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
86 global lookingforhead showlocalchanges
88 set startmsecs
[clock clicks
-milliseconds]
89 set commitidx
($view) 0
90 set order
"--topo-order"
92 set order
"--date-order"
95 set fd
[open
[concat | git log
-z --pretty=raw
$order --parents \
96 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
98 error_popup
"Error executing git rev-list: $err"
101 set commfd
($view) $fd
102 set leftover
($view) {}
103 set lookingforhead
$showlocalchanges
104 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
105 if {$tclencoding != {}} {
106 fconfigure
$fd -encoding $tclencoding
108 filerun
$fd [list getcommitlines
$fd $view]
112 proc stop_rev_list
{} {
113 global commfd curview
115 if {![info exists commfd
($curview)]} return
116 set fd
$commfd($curview)
122 unset commfd
($curview)
126 global phase canv mainfont curview
130 start_rev_list
$curview
131 show_status
"Reading commits..."
134 proc getcommitlines
{fd view
} {
136 global leftover commfd
137 global displayorder commitidx commitrow commitdata
138 global parentlist children curview hlview
139 global vparentlist vdisporder vcmitlisted
141 set stuff
[read $fd 500000]
142 # git log doesn't terminate the last commit with a null...
143 if {$stuff == {} && $leftover($view) ne
{} && [eof
$fd]} {
153 # set it blocking so we wait for the process to terminate
154 fconfigure
$fd -blocking 1
155 if {[catch
{close
$fd} err
]} {
157 if {$view != $curview} {
158 set fv
" for the \"$viewname($view)\" view"
160 if {[string range
$err 0 4] == "usage"} {
161 set err
"Gitk: error reading commits$fv:\
162 bad arguments to git rev-list."
163 if {$viewname($view) eq
"Command line"} {
165 " (Note: arguments to gitk are passed to git rev-list\
166 to allow selection of commits to be displayed.)"
169 set err
"Error reading commits$fv: $err"
173 if {$view == $curview} {
174 run chewcommits
$view
181 set i
[string first
"\0" $stuff $start]
183 append leftover
($view) [string range
$stuff $start end
]
187 set cmit
$leftover($view)
188 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
189 set leftover
($view) {}
191 set cmit
[string range
$stuff $start [expr {$i - 1}]]
193 set start
[expr {$i + 1}]
194 set j
[string first
"\n" $cmit]
197 if {$j >= 0 && [string match
"commit *" $cmit]} {
198 set ids
[string range
$cmit 7 [expr {$j - 1}]]
199 if {[string match
{[-<>]*} $ids]} {
200 switch
-- [string index
$ids 0] {
205 set ids
[string range
$ids 1 end
]
209 if {[string length
$id] != 40} {
217 if {[string length
$shortcmit] > 80} {
218 set shortcmit
"[string range $shortcmit 0 80]..."
220 error_popup
"Can't parse git log output: {$shortcmit}"
223 set id
[lindex
$ids 0]
225 set olds
[lrange
$ids 1 end
]
228 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
229 lappend children
($view,$p) $id
236 if {![info exists children
($view,$id)]} {
237 set children
($view,$id) {}
239 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
240 set commitrow
($view,$id) $commitidx($view)
241 incr commitidx
($view)
242 if {$view == $curview} {
243 lappend parentlist
$olds
244 lappend displayorder
$id
245 lappend commitlisted
$listed
247 lappend vparentlist
($view) $olds
248 lappend vdisporder
($view) $id
249 lappend vcmitlisted
($view) $listed
254 run chewcommits
$view
259 proc chewcommits
{view
} {
260 global curview hlview commfd
261 global selectedline pending_select
264 if {$view == $curview} {
265 set allread
[expr {![info exists commfd
($view)]}]
266 set tlimit
[expr {[clock clicks
-milliseconds] + 50}]
267 set more [layoutmore
$tlimit $allread]
268 if {$allread && !$more} {
269 global displayorder commitidx phase
270 global numcommits startmsecs
272 if {[info exists pending_select
]} {
273 set row
[first_real_row
]
276 if {$commitidx($curview) > 0} {
277 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
278 #puts "overall $ms ms for $numcommits commits"
280 show_status
"No commits selected"
286 if {[info exists hlview
] && $view == $hlview} {
292 proc readcommit
{id
} {
293 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
294 parsecommit
$id $contents 0
297 proc updatecommits
{} {
298 global viewdata curview phase displayorder
299 global children commitrow selectedline thickerline showneartags
306 foreach id
$displayorder {
307 catch
{unset children
($n,$id)}
308 catch
{unset commitrow
($n,$id)}
311 catch
{unset selectedline
}
312 catch
{unset thickerline
}
313 catch
{unset viewdata
($n)}
322 proc parsecommit
{id contents listed
} {
323 global commitinfo cdate
332 set hdrend
[string first
"\n\n" $contents]
334 # should never happen...
335 set hdrend
[string length
$contents]
337 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
338 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
339 foreach line
[split $header "\n"] {
340 set tag
[lindex
$line 0]
341 if {$tag == "author"} {
342 set audate
[lindex
$line end-1
]
343 set auname
[lrange
$line 1 end-2
]
344 } elseif
{$tag == "committer"} {
345 set comdate
[lindex
$line end-1
]
346 set comname
[lrange
$line 1 end-2
]
350 # take the first non-blank line of the comment as the headline
351 set headline
[string trimleft
$comment]
352 set i
[string first
"\n" $headline]
354 set headline
[string range
$headline 0 $i]
356 set headline
[string trimright
$headline]
357 set i
[string first
"\r" $headline]
359 set headline
[string trimright
[string range
$headline 0 $i]]
362 # git rev-list indents the comment by 4 spaces;
363 # if we got this via git cat-file, add the indentation
365 foreach line
[split $comment "\n"] {
366 append newcomment
" "
367 append newcomment
$line
368 append newcomment
"\n"
370 set comment
$newcomment
372 if {$comdate != {}} {
373 set cdate
($id) $comdate
375 set commitinfo
($id) [list
$headline $auname $audate \
376 $comname $comdate $comment]
379 proc getcommit
{id
} {
380 global commitdata commitinfo
382 if {[info exists commitdata
($id)]} {
383 parsecommit
$id $commitdata($id) 1
386 if {![info exists commitinfo
($id)]} {
387 set commitinfo
($id) {"No commit information available"}
394 global tagids idtags headids idheads tagobjid
395 global otherrefids idotherrefs mainhead mainheadid
397 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
400 set refd
[open
[list | git show-ref
-d] r
]
401 while {[gets
$refd line
] >= 0} {
402 if {[string index
$line 40] ne
" "} continue
403 set id
[string range
$line 0 39]
404 set ref
[string range
$line 41 end
]
405 if {![string match
"refs/*" $ref]} continue
406 set name
[string range
$ref 5 end
]
407 if {[string match
"remotes/*" $name]} {
408 if {![string match
"*/HEAD" $name]} {
409 set headids
($name) $id
410 lappend idheads
($id) $name
412 } elseif
{[string match
"heads/*" $name]} {
413 set name
[string range
$name 6 end
]
414 set headids
($name) $id
415 lappend idheads
($id) $name
416 } elseif
{[string match
"tags/*" $name]} {
417 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
418 # which is what we want since the former is the commit ID
419 set name
[string range
$name 5 end
]
420 if {[string match
"*^{}" $name]} {
421 set name
[string range
$name 0 end-3
]
423 set tagobjid
($name) $id
425 set tagids
($name) $id
426 lappend idtags
($id) $name
428 set otherrefids
($name) $id
429 lappend idotherrefs
($id) $name
436 set thehead
[exec git symbolic-ref HEAD
]
437 if {[string match
"refs/heads/*" $thehead]} {
438 set mainhead
[string range
$thehead 11 end
]
439 if {[info exists headids
($mainhead)]} {
440 set mainheadid
$headids($mainhead)
446 # skip over fake commits
447 proc first_real_row
{} {
448 global nullid nullid2 displayorder numcommits
450 for {set row
0} {$row < $numcommits} {incr row
} {
451 set id
[lindex
$displayorder $row]
452 if {$id ne
$nullid && $id ne
$nullid2} {
459 # update things for a head moved to a child of its previous location
460 proc movehead
{id name
} {
461 global headids idheads
463 removehead
$headids($name) $name
464 set headids
($name) $id
465 lappend idheads
($id) $name
468 # update things when a head has been removed
469 proc removehead
{id name
} {
470 global headids idheads
472 if {$idheads($id) eq
$name} {
475 set i
[lsearch
-exact $idheads($id) $name]
477 set idheads
($id) [lreplace
$idheads($id) $i $i]
483 proc show_error
{w top msg
} {
484 message
$w.m
-text $msg -justify center
-aspect 400
485 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
486 button
$w.ok
-text OK
-command "destroy $top"
487 pack
$w.ok
-side bottom
-fill x
488 bind $top <Visibility
> "grab $top; focus $top"
489 bind $top <Key-Return
> "destroy $top"
493 proc error_popup msg
{
497 show_error
$w $w $msg
500 proc confirm_popup msg
{
506 message
$w.m
-text $msg -justify center
-aspect 400
507 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
508 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
509 pack
$w.ok
-side left
-fill x
510 button
$w.cancel
-text Cancel
-command "destroy $w"
511 pack
$w.cancel
-side right
-fill x
512 bind $w <Visibility
> "grab $w; focus $w"
518 global canv canv2 canv3 linespc charspc ctext cflist
519 global textfont mainfont uifont tabstop
520 global findtype findtypemenu findloc findstring fstring geometry
521 global entries sha1entry sha1string sha1but
522 global diffcontextstring diffcontext
523 global maincursor textcursor curtextcursor
524 global rowctxmenu fakerowmenu mergemax wrapcomment
525 global highlight_files gdttype
526 global searchstring sstring
527 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
531 .bar add cascade
-label "File" -menu .bar.
file
532 .bar configure
-font $uifont
534 .bar.
file add
command -label "Update" -command updatecommits
535 .bar.
file add
command -label "Reread references" -command rereadrefs
536 .bar.
file add
command -label "Quit" -command doquit
537 .bar.
file configure
-font $uifont
539 .bar add cascade
-label "Edit" -menu .bar.edit
540 .bar.edit add
command -label "Preferences" -command doprefs
541 .bar.edit configure
-font $uifont
543 menu .bar.view
-font $uifont
544 .bar add cascade
-label "View" -menu .bar.view
545 .bar.view add
command -label "New view..." -command {newview
0}
546 .bar.view add
command -label "Edit view..." -command editview \
548 .bar.view add
command -label "Delete view" -command delview
-state disabled
549 .bar.view add separator
550 .bar.view add radiobutton
-label "All files" -command {showview
0} \
551 -variable selectedview
-value 0
554 .bar add cascade
-label "Help" -menu .bar.
help
555 .bar.
help add
command -label "About gitk" -command about
556 .bar.
help add
command -label "Key bindings" -command keys
557 .bar.
help configure
-font $uifont
558 . configure
-menu .bar
560 # the gui has upper and lower half, parts of a paned window.
561 panedwindow .ctop
-orient vertical
563 # possibly use assumed geometry
564 if {![info exists geometry
(pwsash0
)]} {
565 set geometry
(topheight
) [expr {15 * $linespc}]
566 set geometry
(topwidth
) [expr {80 * $charspc}]
567 set geometry
(botheight
) [expr {15 * $linespc}]
568 set geometry
(botwidth
) [expr {50 * $charspc}]
569 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
570 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
573 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
574 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
576 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
578 # create three canvases
579 set cscroll .tf.histframe.csb
580 set canv .tf.histframe.pwclist.canv
582 -selectbackground $selectbgcolor \
583 -background $bgcolor -bd 0 \
584 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
585 .tf.histframe.pwclist add
$canv
586 set canv2 .tf.histframe.pwclist.canv2
588 -selectbackground $selectbgcolor \
589 -background $bgcolor -bd 0 -yscrollincr $linespc
590 .tf.histframe.pwclist add
$canv2
591 set canv3 .tf.histframe.pwclist.canv3
593 -selectbackground $selectbgcolor \
594 -background $bgcolor -bd 0 -yscrollincr $linespc
595 .tf.histframe.pwclist add
$canv3
596 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
597 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
599 # a scroll bar to rule them
600 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
601 pack
$cscroll -side right
-fill y
602 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
603 lappend bglist
$canv $canv2 $canv3
604 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
606 # we have two button bars at bottom of top frame. Bar 1
608 frame .tf.lbar
-height 15
610 set sha1entry .tf.bar.sha1
611 set entries
$sha1entry
612 set sha1but .tf.bar.sha1label
613 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
614 -command gotocommit
-width 8 -font $uifont
615 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
616 pack .tf.bar.sha1label
-side left
617 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
618 trace add variable sha1string
write sha1change
619 pack
$sha1entry -side left
-pady 2
621 image create bitmap bm-left
-data {
622 #define left_width 16
623 #define left_height 16
624 static unsigned char left_bits
[] = {
625 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
626 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
627 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
629 image create bitmap bm-right
-data {
630 #define right_width 16
631 #define right_height 16
632 static unsigned char right_bits
[] = {
633 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
634 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
635 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
637 button .tf.bar.leftbut
-image bm-left
-command goback \
638 -state disabled
-width 26
639 pack .tf.bar.leftbut
-side left
-fill y
640 button .tf.bar.rightbut
-image bm-right
-command goforw \
641 -state disabled
-width 26
642 pack .tf.bar.rightbut
-side left
-fill y
644 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
645 pack .tf.bar.findbut
-side left
647 set fstring .tf.bar.findstring
648 lappend entries
$fstring
649 entry
$fstring -width 30 -font $textfont -textvariable findstring
650 trace add variable findstring
write find_change
651 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
653 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
654 findtype Exact IgnCase Regexp
]
655 trace add variable findtype
write find_change
656 .tf.bar.findtype configure
-font $uifont
657 .tf.bar.findtype.menu configure
-font $uifont
658 set findloc
"All fields"
659 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
660 Comments Author Committer
661 trace add variable findloc
write find_change
662 .tf.bar.findloc configure
-font $uifont
663 .tf.bar.findloc.menu configure
-font $uifont
664 pack .tf.bar.findloc
-side right
665 pack .tf.bar.findtype
-side right
667 # build up the bottom bar of upper window
668 label .tf.lbar.flabel
-text "Highlight: Commits " \
670 pack .tf.lbar.flabel
-side left
-fill y
671 set gdttype
"touching paths:"
672 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
673 "adding/removing string:"]
674 trace add variable gdttype
write hfiles_change
675 $gm conf
-font $uifont
676 .tf.lbar.gdttype conf
-font $uifont
677 pack .tf.lbar.gdttype
-side left
-fill y
678 entry .tf.lbar.fent
-width 25 -font $textfont \
679 -textvariable highlight_files
680 trace add variable highlight_files
write hfiles_change
681 lappend entries .tf.lbar.fent
682 pack .tf.lbar.fent
-side left
-fill x
-expand 1
683 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
684 pack .tf.lbar.vlabel
-side left
-fill y
685 global viewhlmenu selectedhlview
686 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
687 $viewhlmenu entryconf None
-command delvhighlight
688 $viewhlmenu conf
-font $uifont
689 .tf.lbar.vhl conf
-font $uifont
690 pack .tf.lbar.vhl
-side left
-fill y
691 label .tf.lbar.rlabel
-text " OR " -font $uifont
692 pack .tf.lbar.rlabel
-side left
-fill y
693 global highlight_related
694 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
695 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
696 $m conf
-font $uifont
697 .tf.lbar.relm conf
-font $uifont
698 trace add variable highlight_related
write vrel_change
699 pack .tf.lbar.relm
-side left
-fill y
701 # Finish putting the upper half of the viewer together
702 pack .tf.lbar
-in .tf
-side bottom
-fill x
703 pack .tf.bar
-in .tf
-side bottom
-fill x
704 pack .tf.histframe
-fill both
-side top
-expand 1
706 .ctop paneconfigure .tf
-height $geometry(topheight
)
707 .ctop paneconfigure .tf
-width $geometry(topwidth
)
709 # now build up the bottom
710 panedwindow .pwbottom
-orient horizontal
712 # lower left, a text box over search bar, scroll bar to the right
713 # if we know window height, then that will set the lower text height, otherwise
714 # we set lower text height which will drive window height
715 if {[info exists geometry
(main
)]} {
716 frame .bleft
-width $geometry(botwidth
)
718 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
723 button .bleft.top.search
-text "Search" -command dosearch \
725 pack .bleft.top.search
-side left
-padx 5
726 set sstring .bleft.top.sstring
727 entry
$sstring -width 20 -font $textfont -textvariable searchstring
728 lappend entries
$sstring
729 trace add variable searchstring
write incrsearch
730 pack
$sstring -side left
-expand 1 -fill x
731 radiobutton .bleft.mid.
diff -text "Diff" \
732 -command changediffdisp
-variable diffelide
-value {0 0}
733 radiobutton .bleft.mid.old
-text "Old version" \
734 -command changediffdisp
-variable diffelide
-value {0 1}
735 radiobutton .bleft.mid.new
-text "New version" \
736 -command changediffdisp
-variable diffelide
-value {1 0}
737 label .bleft.mid.labeldiffcontext
-text " Lines of context: " \
739 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
740 spinbox .bleft.mid.diffcontext
-width 5 -font $textfont \
741 -from 1 -increment 1 -to 10000000 \
742 -validate all
-validatecommand "diffcontextvalidate %P" \
743 -textvariable diffcontextstring
744 .bleft.mid.diffcontext
set $diffcontext
745 trace add variable diffcontextstring
write diffcontextchange
746 lappend entries .bleft.mid.diffcontext
747 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
748 set ctext .bleft.ctext
749 text
$ctext -background $bgcolor -foreground $fgcolor \
750 -tabs "[expr {$tabstop * $charspc}]" \
751 -state disabled
-font $textfont \
752 -yscrollcommand scrolltext
-wrap none
753 scrollbar .bleft.sb
-command "$ctext yview"
754 pack .bleft.top
-side top
-fill x
755 pack .bleft.mid
-side top
-fill x
756 pack .bleft.sb
-side right
-fill y
757 pack
$ctext -side left
-fill both
-expand 1
758 lappend bglist
$ctext
759 lappend fglist
$ctext
761 $ctext tag conf comment
-wrap $wrapcomment
762 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
763 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
764 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
765 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
766 $ctext tag conf m0
-fore red
767 $ctext tag conf m1
-fore blue
768 $ctext tag conf m2
-fore green
769 $ctext tag conf m3
-fore purple
770 $ctext tag conf
m4 -fore brown
771 $ctext tag conf m5
-fore "#009090"
772 $ctext tag conf m6
-fore magenta
773 $ctext tag conf m7
-fore "#808000"
774 $ctext tag conf m8
-fore "#009000"
775 $ctext tag conf m9
-fore "#ff0080"
776 $ctext tag conf m10
-fore cyan
777 $ctext tag conf m11
-fore "#b07070"
778 $ctext tag conf m12
-fore "#70b0f0"
779 $ctext tag conf m13
-fore "#70f0b0"
780 $ctext tag conf m14
-fore "#f0b070"
781 $ctext tag conf m15
-fore "#ff70b0"
782 $ctext tag conf mmax
-fore darkgrey
784 $ctext tag conf mresult
-font [concat
$textfont bold
]
785 $ctext tag conf msep
-font [concat
$textfont bold
]
786 $ctext tag conf found
-back yellow
789 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
794 radiobutton .bright.mode.
patch -text "Patch" \
795 -command reselectline
-variable cmitmode
-value "patch"
796 .bright.mode.
patch configure
-font $uifont
797 radiobutton .bright.mode.tree
-text "Tree" \
798 -command reselectline
-variable cmitmode
-value "tree"
799 .bright.mode.tree configure
-font $uifont
800 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
801 pack .bright.mode
-side top
-fill x
802 set cflist .bright.cfiles
803 set indent
[font measure
$mainfont "nn"]
805 -selectbackground $selectbgcolor \
806 -background $bgcolor -foreground $fgcolor \
808 -tabs [list
$indent [expr {2 * $indent}]] \
809 -yscrollcommand ".bright.sb set" \
810 -cursor [. cget
-cursor] \
811 -spacing1 1 -spacing3 1
812 lappend bglist
$cflist
813 lappend fglist
$cflist
814 scrollbar .bright.sb
-command "$cflist yview"
815 pack .bright.sb
-side right
-fill y
816 pack
$cflist -side left
-fill both
-expand 1
817 $cflist tag configure highlight \
818 -background [$cflist cget
-selectbackground]
819 $cflist tag configure bold
-font [concat
$mainfont bold
]
821 .pwbottom add .bright
824 # restore window position if known
825 if {[info exists geometry
(main
)]} {
826 wm geometry .
"$geometry(main)"
829 if {[tk windowingsystem
] eq
{aqua
}} {
835 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
836 pack .ctop
-fill both
-expand 1
837 bindall
<1> {selcanvline
%W
%x
%y
}
838 #bindall <B1-Motion> {selcanvline %W %x %y}
839 if {[tk windowingsystem
] == "win32"} {
840 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
841 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
843 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
844 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
846 bindall
<2> "canvscan mark %W %x %y"
847 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
848 bindkey
<Home
> selfirstline
849 bindkey
<End
> sellastline
850 bind .
<Key-Up
> "selnextline -1"
851 bind .
<Key-Down
> "selnextline 1"
852 bind .
<Shift-Key-Up
> "next_highlight -1"
853 bind .
<Shift-Key-Down
> "next_highlight 1"
854 bindkey
<Key-Right
> "goforw"
855 bindkey
<Key-Left
> "goback"
856 bind .
<Key-Prior
> "selnextpage -1"
857 bind .
<Key-Next
> "selnextpage 1"
858 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
859 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
860 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
861 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
862 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
863 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
864 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
865 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
866 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
867 bindkey p
"selnextline -1"
868 bindkey n
"selnextline 1"
871 bindkey i
"selnextline -1"
872 bindkey k
"selnextline 1"
875 bindkey b
"$ctext yview scroll -1 pages"
876 bindkey d
"$ctext yview scroll 18 units"
877 bindkey u
"$ctext yview scroll -18 units"
878 bindkey
/ {findnext
1}
879 bindkey
<Key-Return
> {findnext
0}
882 bindkey
<F5
> updatecommits
883 bind .
<$M1B-q> doquit
884 bind .
<$M1B-f> dofind
885 bind .
<$M1B-g> {findnext
0}
886 bind .
<$M1B-r> dosearchback
887 bind .
<$M1B-s> dosearch
888 bind .
<$M1B-equal> {incrfont
1}
889 bind .
<$M1B-KP_Add> {incrfont
1}
890 bind .
<$M1B-minus> {incrfont
-1}
891 bind .
<$M1B-KP_Subtract> {incrfont
-1}
892 wm protocol . WM_DELETE_WINDOW doquit
893 bind .
<Button-1
> "click %W"
894 bind $fstring <Key-Return
> dofind
895 bind $sha1entry <Key-Return
> gotocommit
896 bind $sha1entry <<PasteSelection>> clearsha1
897 bind $cflist <1> {sel_flist %W %x %y; break}
898 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
899 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
900 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
902 set maincursor [. cget -cursor]
903 set textcursor [$ctext cget -cursor]
904 set curtextcursor $textcursor
906 set rowctxmenu .rowctxmenu
907 menu $rowctxmenu -tearoff 0
908 $rowctxmenu add command -label "Diff this -> selected" \
909 -command {diffvssel 0}
910 $rowctxmenu add command -label "Diff selected -> this" \
911 -command {diffvssel 1}
912 $rowctxmenu add command -label "Make patch" -command mkpatch
913 $rowctxmenu add command -label "Create tag" -command mktag
914 $rowctxmenu add command -label "Write commit to file" -command writecommit
915 $rowctxmenu add command -label "Create new branch" -command mkbranch
916 $rowctxmenu add command -label "Cherry-pick this commit" \
918 $rowctxmenu add command -label "Reset HEAD branch to here" \
921 set fakerowmenu .fakerowmenu
922 menu $fakerowmenu -tearoff 0
923 $fakerowmenu add command -label "Diff this -> selected" \
924 -command {diffvssel 0}
925 $fakerowmenu add command -label "Diff selected -> this" \
926 -command {diffvssel 1}
927 $fakerowmenu add command -label "Make patch" -command mkpatch
928 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
929 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
930 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
932 set headctxmenu .headctxmenu
933 menu $headctxmenu -tearoff 0
934 $headctxmenu add command -label "Check out this branch" \
936 $headctxmenu add command -label "Remove this branch" \
940 set flist_menu .flistctxmenu
941 menu $flist_menu -tearoff 0
942 $flist_menu add command -label "Highlight this too" \
943 -command {flist_hl 0}
944 $flist_menu add command -label "Highlight this only" \
945 -command {flist_hl 1}
948 # Windows sends all mouse wheel events to the current focused window, not
949 # the one where the mouse hovers, so bind those events here and redirect
950 # to the correct window
951 proc windows_mousewheel_redirector {W X Y D} {
952 global canv canv2 canv3
953 set w [winfo containing -displayof $W $X $Y]
955 set u [expr {$D < 0 ? 5 : -5}]
956 if {$w == $canv || $w == $canv2 || $w == $canv3} {
957 allcanvs yview scroll $u units
960 $w yview scroll $u units
966 # mouse-2 makes all windows scan vertically, but only the one
967 # the cursor is in scans horizontally
968 proc canvscan {op w x y} {
969 global canv canv2 canv3
970 foreach c [list $canv $canv2 $canv3] {
979 proc scrollcanv {cscroll f0 f1} {
985 # when we make a key binding for the toplevel, make sure
986 # it doesn't get triggered when that key is pressed in the
987 # find string entry widget.
988 proc bindkey {ev script} {
991 set escript [bind Entry $ev]
992 if {$escript == {}} {
993 set escript [bind Entry <Key>]
996 bind $e $ev "$escript; break"
1000 # set the focus back to the toplevel for any click outside
1003 global ctext entries
1004 foreach e [concat $entries $ctext] {
1005 if {$w == $e} return
1010 proc savestuff {w} {
1011 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1012 global stuffsaved findmergefiles maxgraphpct
1013 global maxwidth showneartags showlocalchanges
1014 global viewname viewfiles viewargs viewperm nextviewnum
1015 global cmitmode wrapcomment
1016 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1018 if {$stuffsaved} return
1019 if {![winfo viewable .]} return
1021 set f [open "~/.gitk-new" w]
1022 puts $f [list set mainfont $mainfont]
1023 puts $f [list set textfont $textfont]
1024 puts $f [list set uifont $uifont]
1025 puts $f [list set tabstop $tabstop]
1026 puts $f [list set findmergefiles $findmergefiles]
1027 puts $f [list set maxgraphpct $maxgraphpct]
1028 puts $f [list set maxwidth $maxwidth]
1029 puts $f [list set cmitmode $cmitmode]
1030 puts $f [list set wrapcomment $wrapcomment]
1031 puts $f [list set showneartags $showneartags]
1032 puts $f [list set showlocalchanges $showlocalchanges]
1033 puts $f [list set bgcolor $bgcolor]
1034 puts $f [list set fgcolor $fgcolor]
1035 puts $f [list set colors $colors]
1036 puts $f [list set diffcolors $diffcolors]
1037 puts $f [list set diffcontext $diffcontext]
1038 puts $f [list set selectbgcolor $selectbgcolor]
1040 puts $f "set geometry(main) [wm geometry .]"
1041 puts $f "set geometry(topwidth) [winfo width .tf]"
1042 puts $f "set geometry(topheight) [winfo height .tf]"
1043 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1044 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1045 puts $f "set geometry(botwidth) [winfo width .bleft]"
1046 puts $f "set geometry(botheight) [winfo height .bleft]"
1048 puts -nonewline $f "set permviews {"
1049 for {set v 0} {$v < $nextviewnum} {incr v} {
1050 if {$viewperm($v)} {
1051 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1056 file rename -force "~/.gitk-new" "~/.gitk"
1061 proc resizeclistpanes {win w} {
1063 if {[info exists oldwidth($win)]} {
1064 set s0 [$win sash coord 0]
1065 set s1 [$win sash coord 1]
1067 set sash0 [expr {int($w/2 - 2)}]
1068 set sash1 [expr {int($w*5/6 - 2)}]
1070 set factor [expr {1.0 * $w / $oldwidth($win)}]
1071 set sash0 [expr {int($factor * [lindex $s0 0])}]
1072 set sash1 [expr {int($factor * [lindex $s1 0])}]
1076 if {$sash1 < $sash0 + 20} {
1077 set sash1 [expr {$sash0 + 20}]
1079 if {$sash1 > $w - 10} {
1080 set sash1 [expr {$w - 10}]
1081 if {$sash0 > $sash1 - 20} {
1082 set sash0 [expr {$sash1 - 20}]
1086 $win sash place 0 $sash0 [lindex $s0 1]
1087 $win sash place 1 $sash1 [lindex $s1 1]
1089 set oldwidth($win) $w
1092 proc resizecdetpanes {win w} {
1094 if {[info exists oldwidth($win)]} {
1095 set s0 [$win sash coord 0]
1097 set sash0 [expr {int($w*3/4 - 2)}]
1099 set factor [expr {1.0 * $w / $oldwidth($win)}]
1100 set sash0 [expr {int($factor * [lindex $s0 0])}]
1104 if {$sash0 > $w - 15} {
1105 set sash0 [expr {$w - 15}]
1108 $win sash place 0 $sash0 [lindex $s0 1]
1110 set oldwidth($win) $w
1113 proc allcanvs args {
1114 global canv canv2 canv3
1120 proc bindall {event action} {
1121 global canv canv2 canv3
1122 bind $canv $event $action
1123 bind $canv2 $event $action
1124 bind $canv3 $event $action
1130 if {[winfo exists $w]} {
1135 wm title $w "About gitk"
1136 message $w.m -text {
1137 Gitk - a commit viewer for git
1139 Copyright © 2005-2006 Paul Mackerras
1141 Use and redistribute under the terms of the GNU General Public License} \
1142 -justify center -aspect 400 -border 2 -bg white -relief groove
1143 pack $w.m -side top -fill x -padx 2 -pady 2
1144 $w.m configure -font $uifont
1145 button $w.ok -text Close -command "destroy $w" -default active
1146 pack $w.ok -side bottom
1147 $w.ok configure -font $uifont
1148 bind $w <Visibility> "focus $w.ok"
1149 bind $w <Key-Escape> "destroy $w"
1150 bind $w <Key-Return> "destroy $w"
1156 if {[winfo exists $w]} {
1160 if {[tk windowingsystem] eq {aqua}} {
1166 wm title $w "Gitk key bindings"
1167 message $w.m -text "
1171 <Home> Move to first commit
1172 <End> Move to last commit
1173 <Up>, p, i Move up one commit
1174 <Down>, n, k Move down one commit
1175 <Left>, z, j Go back in history list
1176 <Right>, x, l Go forward in history list
1177 <PageUp> Move up one page in commit list
1178 <PageDown> Move down one page in commit list
1179 <$M1T-Home> Scroll to top of commit list
1180 <$M1T-End> Scroll to bottom of commit list
1181 <$M1T-Up> Scroll commit list up one line
1182 <$M1T-Down> Scroll commit list down one line
1183 <$M1T-PageUp> Scroll commit list up one page
1184 <$M1T-PageDown> Scroll commit list down one page
1185 <Shift-Up> Move to previous highlighted line
1186 <Shift-Down> Move to next highlighted line
1187 <Delete>, b Scroll diff view up one page
1188 <Backspace> Scroll diff view up one page
1189 <Space> Scroll diff view down one page
1190 u Scroll diff view up 18 lines
1191 d Scroll diff view down 18 lines
1193 <$M1T-G> Move to next find hit
1194 <Return> Move to next find hit
1195 / Move to next find hit, or redo find
1196 ? Move to previous find hit
1197 f Scroll diff view to next file
1198 <$M1T-S> Search for next hit in diff view
1199 <$M1T-R> Search for previous hit in diff view
1200 <$M1T-KP+> Increase font size
1201 <$M1T-plus> Increase font size
1202 <$M1T-KP-> Decrease font size
1203 <$M1T-minus> Decrease font size
1206 -justify left -bg white -border 2 -relief groove
1207 pack $w.m -side top -fill both -padx 2 -pady 2
1208 $w.m configure -font $uifont
1209 button $w.ok -text Close -command "destroy $w" -default active
1210 pack $w.ok -side bottom
1211 $w.ok configure -font $uifont
1212 bind $w <Visibility> "focus $w.ok"
1213 bind $w <Key-Escape> "destroy $w"
1214 bind $w <Key-Return> "destroy $w"
1217 # Procedures for manipulating the file list window at the
1218 # bottom right of the overall window.
1220 proc treeview {w l openlevs} {
1221 global treecontents treediropen treeheight treeparent treeindex
1231 set treecontents() {}
1232 $w conf -state normal
1234 while {[string range $f 0 $prefixend] ne $prefix} {
1235 if {$lev <= $openlevs} {
1236 $w mark set e:$treeindex($prefix) "end -1c"
1237 $w mark gravity e:$treeindex($prefix) left
1239 set treeheight($prefix) $ht
1240 incr ht [lindex $htstack end]
1241 set htstack [lreplace $htstack end end]
1242 set prefixend [lindex $prefendstack end]
1243 set prefendstack [lreplace $prefendstack end end]
1244 set prefix [string range $prefix 0 $prefixend]
1247 set tail [string range $f [expr {$prefixend+1}] end]
1248 while {[set slash [string first "/" $tail]] >= 0} {
1251 lappend prefendstack $prefixend
1252 incr prefixend [expr {$slash + 1}]
1253 set d [string range $tail 0 $slash]
1254 lappend treecontents($prefix) $d
1255 set oldprefix $prefix
1257 set treecontents($prefix) {}
1258 set treeindex($prefix) [incr ix]
1259 set treeparent($prefix) $oldprefix
1260 set tail [string range $tail [expr {$slash+1}] end]
1261 if {$lev <= $openlevs} {
1263 set treediropen($prefix) [expr {$lev < $openlevs}]
1264 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1265 $w mark set d:$ix "end -1c"
1266 $w mark gravity d:$ix left
1268 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1270 $w image create end -align center -image $bm -padx 1 \
1272 $w insert end $d [highlight_tag $prefix]
1273 $w mark set s:$ix "end -1c"
1274 $w mark gravity s:$ix left
1279 if {$lev <= $openlevs} {
1282 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1284 $w insert end $tail [highlight_tag $f]
1286 lappend treecontents($prefix) $tail
1289 while {$htstack ne {}} {
1290 set treeheight($prefix) $ht
1291 incr ht [lindex $htstack end]
1292 set htstack [lreplace $htstack end end]
1293 set prefixend [lindex $prefendstack end]
1294 set prefendstack [lreplace $prefendstack end end]
1295 set prefix [string range $prefix 0 $prefixend]
1297 $w conf -state disabled
1300 proc linetoelt {l} {
1301 global treeheight treecontents
1306 foreach e $treecontents($prefix) {
1311 if {[string index $e end] eq "/"} {
1312 set n $treeheight($prefix$e)
1324 proc highlight_tree {y prefix} {
1325 global treeheight treecontents cflist
1327 foreach e $treecontents($prefix) {
1329 if {[highlight_tag $path] ne {}} {
1330 $cflist tag add bold $y.0 "$y.0 lineend"
1333 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1334 set y [highlight_tree $y $path]
1340 proc treeclosedir {w dir} {
1341 global treediropen treeheight treeparent treeindex
1343 set ix $treeindex($dir)
1344 $w conf -state normal
1345 $w delete s:$ix e:$ix
1346 set treediropen($dir) 0
1347 $w image configure a:$ix -image tri-rt
1348 $w conf -state disabled
1349 set n [expr {1 - $treeheight($dir)}]
1350 while {$dir ne {}} {
1351 incr treeheight($dir) $n
1352 set dir $treeparent($dir)
1356 proc treeopendir {w dir} {
1357 global treediropen treeheight treeparent treecontents treeindex
1359 set ix $treeindex($dir)
1360 $w conf -state normal
1361 $w image configure a:$ix -image tri-dn
1362 $w mark set e:$ix s:$ix
1363 $w mark gravity e:$ix right
1366 set n [llength $treecontents($dir)]
1367 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1370 incr treeheight($x) $n
1372 foreach e $treecontents($dir) {
1374 if {[string index $e end] eq "/"} {
1375 set iy $treeindex($de)
1376 $w mark set d:$iy e:$ix
1377 $w mark gravity d:$iy left
1378 $w insert e:$ix $str
1379 set treediropen($de) 0
1380 $w image create e:$ix -align center -image tri-rt -padx 1 \
1382 $w insert e:$ix $e [highlight_tag $de]
1383 $w mark set s:$iy e:$ix
1384 $w mark gravity s:$iy left
1385 set treeheight($de) 1
1387 $w insert e:$ix $str
1388 $w insert e:$ix $e [highlight_tag $de]
1391 $w mark gravity e:$ix left
1392 $w conf -state disabled
1393 set treediropen($dir) 1
1394 set top [lindex [split [$w index @0,0] .] 0]
1395 set ht [$w cget -height]
1396 set l [lindex [split [$w index s:$ix] .] 0]
1399 } elseif {$l + $n + 1 > $top + $ht} {
1400 set top [expr {$l + $n + 2 - $ht}]
1408 proc treeclick {w x y} {
1409 global treediropen cmitmode ctext cflist cflist_top
1411 if {$cmitmode ne "tree"} return
1412 if {![info exists cflist_top]} return
1413 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1414 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1415 $cflist tag add highlight $l.0 "$l.0 lineend"
1421 set e [linetoelt $l]
1422 if {[string index $e end] ne "/"} {
1424 } elseif {$treediropen($e)} {
1431 proc setfilelist {id} {
1432 global treefilelist cflist
1434 treeview $cflist $treefilelist($id) 0
1437 image create bitmap tri-rt -background black -foreground blue -data {
1438 #define tri-rt_width 13
1439 #define tri-rt_height 13
1440 static unsigned char tri-rt_bits[] = {
1441 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1442 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1445 #define tri-rt-mask_width 13
1446 #define tri-rt-mask_height 13
1447 static unsigned char tri-rt-mask_bits[] = {
1448 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1449 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1452 image create bitmap tri-dn -background black -foreground blue -data {
1453 #define tri-dn_width 13
1454 #define tri-dn_height 13
1455 static unsigned char tri-dn_bits[] = {
1456 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1457 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1460 #define tri-dn-mask_width 13
1461 #define tri-dn-mask_height 13
1462 static unsigned char tri-dn-mask_bits[] = {
1463 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1464 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1468 proc init_flist {first} {
1469 global cflist cflist_top selectedline difffilestart
1471 $cflist conf -state normal
1472 $cflist delete 0.0 end
1474 $cflist insert end $first
1476 $cflist tag add highlight 1.0 "1.0 lineend"
1478 catch {unset cflist_top}
1480 $cflist conf -state disabled
1481 set difffilestart {}
1484 proc highlight_tag {f} {
1485 global highlight_paths
1487 foreach p $highlight_paths {
1488 if {[string match $p $f]} {
1495 proc highlight_filelist {} {
1496 global cmitmode cflist
1498 $cflist conf -state normal
1499 if {$cmitmode ne "tree"} {
1500 set end [lindex [split [$cflist index end] .] 0]
1501 for {set l 2} {$l < $end} {incr l} {
1502 set line [$cflist get $l.0 "$l.0 lineend"]
1503 if {[highlight_tag $line] ne {}} {
1504 $cflist tag add bold $l.0 "$l.0 lineend"
1510 $cflist conf -state disabled
1513 proc unhighlight_filelist {} {
1516 $cflist conf -state normal
1517 $cflist tag remove bold 1.0 end
1518 $cflist conf -state disabled
1521 proc add_flist {fl} {
1524 $cflist conf -state normal
1526 $cflist insert end "\n"
1527 $cflist insert end $f [highlight_tag $f]
1529 $cflist conf -state disabled
1532 proc sel_flist {w x y} {
1533 global ctext difffilestart cflist cflist_top cmitmode
1535 if {$cmitmode eq "tree"} return
1536 if {![info exists cflist_top]} return
1537 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1538 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1539 $cflist tag add highlight $l.0 "$l.0 lineend"
1544 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1548 proc pop_flist_menu {w X Y x y} {
1549 global ctext cflist cmitmode flist_menu flist_menu_file
1550 global treediffs diffids
1552 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1554 if {$cmitmode eq "tree"} {
1555 set e [linetoelt $l]
1556 if {[string index $e end] eq "/"} return
1558 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1560 set flist_menu_file $e
1561 tk_popup $flist_menu $X $Y
1564 proc flist_hl {only} {
1565 global flist_menu_file highlight_files
1567 set x [shellquote $flist_menu_file]
1568 if {$only || $highlight_files eq {}} {
1569 set highlight_files $x
1571 append highlight_files " " $x
1575 # Functions for adding and removing shell-type quoting
1577 proc shellquote {str} {
1578 if {![string match "*\['\"\\ \t]*" $str]} {
1581 if {![string match "*\['\"\\]*" $str]} {
1584 if {![string match "*'*" $str]} {
1587 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1590 proc shellarglist {l} {
1596 append str [shellquote $a]
1601 proc shelldequote {str} {
1606 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1607 append ret [string range $str $used end]
1608 set used [string length $str]
1611 set first [lindex $first 0]
1612 set ch [string index $str $first]
1613 if {$first > $used} {
1614 append ret [string range $str $used [expr {$first - 1}]]
1617 if {$ch eq " " || $ch eq "\t"} break
1620 set first [string first "'" $str $used]
1622 error "unmatched single-quote"
1624 append ret [string range $str $used [expr {$first - 1}]]
1629 if {$used >= [string length $str]} {
1630 error "trailing backslash"
1632 append ret [string index $str $used]
1637 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1638 error "unmatched double-quote"
1640 set first [lindex $first 0]
1641 set ch [string index $str $first]
1642 if {$first > $used} {
1643 append ret [string range $str $used [expr {$first - 1}]]
1646 if {$ch eq "\""} break
1648 append ret [string index $str $used]
1652 return [list $used $ret]
1655 proc shellsplit {str} {
1658 set str [string trimleft $str]
1659 if {$str eq {}} break
1660 set dq [shelldequote $str]
1661 set n [lindex $dq 0]
1662 set word [lindex $dq 1]
1663 set str [string range $str $n end]
1669 # Code to implement multiple views
1671 proc newview {ishighlight} {
1672 global nextviewnum newviewname newviewperm uifont newishighlight
1673 global newviewargs revtreeargs
1675 set newishighlight $ishighlight
1677 if {[winfo exists $top]} {
1681 set newviewname($nextviewnum) "View $nextviewnum"
1682 set newviewperm($nextviewnum) 0
1683 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1684 vieweditor $top $nextviewnum "Gitk view definition"
1689 global viewname viewperm newviewname newviewperm
1690 global viewargs newviewargs
1692 set top .gitkvedit-$curview
1693 if {[winfo exists $top]} {
1697 set newviewname($curview) $viewname($curview)
1698 set newviewperm($curview) $viewperm($curview)
1699 set newviewargs($curview) [shellarglist $viewargs($curview)]
1700 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1703 proc vieweditor {top n title} {
1704 global newviewname newviewperm viewfiles
1708 wm title $top $title
1709 label $top.nl -text "Name" -font $uifont
1710 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1711 grid $top.nl $top.name -sticky w -pady 5
1712 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1714 grid $top.perm - -pady 5 -sticky w
1715 message $top.al -aspect 1000 -font $uifont \
1716 -text "Commits to include (arguments to git rev-list):"
1717 grid $top.al - -sticky w -pady 5
1718 entry $top.args -width 50 -textvariable newviewargs($n) \
1719 -background white -font $uifont
1720 grid $top.args - -sticky ew -padx 5
1721 message $top.l -aspect 1000 -font $uifont \
1722 -text "Enter files and directories to include, one per line:"
1723 grid $top.l - -sticky w
1724 text $top.t -width 40 -height 10 -background white -font $uifont
1725 if {[info exists viewfiles($n)]} {
1726 foreach f $viewfiles($n) {
1727 $top.t insert end $f
1728 $top.t insert end "\n"
1730 $top.t delete {end - 1c} end
1731 $top.t mark set insert 0.0
1733 grid $top.t - -sticky ew -padx 5
1735 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1737 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1739 grid $top.buts.ok $top.buts.can
1740 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1741 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1742 grid $top.buts - -pady 10 -sticky ew
1746 proc doviewmenu {m first cmd op argv} {
1747 set nmenu [$m index end]
1748 for {set i $first} {$i <= $nmenu} {incr i} {
1749 if {[$m entrycget $i -command] eq $cmd} {
1750 eval $m $op $i $argv
1756 proc allviewmenus {n op args} {
1759 doviewmenu .bar.view 5 [list showview $n] $op $args
1760 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1763 proc newviewok {top n} {
1764 global nextviewnum newviewperm newviewname newishighlight
1765 global viewname viewfiles viewperm selectedview curview
1766 global viewargs newviewargs viewhlmenu
1769 set newargs [shellsplit $newviewargs($n)]
1771 error_popup "Error in commit selection arguments: $err"
1777 foreach f [split [$top.t get 0.0 end] "\n"] {
1778 set ft [string trim $f]
1783 if {![info exists viewfiles($n)]} {
1784 # creating a new view
1786 set viewname($n) $newviewname($n)
1787 set viewperm($n) $newviewperm($n)
1788 set viewfiles($n) $files
1789 set viewargs($n) $newargs
1791 if {!$newishighlight} {
1794 run addvhighlight $n
1797 # editing an existing view
1798 set viewperm($n) $newviewperm($n)
1799 if {$newviewname($n) ne $viewname($n)} {
1800 set viewname($n) $newviewname($n)
1801 doviewmenu .bar.view 5 [list showview $n] \
1802 entryconf [list -label $viewname($n)]
1803 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1804 entryconf [list -label $viewname($n) -value $viewname($n)]
1806 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1807 set viewfiles($n) $files
1808 set viewargs($n) $newargs
1809 if {$curview == $n} {
1814 catch {destroy $top}
1818 global curview viewdata viewperm hlview selectedhlview
1820 if {$curview == 0} return
1821 if {[info exists hlview] && $hlview == $curview} {
1822 set selectedhlview None
1825 allviewmenus $curview delete
1826 set viewdata($curview) {}
1827 set viewperm($curview) 0
1831 proc addviewmenu {n} {
1832 global viewname viewhlmenu
1834 .bar.view add radiobutton -label $viewname($n) \
1835 -command [list showview $n] -variable selectedview -value $n
1836 $viewhlmenu add radiobutton -label $viewname($n) \
1837 -command [list addvhighlight $n] -variable selectedhlview
1840 proc flatten {var} {
1844 foreach i [array names $var] {
1845 lappend ret $i [set $var\($i\)]
1850 proc unflatten {var l} {
1860 global curview viewdata viewfiles
1861 global displayorder parentlist rowidlist rowoffsets
1862 global colormap rowtextx commitrow nextcolor canvxmax
1863 global numcommits rowrangelist commitlisted idrowranges rowchk
1864 global selectedline currentid canv canvy0
1866 global pending_select phase
1867 global commitidx rowlaidout rowoptim
1869 global selectedview selectfirst
1870 global vparentlist vdisporder vcmitlisted
1871 global hlview selectedhlview
1873 if {$n == $curview} return
1875 if {[info exists selectedline]} {
1876 set selid $currentid
1877 set y [yc $selectedline]
1878 set ymax [lindex [$canv cget -scrollregion] 3]
1879 set span [$canv yview]
1880 set ytop [expr {[lindex $span 0] * $ymax}]
1881 set ybot [expr {[lindex $span 1] * $ymax}]
1882 if {$ytop < $y && $y < $ybot} {
1883 set yscreen [expr {$y - $ytop}]
1885 set yscreen [expr {($ybot - $ytop) / 2}]
1887 } elseif {[info exists pending_select]} {
1888 set selid $pending_select
1889 unset pending_select
1893 if {$curview >= 0} {
1894 set vparentlist($curview) $parentlist
1895 set vdisporder($curview) $displayorder
1896 set vcmitlisted($curview) $commitlisted
1898 set viewdata($curview) \
1899 [list $phase $rowidlist $rowoffsets $rowrangelist \
1900 [flatten idrowranges] [flatten idinlist] \
1901 $rowlaidout $rowoptim $numcommits]
1902 } elseif {![info exists viewdata($curview)]
1903 || [lindex $viewdata($curview) 0] ne {}} {
1904 set viewdata($curview) \
1905 [list {} $rowidlist $rowoffsets $rowrangelist]
1908 catch {unset treediffs}
1910 if {[info exists hlview] && $hlview == $n} {
1912 set selectedhlview None
1917 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1918 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1920 if {![info exists viewdata($n)]} {
1922 set pending_select $selid
1929 set phase [lindex $v 0]
1930 set displayorder $vdisporder($n)
1931 set parentlist $vparentlist($n)
1932 set commitlisted $vcmitlisted($n)
1933 set rowidlist [lindex $v 1]
1934 set rowoffsets [lindex $v 2]
1935 set rowrangelist [lindex $v 3]
1937 set numcommits [llength $displayorder]
1938 catch {unset idrowranges}
1940 unflatten idrowranges [lindex $v 4]
1941 unflatten idinlist [lindex $v 5]
1942 set rowlaidout [lindex $v 6]
1943 set rowoptim [lindex $v 7]
1944 set numcommits [lindex $v 8]
1945 catch {unset rowchk}
1948 catch {unset colormap}
1949 catch {unset rowtextx}
1951 set canvxmax [$canv cget -width]
1958 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1959 set row $commitrow($n,$selid)
1960 # try to get the selected row in the same position on the screen
1961 set ymax [lindex [$canv cget -scrollregion] 3]
1962 set ytop [expr {[yc $row] - $yscreen}]
1966 set yf [expr {$ytop * 1.0 / $ymax}]
1968 allcanvs yview moveto $yf
1972 } elseif {$selid ne {}} {
1973 set pending_select $selid
1975 set row [first_real_row]
1976 if {$row < $numcommits} {
1983 if {$phase eq "getcommits"} {
1984 show_status "Reading commits..."
1987 } elseif {$numcommits == 0} {
1988 show_status "No commits selected"
1992 # Stuff relating to the highlighting facility
1994 proc ishighlighted {row} {
1995 global vhighlights fhighlights nhighlights rhighlights
1997 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1998 return $nhighlights($row)
2000 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2001 return $vhighlights($row)
2003 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2004 return $fhighlights($row)
2006 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2007 return $rhighlights($row)
2012 proc bolden {row font} {
2013 global canv linehtag selectedline boldrows
2015 lappend boldrows $row
2016 $canv itemconf $linehtag($row) -font $font
2017 if {[info exists selectedline] && $row == $selectedline} {
2019 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2020 -outline {{}} -tags secsel \
2021 -fill [$canv cget -selectbackground]]
2026 proc bolden_name {row font} {
2027 global canv2 linentag selectedline boldnamerows
2029 lappend boldnamerows $row
2030 $canv2 itemconf $linentag($row) -font $font
2031 if {[info exists selectedline] && $row == $selectedline} {
2032 $canv2 delete secsel
2033 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2034 -outline {{}} -tags secsel \
2035 -fill [$canv2 cget -selectbackground]]
2041 global mainfont boldrows
2044 foreach row $boldrows {
2045 if {![ishighlighted $row]} {
2046 bolden $row $mainfont
2048 lappend stillbold $row
2051 set boldrows $stillbold
2054 proc addvhighlight {n} {
2055 global hlview curview viewdata vhl_done vhighlights commitidx
2057 if {[info exists hlview]} {
2061 if {$n != $curview && ![info exists viewdata($n)]} {
2062 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2063 set vparentlist($n) {}
2064 set vdisporder($n) {}
2065 set vcmitlisted($n) {}
2068 set vhl_done $commitidx($hlview)
2069 if {$vhl_done > 0} {
2074 proc delvhighlight {} {
2075 global hlview vhighlights
2077 if {![info exists hlview]} return
2079 catch {unset vhighlights}
2083 proc vhighlightmore {} {
2084 global hlview vhl_done commitidx vhighlights
2085 global displayorder vdisporder curview mainfont
2087 set font [concat $mainfont bold]
2088 set max $commitidx($hlview)
2089 if {$hlview == $curview} {
2090 set disp $displayorder
2092 set disp $vdisporder($hlview)
2094 set vr [visiblerows]
2095 set r0 [lindex $vr 0]
2096 set r1 [lindex $vr 1]
2097 for {set i $vhl_done} {$i < $max} {incr i} {
2098 set id [lindex $disp $i]
2099 if {[info exists commitrow($curview,$id)]} {
2100 set row $commitrow($curview,$id)
2101 if {$r0 <= $row && $row <= $r1} {
2102 if {![highlighted $row]} {
2105 set vhighlights($row) 1
2112 proc askvhighlight {row id} {
2113 global hlview vhighlights commitrow iddrawn mainfont
2115 if {[info exists commitrow($hlview,$id)]} {
2116 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2117 bolden $row [concat $mainfont bold]
2119 set vhighlights($row) 1
2121 set vhighlights($row) 0
2125 proc hfiles_change {name ix op} {
2126 global highlight_files filehighlight fhighlights fh_serial
2127 global mainfont highlight_paths
2129 if {[info exists filehighlight]} {
2130 # delete previous highlights
2131 catch {close $filehighlight}
2133 catch {unset fhighlights}
2135 unhighlight_filelist
2137 set highlight_paths {}
2138 after cancel do_file_hl $fh_serial
2140 if {$highlight_files ne {}} {
2141 after 300 do_file_hl $fh_serial
2145 proc makepatterns {l} {
2148 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2149 if {[string index $ee end] eq "/"} {
2159 proc do_file_hl {serial} {
2160 global highlight_files filehighlight highlight_paths gdttype fhl_list
2162 if {$gdttype eq "touching paths:"} {
2163 if {[catch {set paths [shellsplit $highlight_files]}]} return
2164 set highlight_paths [makepatterns $paths]
2166 set gdtargs [concat -- $paths]
2168 set gdtargs [list "-S$highlight_files"]
2170 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2171 set filehighlight [open $cmd r+]
2172 fconfigure $filehighlight -blocking 0
2173 filerun $filehighlight readfhighlight
2179 proc flushhighlights {} {
2180 global filehighlight fhl_list
2182 if {[info exists filehighlight]} {
2184 puts $filehighlight ""
2185 flush $filehighlight
2189 proc askfilehighlight {row id} {
2190 global filehighlight fhighlights fhl_list
2192 lappend fhl_list $id
2193 set fhighlights($row) -1
2194 puts $filehighlight $id
2197 proc readfhighlight {} {
2198 global filehighlight fhighlights commitrow curview mainfont iddrawn
2201 if {![info exists filehighlight]} {
2205 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2206 set line [string trim $line]
2207 set i [lsearch -exact $fhl_list $line]
2208 if {$i < 0} continue
2209 for {set j 0} {$j < $i} {incr j} {
2210 set id [lindex $fhl_list $j]
2211 if {[info exists commitrow($curview,$id)]} {
2212 set fhighlights($commitrow($curview,$id)) 0
2215 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2216 if {$line eq {}} continue
2217 if {![info exists commitrow($curview,$line)]} continue
2218 set row $commitrow($curview,$line)
2219 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2220 bolden $row [concat $mainfont bold]
2222 set fhighlights($row) 1
2224 if {[eof $filehighlight]} {
2226 puts "oops, git diff-tree died"
2227 catch {close $filehighlight}
2235 proc find_change {name ix op} {
2236 global nhighlights mainfont boldnamerows
2237 global findstring findpattern findtype
2239 # delete previous highlights, if any
2240 foreach row $boldnamerows {
2241 bolden_name $row $mainfont
2244 catch {unset nhighlights}
2247 if {$findtype ne "Regexp"} {
2248 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2250 set findpattern "*$e*"
2255 proc doesmatch {f} {
2256 global findtype findstring findpattern
2258 if {$findtype eq "Regexp"} {
2259 return [regexp $findstring $f]
2260 } elseif {$findtype eq "IgnCase"} {
2261 return [string match -nocase $findpattern $f]
2263 return [string match $findpattern $f]
2267 proc askfindhighlight {row id} {
2268 global nhighlights commitinfo iddrawn mainfont
2270 global markingmatches
2272 if {![info exists commitinfo($id)]} {
2275 set info $commitinfo($id)
2277 set fldtypes {Headline Author Date Committer CDate Comments}
2278 foreach f $info ty $fldtypes {
2279 if {($findloc eq "All fields" || $findloc eq $ty) &&
2281 if {$ty eq "Author"} {
2288 if {$isbold && [info exists iddrawn($id)]} {
2289 set f [concat $mainfont bold]
2290 if {![ishighlighted $row]} {
2296 if {$markingmatches} {
2297 markrowmatches $row $id
2300 set nhighlights($row) $isbold
2303 proc markrowmatches {row id} {
2304 global canv canv2 linehtag linentag commitinfo findloc
2306 set headline [lindex $commitinfo($id) 0]
2307 set author [lindex $commitinfo($id) 1]
2308 $canv delete match$row
2309 $canv2 delete match$row
2310 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2311 set m [findmatches $headline]
2313 markmatches $canv $row $headline $linehtag($row) $m \
2314 [$canv itemcget $linehtag($row) -font] $row
2317 if {$findloc eq "All fields" || $findloc eq "Author"} {
2318 set m [findmatches $author]
2320 markmatches $canv2 $row $author $linentag($row) $m \
2321 [$canv2 itemcget $linentag($row) -font] $row
2326 proc vrel_change {name ix op} {
2327 global highlight_related
2330 if {$highlight_related ne "None"} {
2335 # prepare for testing whether commits are descendents or ancestors of a
2336 proc rhighlight_sel {a} {
2337 global descendent desc_todo ancestor anc_todo
2338 global highlight_related rhighlights
2340 catch {unset descendent}
2341 set desc_todo [list $a]
2342 catch {unset ancestor}
2343 set anc_todo [list $a]
2344 if {$highlight_related ne "None"} {
2350 proc rhighlight_none {} {
2353 catch {unset rhighlights}
2357 proc is_descendent {a} {
2358 global curview children commitrow descendent desc_todo
2361 set la $commitrow($v,$a)
2365 for {set i 0} {$i < [llength $todo]} {incr i} {
2366 set do [lindex $todo $i]
2367 if {$commitrow($v,$do) < $la} {
2368 lappend leftover $do
2371 foreach nk $children($v,$do) {
2372 if {![info exists descendent($nk)]} {
2373 set descendent($nk) 1
2381 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2385 set descendent($a) 0
2386 set desc_todo $leftover
2389 proc is_ancestor {a} {
2390 global curview parentlist commitrow ancestor anc_todo
2393 set la $commitrow($v,$a)
2397 for {set i 0} {$i < [llength $todo]} {incr i} {
2398 set do [lindex $todo $i]
2399 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2400 lappend leftover $do
2403 foreach np [lindex $parentlist $commitrow($v,$do)] {
2404 if {![info exists ancestor($np)]} {
2413 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2418 set anc_todo $leftover
2421 proc askrelhighlight {row id} {
2422 global descendent highlight_related iddrawn mainfont rhighlights
2423 global selectedline ancestor
2425 if {![info exists selectedline]} return
2427 if {$highlight_related eq "Descendent" ||
2428 $highlight_related eq "Not descendent"} {
2429 if {![info exists descendent($id)]} {
2432 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2435 } elseif {$highlight_related eq "Ancestor" ||
2436 $highlight_related eq "Not ancestor"} {
2437 if {![info exists ancestor($id)]} {
2440 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2444 if {[info exists iddrawn($id)]} {
2445 if {$isbold && ![ishighlighted $row]} {
2446 bolden $row [concat $mainfont bold]
2449 set rhighlights($row) $isbold
2452 proc next_hlcont {} {
2453 global fhl_row fhl_dirn displayorder numcommits
2454 global vhighlights fhighlights nhighlights rhighlights
2455 global hlview filehighlight findstring highlight_related
2457 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2460 if {$row < 0 || $row >= $numcommits} {
2465 set id [lindex $displayorder $row]
2466 if {[info exists hlview]} {
2467 if {![info exists vhighlights($row)]} {
2468 askvhighlight $row $id
2470 if {$vhighlights($row) > 0} break
2472 if {$findstring ne {}} {
2473 if {![info exists nhighlights($row)]} {
2474 askfindhighlight $row $id
2476 if {$nhighlights($row) > 0} break
2478 if {$highlight_related ne "None"} {
2479 if {![info exists rhighlights($row)]} {
2480 askrelhighlight $row $id
2482 if {$rhighlights($row) > 0} break
2484 if {[info exists filehighlight]} {
2485 if {![info exists fhighlights($row)]} {
2486 # ask for a few more while we're at it...
2488 for {set n 0} {$n < 100} {incr n} {
2489 if {![info exists fhighlights($r)]} {
2490 askfilehighlight $r [lindex $displayorder $r]
2493 if {$r < 0 || $r >= $numcommits} break
2497 if {$fhighlights($row) < 0} {
2501 if {$fhighlights($row) > 0} break
2509 proc next_highlight {dirn} {
2510 global selectedline fhl_row fhl_dirn
2511 global hlview filehighlight findstring highlight_related
2513 if {![info exists selectedline]} return
2514 if {!([info exists hlview] || $findstring ne {} ||
2515 $highlight_related ne "None" || [info exists filehighlight])} return
2516 set fhl_row [expr {$selectedline + $dirn}]
2521 proc cancel_next_highlight {} {
2527 # Graph layout functions
2529 proc shortids {ids} {
2532 if {[llength $id] > 1} {
2533 lappend res [shortids $id]
2534 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2535 lappend res [string range $id 0 7]
2543 proc incrange {l x o} {
2546 set e [lindex $l $x]
2548 lset l $x [expr {$e + $o}]
2557 for {} {$n > 0} {incr n -1} {
2563 proc usedinrange {id l1 l2} {
2564 global children commitrow curview
2566 if {[info exists commitrow($curview,$id)]} {
2567 set r $commitrow($curview,$id)
2568 if {$l1 <= $r && $r <= $l2} {
2569 return [expr {$r - $l1 + 1}]
2572 set kids $children($curview,$id)
2574 set r $commitrow($curview,$c)
2575 if {$l1 <= $r && $r <= $l2} {
2576 return [expr {$r - $l1 + 1}]
2582 proc sanity {row {full 0}} {
2583 global rowidlist rowoffsets
2586 set ids [lindex $rowidlist $row]
2589 if {$id eq {}} continue
2590 if {$col < [llength $ids] - 1 &&
2591 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2592 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2594 set o [lindex $rowoffsets $row $col]
2600 if {[lindex $rowidlist $y $x] != $id} {
2601 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2602 puts " id=[shortids $id] check started at row $row"
2603 for {set i $row} {$i >= $y} {incr i -1} {
2604 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2609 set o [lindex $rowoffsets $y $x]
2614 proc makeuparrow {oid x y z} {
2615 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2617 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2620 set off0 [lindex $rowoffsets $y]
2621 for {set x0 $x} {1} {incr x0} {
2622 if {$x0 >= [llength $off0]} {
2623 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2626 set z [lindex $off0 $x0]
2632 set z [expr {$x0 - $x}]
2633 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2634 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2636 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2637 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2638 lappend idrowranges($oid) [lindex $displayorder $y]
2641 proc initlayout {} {
2642 global rowidlist rowoffsets displayorder commitlisted
2643 global rowlaidout rowoptim
2644 global idinlist rowchk rowrangelist idrowranges
2645 global numcommits canvxmax canv
2648 global colormap rowtextx
2659 catch {unset idinlist}
2660 catch {unset rowchk}
2663 set canvxmax [$canv cget -width]
2664 catch {unset colormap}
2665 catch {unset rowtextx}
2666 catch {unset idrowranges}
2670 proc setcanvscroll {} {
2671 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2673 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2674 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2675 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2676 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2679 proc visiblerows {} {
2680 global canv numcommits linespc
2682 set ymax [lindex [$canv cget -scrollregion] 3]
2683 if {$ymax eq {} || $ymax == 0} return
2685 set y0 [expr {int([lindex $f 0] * $ymax)}]
2686 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2690 set y1 [expr {int([lindex $f 1] * $ymax)}]
2691 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2692 if {$r1 >= $numcommits} {
2693 set r1 [expr {$numcommits - 1}]
2695 return [list $r0 $r1]
2698 proc layoutmore {tmax allread} {
2699 global rowlaidout rowoptim commitidx numcommits optim_delay
2700 global uparrowlen curview rowidlist idinlist
2703 set showdelay $optim_delay
2704 set optdelay [expr {$uparrowlen + 1}]
2706 if {$rowoptim - $showdelay > $numcommits} {
2707 showstuff [expr {$rowoptim - $showdelay}] $showlast
2708 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2709 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2713 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2715 } elseif {$commitidx($curview) > $rowlaidout} {
2716 set nr [expr {$commitidx($curview) - $rowlaidout}]
2717 # may need to increase this threshold if uparrowlen or
2718 # mingaplen are increased...
2723 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2724 if {$rowlaidout == $row} {
2727 } elseif {$allread} {
2729 set nrows $commitidx($curview)
2730 if {[lindex $rowidlist $nrows] ne {} ||
2731 [array names idinlist] ne {}} {
2733 set rowlaidout $commitidx($curview)
2734 } elseif {$rowoptim == $nrows} {
2737 if {$numcommits == $nrows} {
2744 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2750 proc showstuff {canshow last} {
2751 global numcommits commitrow pending_select selectedline curview
2752 global lookingforhead mainheadid displayorder selectfirst
2753 global lastscrollset
2755 if {$numcommits == 0} {
2757 set phase "incrdraw"
2761 set prev $numcommits
2762 set numcommits $canshow
2763 set t [clock clicks -milliseconds]
2764 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2765 set lastscrollset $t
2768 set rows [visiblerows]
2769 set r1 [lindex $rows 1]
2770 if {$r1 >= $canshow} {
2771 set r1 [expr {$canshow - 1}]
2776 if {[info exists pending_select] &&
2777 [info exists commitrow($curview,$pending_select)] &&
2778 $commitrow($curview,$pending_select) < $numcommits} {
2779 selectline $commitrow($curview,$pending_select) 1
2782 if {[info exists selectedline] || [info exists pending_select]} {
2785 set l [first_real_row]
2790 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2791 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2792 set lookingforhead 0
2797 proc doshowlocalchanges {} {
2798 global lookingforhead curview mainheadid phase commitrow
2800 if {[info exists commitrow($curview,$mainheadid)] &&
2801 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2803 } elseif {$phase ne {}} {
2804 set lookingforhead 1
2808 proc dohidelocalchanges {} {
2809 global lookingforhead localfrow localirow lserial
2811 set lookingforhead 0
2812 if {$localfrow >= 0} {
2813 removerow $localfrow
2815 if {$localirow > 0} {
2819 if {$localirow >= 0} {
2820 removerow $localirow
2826 # spawn off a process to do git diff-index --cached HEAD
2827 proc dodiffindex {} {
2828 global localirow localfrow lserial
2833 set fd [open "|git diff-index --cached HEAD" r]
2834 fconfigure $fd -blocking 0
2835 filerun $fd [list readdiffindex $fd $lserial]
2838 proc readdiffindex {fd serial} {
2839 global localirow commitrow mainheadid nullid2 curview
2840 global commitinfo commitdata lserial
2843 if {[gets $fd line] < 0} {
2849 # we only need to see one line and we don't really care what it says...
2852 # now see if there are any local changes not checked in to the index
2853 if {$serial == $lserial} {
2854 set fd [open "|git diff-files" r]
2855 fconfigure $fd -blocking 0
2856 filerun $fd [list readdifffiles $fd $serial]
2859 if {$isdiff && $serial == $lserial && $localirow == -1} {
2860 # add the line for the changes in the index to the graph
2861 set localirow $commitrow($curview,$mainheadid)
2862 set hl "Local changes checked in to index but not committed"
2863 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2864 set commitdata($nullid2) "\n $hl\n"
2865 insertrow $localirow $nullid2
2870 proc readdifffiles {fd serial} {
2871 global localirow localfrow commitrow mainheadid nullid curview
2872 global commitinfo commitdata lserial
2875 if {[gets $fd line] < 0} {
2881 # we only need to see one line and we don't really care what it says...
2884 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2885 # add the line for the local diff to the graph
2886 if {$localirow >= 0} {
2887 set localfrow $localirow
2890 set localfrow $commitrow($curview,$mainheadid)
2892 set hl "Local uncommitted changes, not checked in to index"
2893 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2894 set commitdata($nullid) "\n $hl\n"
2895 insertrow $localfrow $nullid
2900 proc layoutrows {row endrow last} {
2901 global rowidlist rowoffsets displayorder
2902 global uparrowlen downarrowlen maxwidth mingaplen
2903 global children parentlist
2905 global commitidx curview
2906 global idinlist rowchk rowrangelist
2908 set idlist [lindex $rowidlist $row]
2909 set offs [lindex $rowoffsets $row]
2910 while {$row < $endrow} {
2911 set id [lindex $displayorder $row]
2912 set nev [expr {[llength $idlist] - $maxwidth + 1}]
2913 foreach p [lindex $parentlist $row] {
2914 if {![info exists idinlist($p)] || !$idinlist($p)} {
2920 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2921 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2922 set i [lindex $idlist $x]
2923 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2924 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2925 [expr {$row + $uparrowlen + $mingaplen}]]
2927 set idlist [lreplace $idlist $x $x]
2928 set offs [lreplace $offs $x $x]
2929 set offs [incrange $offs $x 1]
2931 set rm1 [expr {$row - 1}]
2932 lappend idrowranges($i) [lindex $displayorder $rm1]
2933 if {[incr nev -1] <= 0} break
2936 set rowchk($i) [expr {$row + $r}]
2939 lset rowidlist $row $idlist
2940 lset rowoffsets $row $offs
2944 foreach p [lindex $parentlist $row] {
2945 if {![info exists idinlist($p)]} {
2947 } elseif {!$idinlist($p)} {
2952 set col [lsearch -exact $idlist $id]
2954 set col [llength $idlist]
2956 lset rowidlist $row $idlist
2958 if {$children($curview,$id) ne {}} {
2959 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2963 lset rowoffsets $row $offs
2965 makeuparrow $id $col $row $z
2971 if {[info exists idrowranges($id)]} {
2972 set ranges $idrowranges($id)
2974 unset idrowranges($id)
2976 lappend rowrangelist $ranges
2978 set offs [ntimes [llength $idlist] 0]
2979 set l [llength $newolds]
2980 set idlist [eval lreplace \$idlist $col $col $newolds]
2983 set offs [lrange $offs 0 [expr {$col - 1}]]
2984 foreach x $newolds {
2989 set tmp [expr {[llength $idlist] - [llength $offs]}]
2991 set offs [concat $offs [ntimes $tmp $o]]
2996 foreach i $newolds {
2997 set idrowranges($i) $id
3000 foreach oid $oldolds {
3001 set idlist [linsert $idlist $col $oid]
3002 set offs [linsert $offs $col $o]
3003 makeuparrow $oid $col $row $o
3006 lappend rowidlist $idlist
3007 lappend rowoffsets $offs
3012 proc addextraid {id row} {
3013 global displayorder commitrow commitinfo
3014 global commitidx commitlisted
3015 global parentlist children curview
3017 incr commitidx($curview)
3018 lappend displayorder $id
3019 lappend commitlisted 0
3020 lappend parentlist {}
3021 set commitrow($curview,$id) $row
3023 if {![info exists commitinfo($id)]} {
3024 set commitinfo($id) {"No commit information available"}
3026 if {![info exists children($curview,$id)]} {
3027 set children($curview,$id) {}
3031 proc layouttail {} {
3032 global rowidlist rowoffsets idinlist commitidx curview
3033 global idrowranges rowrangelist
3035 set row $commitidx($curview)
3036 set idlist [lindex $rowidlist $row]
3037 while {$idlist ne {}} {
3038 set col [expr {[llength $idlist] - 1}]
3039 set id [lindex $idlist $col]
3041 catch {unset idinlist($id)}
3042 lappend idrowranges($id) $id
3043 lappend rowrangelist $idrowranges($id)
3044 unset idrowranges($id)
3046 set offs [ntimes $col 0]
3047 set idlist [lreplace $idlist $col $col]
3048 lappend rowidlist $idlist
3049 lappend rowoffsets $offs
3052 foreach id [array names idinlist] {
3055 lset rowidlist $row [list $id]
3056 lset rowoffsets $row 0
3057 makeuparrow $id 0 $row 0
3058 lappend idrowranges($id) $id
3059 lappend rowrangelist $idrowranges($id)
3060 unset idrowranges($id)
3062 lappend rowidlist {}
3063 lappend rowoffsets {}
3067 proc insert_pad {row col npad} {
3068 global rowidlist rowoffsets
3070 set pad [ntimes $npad {}]
3071 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3072 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3073 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3076 proc optimize_rows {row col endrow} {
3077 global rowidlist rowoffsets displayorder
3079 for {} {$row < $endrow} {incr row} {
3080 set idlist [lindex $rowidlist $row]
3081 set offs [lindex $rowoffsets $row]
3083 for {} {$col < [llength $offs]} {incr col} {
3084 if {[lindex $idlist $col] eq {}} {
3088 set z [lindex $offs $col]
3089 if {$z eq {}} continue
3091 set x0 [expr {$col + $z}]
3092 set y0 [expr {$row - 1}]
3093 set z0 [lindex $rowoffsets $y0 $x0]
3095 set id [lindex $idlist $col]
3096 set ranges [rowranges $id]
3097 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3101 # Looking at lines from this row to the previous row,
3102 # make them go straight up if they end in an arrow on
3103 # the previous row; otherwise make them go straight up
3105 if {$z < -1 || ($z < 0 && $isarrow)} {
3106 # Line currently goes left too much;
3107 # insert pads in the previous row, then optimize it
3108 set npad [expr {-1 - $z + $isarrow}]
3109 set offs [incrange $offs $col $npad]
3110 insert_pad $y0 $x0 $npad
3112 optimize_rows $y0 $x0 $row
3114 set z [lindex $offs $col]
3115 set x0 [expr {$col + $z}]
3116 set z0 [lindex $rowoffsets $y0 $x0]
3117 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3118 # Line currently goes right too much;
3119 # insert pads in this line and adjust the next's rowoffsets
3120 set npad [expr {$z - 1 + $isarrow}]
3121 set y1 [expr {$row + 1}]
3122 set offs2 [lindex $rowoffsets $y1]
3126 if {$z eq {} || $x1 + $z < $col} continue
3127 if {$x1 + $z > $col} {
3130 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3133 set pad [ntimes $npad {}]
3134 set idlist [eval linsert \$idlist $col $pad]
3135 set tmp [eval linsert \$offs $col $pad]
3137 set offs [incrange $tmp $col [expr {-$npad}]]
3138 set z [lindex $offs $col]
3141 if {$z0 eq {} && !$isarrow} {
3142 # this line links to its first child on row $row-2
3143 set rm2 [expr {$row - 2}]
3144 set id [lindex $displayorder $rm2]
3145 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3147 set z0 [expr {$xc - $x0}]
3150 # avoid lines jigging left then immediately right
3151 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3152 insert_pad $y0 $x0 1
3153 set offs [incrange $offs $col 1]
3154 optimize_rows $y0 [expr {$x0 + 1}] $row
3159 # Find the first column that doesn't have a line going right
3160 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3161 set o [lindex $offs $col]
3163 # check if this is the link to the first child
3164 set id [lindex $idlist $col]
3165 set ranges [rowranges $id]
3166 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3167 # it is, work out offset to child
3168 set y0 [expr {$row - 1}]
3169 set id [lindex $displayorder $y0]
3170 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3172 set o [expr {$x0 - $col}]
3176 if {$o eq {} || $o <= 0} break
3178 # Insert a pad at that column as long as it has a line and
3179 # isn't the last column, and adjust the next row' offsets
3180 if {$o ne {} && [incr col] < [llength $idlist]} {
3181 set y1 [expr {$row + 1}]
3182 set offs2 [lindex $rowoffsets $y1]
3186 if {$z eq {} || $x1 + $z < $col} continue
3187 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3190 set idlist [linsert $idlist $col {}]
3191 set tmp [linsert $offs $col {}]
3193 set offs [incrange $tmp $col -1]
3196 lset rowidlist $row $idlist
3197 lset rowoffsets $row $offs
3203 global canvx0 linespc
3204 return [expr {$canvx0 + $col * $linespc}]
3208 global canvy0 linespc
3209 return [expr {$canvy0 + $row * $linespc}]
3212 proc linewidth {id} {
3213 global thickerline lthickness
3216 if {[info exists thickerline] && $id eq $thickerline} {
3217 set wid [expr {2 * $lthickness}]
3222 proc rowranges {id} {
3223 global phase idrowranges commitrow rowlaidout rowrangelist curview
3227 ([info exists commitrow($curview,$id)]
3228 && $commitrow($curview,$id) < $rowlaidout)} {
3229 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3230 } elseif {[info exists idrowranges($id)]} {
3231 set ranges $idrowranges($id)
3234 foreach rid $ranges {
3235 lappend linenos $commitrow($curview,$rid)
3237 if {$linenos ne {}} {
3238 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3243 # work around tk8.4 refusal to draw arrows on diagonal segments
3244 proc adjarrowhigh {coords} {
3247 set x0 [lindex $coords 0]
3248 set x1 [lindex $coords 2]
3250 set y0 [lindex $coords 1]
3251 set y1 [lindex $coords 3]
3252 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3253 # we have a nearby vertical segment, just trim off the diag bit
3254 set coords [lrange $coords 2 end]
3256 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3257 set xi [expr {$x0 - $slope * $linespc / 2}]
3258 set yi [expr {$y0 - $linespc / 2}]
3259 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3265 proc drawlineseg {id row endrow arrowlow} {
3266 global rowidlist displayorder iddrawn linesegs
3267 global canv colormap linespc curview maxlinelen
3269 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3270 set le [expr {$row + 1}]
3273 set c [lsearch -exact [lindex $rowidlist $le] $id]
3279 set x [lindex $displayorder $le]
3284 if {[info exists iddrawn($x)] || $le == $endrow} {
3285 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3301 if {[info exists linesegs($id)]} {
3302 set lines $linesegs($id)
3304 set r0 [lindex $li 0]
3306 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3316 set li [lindex $lines [expr {$i-1}]]
3317 set r1 [lindex $li 1]
3318 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3323 set x [lindex $cols [expr {$le - $row}]]
3324 set xp [lindex $cols [expr {$le - 1 - $row}]]
3325 set dir [expr {$xp - $x}]
3327 set ith [lindex $lines $i 2]
3328 set coords [$canv coords $ith]
3329 set ah [$canv itemcget $ith -arrow]
3330 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3331 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3332 if {$x2 ne {} && $x - $x2 == $dir} {
3333 set coords [lrange $coords 0 end-2]
3336 set coords [list [xc $le $x] [yc $le]]
3339 set itl [lindex $lines [expr {$i-1}] 2]
3340 set al [$canv itemcget $itl -arrow]
3341 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3342 } elseif {$arrowlow &&
3343 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3346 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3347 for {set y $le} {[incr y -1] > $row} {} {
3349 set xp [lindex $cols [expr {$y - 1 - $row}]]
3350 set ndir [expr {$xp - $x}]
3351 if {$dir != $ndir || $xp < 0} {
3352 lappend coords [xc $y $x] [yc $y]
3358 # join parent line to first child
3359 set ch [lindex $displayorder $row]
3360 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3362 puts "oops: drawlineseg: child $ch not on row $row"
3365 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3366 } elseif {$xc > $x + 1} {
3367 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3371 lappend coords [xc $row $x] [yc $row]
3373 set xn [xc $row $xp]
3375 # work around tk8.4 refusal to draw arrows on diagonal segments
3376 if {$arrowlow && $xn != [lindex $coords end-1]} {
3377 if {[llength $coords] < 4 ||
3378 [lindex $coords end-3] != [lindex $coords end-1] ||
3379 [lindex $coords end] - $yn > 2 * $linespc} {
3380 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3381 set yo [yc [expr {$row + 0.5}]]
3382 lappend coords $xn $yo $xn $yn
3385 lappend coords $xn $yn
3390 set coords [adjarrowhigh $coords]
3393 set t [$canv create line $coords -width [linewidth $id] \
3394 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3397 set lines [linsert $lines $i [list $row $le $t]]
3399 $canv coords $ith $coords
3400 if {$arrow ne $ah} {
3401 $canv itemconf $ith -arrow $arrow
3403 lset lines $i 0 $row
3406 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3407 set ndir [expr {$xo - $xp}]
3408 set clow [$canv coords $itl]
3409 if {$dir == $ndir} {
3410 set clow [lrange $clow 2 end]
3412 set coords [concat $coords $clow]
3414 lset lines [expr {$i-1}] 1 $le
3416 set coords [adjarrowhigh $coords]
3419 # coalesce two pieces
3421 set b [lindex $lines [expr {$i-1}] 0]
3422 set e [lindex $lines $i 1]
3423 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3425 $canv coords $itl $coords
3426 if {$arrow ne $al} {
3427 $canv itemconf $itl -arrow $arrow
3431 set linesegs($id) $lines
3435 proc drawparentlinks {id row} {
3436 global rowidlist canv colormap curview parentlist
3439 set rowids [lindex $rowidlist $row]
3440 set col [lsearch -exact $rowids $id]
3441 if {$col < 0} return
3442 set olds [lindex $parentlist $row]
3443 set row2 [expr {$row + 1}]
3444 set x [xc $row $col]
3447 set ids [lindex $rowidlist $row2]
3448 # rmx = right-most X coord used
3451 set i [lsearch -exact $ids $p]
3453 puts "oops, parent $p of $id not in list"
3456 set x2 [xc $row2 $i]
3460 if {[lsearch -exact $rowids $p] < 0} {
3461 # drawlineseg will do this one for us
3465 # should handle duplicated parents here...
3466 set coords [list $x $y]
3467 if {$i < $col - 1} {
3468 lappend coords [xc $row [expr {$i + 1}]] $y
3469 } elseif {$i > $col + 1} {
3470 lappend coords [xc $row [expr {$i - 1}]] $y
3472 lappend coords $x2 $y2
3473 set t [$canv create line $coords -width [linewidth $p] \
3474 -fill $colormap($p) -tags lines.$p]
3478 if {$rmx > [lindex $idpos($id) 1]} {
3479 lset idpos($id) 1 $rmx
3484 proc drawlines {id} {
3487 $canv itemconf lines.$id -width [linewidth $id]
3490 proc drawcmittext {id row col} {
3491 global linespc canv canv2 canv3 canvy0 fgcolor curview
3492 global commitlisted commitinfo rowidlist parentlist
3493 global rowtextx idpos idtags idheads idotherrefs
3494 global linehtag linentag linedtag
3495 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3497 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3498 set listed [lindex $commitlisted $row]
3499 if {$id eq $nullid} {
3501 } elseif {$id eq $nullid2} {
3504 set ofill [expr {$listed != 0? "blue": "white"}]
3506 set x [xc $row $col]
3508 set orad [expr {$linespc / 3}]
3510 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3511 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3512 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3513 } elseif {$listed == 2} {
3514 # triangle pointing left for left-side commits
3515 set t [$canv create polygon \
3516 [expr {$x - $orad}] $y \
3517 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3518 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3519 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3521 # triangle pointing right for right-side commits
3522 set t [$canv create polygon \
3523 [expr {$x + $orad - 1}] $y \
3524 [expr {$x - $orad}] [expr {$y - $orad}] \
3525 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3526 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3529 $canv bind $t <1> {selcanvline {} %x %y}
3530 set rmx [llength [lindex $rowidlist $row]]
3531 set olds [lindex $parentlist $row]
3533 set nextids [lindex $rowidlist [expr {$row + 1}]]
3535 set i [lsearch -exact $nextids $p]
3541 set xt [xc $row $rmx]
3542 set rowtextx($row) $xt
3543 set idpos($id) [list $x $xt $y]
3544 if {[info exists idtags($id)] || [info exists idheads($id)]
3545 || [info exists idotherrefs($id)]} {
3546 set xt [drawtags $id $x $xt $y]
3548 set headline [lindex $commitinfo($id) 0]
3549 set name [lindex $commitinfo($id) 1]
3550 set date [lindex $commitinfo($id) 2]
3551 set date [formatdate $date]
3554 set isbold [ishighlighted $row]
3556 lappend boldrows $row
3559 lappend boldnamerows $row
3563 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3564 -text $headline -font $font -tags text]
3565 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3566 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3567 -text $name -font $nfont -tags text]
3568 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3569 -text $date -font $mainfont -tags text]
3570 set xr [expr {$xt + [font measure $mainfont $headline]}]
3571 if {$xr > $canvxmax} {
3577 proc drawcmitrow {row} {
3578 global displayorder rowidlist
3579 global iddrawn markingmatches
3580 global commitinfo parentlist numcommits
3581 global filehighlight fhighlights findstring nhighlights
3582 global hlview vhighlights
3583 global highlight_related rhighlights
3585 if {$row >= $numcommits} return
3587 set id [lindex $displayorder $row]
3588 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3589 askvhighlight $row $id
3591 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3592 askfilehighlight $row $id
3594 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3595 askfindhighlight $row $id
3597 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3598 askrelhighlight $row $id
3600 if {![info exists iddrawn($id)]} {
3601 set col [lsearch -exact [lindex $rowidlist $row] $id]
3603 puts "oops, row $row id $id not in list"
3606 if {![info exists commitinfo($id)]} {
3610 drawcmittext $id $row $col
3613 if {$markingmatches} {
3614 markrowmatches $row $id
3618 proc drawcommits {row {endrow {}}} {
3619 global numcommits iddrawn displayorder curview
3620 global parentlist rowidlist
3625 if {$endrow eq {}} {
3628 if {$endrow >= $numcommits} {
3629 set endrow [expr {$numcommits - 1}]
3632 # make the lines join to already-drawn rows either side
3633 set r [expr {$row - 1}]
3634 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3637 set er [expr {$endrow + 1}]
3638 if {$er >= $numcommits ||
3639 ![info exists iddrawn([lindex $displayorder $er])]} {
3642 for {} {$r <= $er} {incr r} {
3643 set id [lindex $displayorder $r]
3644 set wasdrawn [info exists iddrawn($id)]
3646 if {$r == $er} break
3647 set nextid [lindex $displayorder [expr {$r + 1}]]
3648 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3649 catch {unset prevlines}
3652 drawparentlinks $id $r
3654 if {[info exists lineends($r)]} {
3655 foreach lid $lineends($r) {
3656 unset prevlines($lid)
3659 set rowids [lindex $rowidlist $r]
3660 foreach lid $rowids {
3661 if {$lid eq {}} continue
3663 # see if this is the first child of any of its parents
3664 foreach p [lindex $parentlist $r] {
3665 if {[lsearch -exact $rowids $p] < 0} {
3666 # make this line extend up to the child
3667 set le [drawlineseg $p $r $er 0]
3668 lappend lineends($le) $p
3672 } elseif {![info exists prevlines($lid)]} {
3673 set le [drawlineseg $lid $r $er 1]
3674 lappend lineends($le) $lid
3675 set prevlines($lid) 1
3681 proc drawfrac {f0 f1} {
3684 set ymax [lindex [$canv cget -scrollregion] 3]
3685 if {$ymax eq {} || $ymax == 0} return
3686 set y0 [expr {int($f0 * $ymax)}]
3687 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3688 set y1 [expr {int($f1 * $ymax)}]
3689 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3690 drawcommits $row $endrow
3693 proc drawvisible {} {
3695 eval drawfrac [$canv yview]
3698 proc clear_display {} {
3699 global iddrawn linesegs
3700 global vhighlights fhighlights nhighlights rhighlights
3703 catch {unset iddrawn}
3704 catch {unset linesegs}
3705 catch {unset vhighlights}
3706 catch {unset fhighlights}
3707 catch {unset nhighlights}
3708 catch {unset rhighlights}
3711 proc findcrossings {id} {
3712 global rowidlist parentlist numcommits rowoffsets displayorder
3716 foreach {s e} [rowranges $id] {
3717 if {$e >= $numcommits} {
3718 set e [expr {$numcommits - 1}]
3720 if {$e <= $s} continue
3721 set x [lsearch -exact [lindex $rowidlist $e] $id]
3723 puts "findcrossings: oops, no [shortids $id] in row $e"
3726 for {set row $e} {[incr row -1] >= $s} {} {
3727 set olds [lindex $parentlist $row]
3728 set kid [lindex $displayorder $row]
3729 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3730 if {$kidx < 0} continue
3731 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3733 set px [lsearch -exact $nextrow $p]
3734 if {$px < 0} continue
3735 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3736 if {[lsearch -exact $ccross $p] >= 0} continue
3737 if {$x == $px + ($kidx < $px? -1: 1)} {
3739 } elseif {[lsearch -exact $cross $p] < 0} {
3744 set inc [lindex $rowoffsets $row $x]
3745 if {$inc eq {}} break
3749 return [concat $ccross {{}} $cross]
3752 proc assigncolor {id} {
3753 global colormap colors nextcolor
3754 global commitrow parentlist children children curview
3756 if {[info exists colormap($id)]} return
3757 set ncolors [llength $colors]
3758 if {[info exists children($curview,$id)]} {
3759 set kids $children($curview,$id)
3763 if {[llength $kids] == 1} {
3764 set child [lindex $kids 0]
3765 if {[info exists colormap($child)]
3766 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3767 set colormap($id) $colormap($child)
3773 foreach x [findcrossings $id] {
3775 # delimiter between corner crossings and other crossings
3776 if {[llength $badcolors] >= $ncolors - 1} break
3777 set origbad $badcolors
3779 if {[info exists colormap($x)]
3780 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3781 lappend badcolors $colormap($x)
3784 if {[llength $badcolors] >= $ncolors} {
3785 set badcolors $origbad
3787 set origbad $badcolors
3788 if {[llength $badcolors] < $ncolors - 1} {
3789 foreach child $kids {
3790 if {[info exists colormap($child)]
3791 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3792 lappend badcolors $colormap($child)
3794 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3795 if {[info exists colormap($p)]
3796 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3797 lappend badcolors $colormap($p)
3801 if {[llength $badcolors] >= $ncolors} {
3802 set badcolors $origbad
3805 for {set i 0} {$i <= $ncolors} {incr i} {
3806 set c [lindex $colors $nextcolor]
3807 if {[incr nextcolor] >= $ncolors} {
3810 if {[lsearch -exact $badcolors $c]} break
3812 set colormap($id) $c
3815 proc bindline {t id} {
3818 $canv bind $t <Enter> "lineenter %x %y $id"
3819 $canv bind $t <Motion> "linemotion %x %y $id"
3820 $canv bind $t <Leave> "lineleave $id"
3821 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3824 proc drawtags {id x xt y1} {
3825 global idtags idheads idotherrefs mainhead
3826 global linespc lthickness
3827 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3832 if {[info exists idtags($id)]} {
3833 set marks $idtags($id)
3834 set ntags [llength $marks]
3836 if {[info exists idheads($id)]} {
3837 set marks [concat $marks $idheads($id)]
3838 set nheads [llength $idheads($id)]
3840 if {[info exists idotherrefs($id)]} {
3841 set marks [concat $marks $idotherrefs($id)]
3847 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3848 set yt [expr {$y1 - 0.5 * $linespc}]
3849 set yb [expr {$yt + $linespc - 1}]
3853 foreach tag $marks {
3855 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3856 set wid [font measure [concat $mainfont bold] $tag]
3858 set wid [font measure $mainfont $tag]
3862 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3864 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3865 -width $lthickness -fill black -tags tag.$id]
3867 foreach tag $marks x $xvals wid $wvals {
3868 set xl [expr {$x + $delta}]
3869 set xr [expr {$x + $delta + $wid + $lthickness}]
3871 if {[incr ntags -1] >= 0} {
3873 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3874 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3875 -width 1 -outline black -fill yellow -tags tag.$id]
3876 $canv bind $t <1> [list showtag $tag 1]
3877 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3879 # draw a head or other ref
3880 if {[incr nheads -1] >= 0} {
3882 if {$tag eq $mainhead} {
3888 set xl [expr {$xl - $delta/2}]
3889 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3890 -width 1 -outline black -fill $col -tags tag.$id
3891 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3892 set rwid [font measure $mainfont $remoteprefix]
3893 set xi [expr {$x + 1}]
3894 set yti [expr {$yt + 1}]
3895 set xri [expr {$x + $rwid}]
3896 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3897 -width 0 -fill "#ffddaa" -tags tag.$id
3900 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3901 -font $font -tags [list tag.$id text]]
3903 $canv bind $t <1> [list showtag $tag 1]
3904 } elseif {$nheads >= 0} {
3905 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3911 proc xcoord {i level ln} {
3912 global canvx0 xspc1 xspc2
3914 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3915 if {$i > 0 && $i == $level} {
3916 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3917 } elseif {$i > $level} {
3918 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3923 proc show_status {msg} {
3924 global canv mainfont fgcolor
3927 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3928 -tags text -fill $fgcolor
3931 # Insert a new commit as the child of the commit on row $row.
3932 # The new commit will be displayed on row $row and the commits
3933 # on that row and below will move down one row.
3934 proc insertrow {row newcmit} {
3935 global displayorder parentlist commitlisted children
3936 global commitrow curview rowidlist rowoffsets numcommits
3937 global rowrangelist rowlaidout rowoptim numcommits
3938 global selectedline rowchk commitidx
3940 if {$row >= $numcommits} {
3941 puts "oops, inserting new row $row but only have $numcommits rows"
3944 set p [lindex $displayorder $row]
3945 set displayorder [linsert $displayorder $row $newcmit]
3946 set parentlist [linsert $parentlist $row $p]
3947 set kids $children($curview,$p)
3948 lappend kids $newcmit
3949 set children($curview,$p) $kids
3950 set children($curview,$newcmit) {}
3951 set commitlisted [linsert $commitlisted $row 1]
3952 set l [llength $displayorder]
3953 for {set r $row} {$r < $l} {incr r} {
3954 set id [lindex $displayorder $r]
3955 set commitrow($curview,$id) $r
3957 incr commitidx($curview)
3959 set idlist [lindex $rowidlist $row]
3960 set offs [lindex $rowoffsets $row]
3963 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3969 if {[llength $kids] == 1} {
3970 set col [lsearch -exact $idlist $p]
3971 lset idlist $col $newcmit
3973 set col [llength $idlist]
3974 lappend idlist $newcmit
3976 lset rowoffsets $row $offs
3978 set rowidlist [linsert $rowidlist $row $idlist]
3979 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3981 set rowrangelist [linsert $rowrangelist $row {}]
3982 if {[llength $kids] > 1} {
3983 set rp1 [expr {$row + 1}]
3984 set ranges [lindex $rowrangelist $rp1]
3985 if {$ranges eq {}} {
3986 set ranges [list $newcmit $p]
3987 } elseif {[lindex $ranges end-1] eq $p} {
3988 lset ranges end-1 $newcmit
3990 lset rowrangelist $rp1 $ranges
3993 catch {unset rowchk}
3999 if {[info exists selectedline] && $selectedline >= $row} {
4005 # Remove a commit that was inserted with insertrow on row $row.
4006 proc removerow {row} {
4007 global displayorder parentlist commitlisted children
4008 global commitrow curview rowidlist rowoffsets numcommits
4009 global rowrangelist idrowranges rowlaidout rowoptim numcommits
4010 global linesegends selectedline rowchk commitidx
4012 if {$row >= $numcommits} {
4013 puts "oops, removing row $row but only have $numcommits rows"
4016 set rp1 [expr {$row + 1}]
4017 set id [lindex $displayorder $row]
4018 set p [lindex $parentlist $row]
4019 set displayorder [lreplace $displayorder $row $row]
4020 set parentlist [lreplace $parentlist $row $row]
4021 set commitlisted [lreplace $commitlisted $row $row]
4022 set kids $children($curview,$p)
4023 set i [lsearch -exact $kids $id]
4025 set kids [lreplace $kids $i $i]
4026 set children($curview,$p) $kids
4028 set l [llength $displayorder]
4029 for {set r $row} {$r < $l} {incr r} {
4030 set id [lindex $displayorder $r]
4031 set commitrow($curview,$id) $r
4033 incr commitidx($curview) -1
4035 set rowidlist [lreplace $rowidlist $row $row]
4036 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
4038 set offs [lindex $rowoffsets $row]
4039 set offs [lreplace $offs end end]
4040 lset rowoffsets $row $offs
4043 set rowrangelist [lreplace $rowrangelist $row $row]
4044 if {[llength $kids] > 0} {
4045 set ranges [lindex $rowrangelist $row]
4046 if {[lindex $ranges end-1] eq $id} {
4047 set ranges [lreplace $ranges end-1 end]
4048 lset rowrangelist $row $ranges
4052 catch {unset rowchk}
4058 if {[info exists selectedline] && $selectedline > $row} {
4059 incr selectedline -1
4064 # Don't change the text pane cursor if it is currently the hand cursor,
4065 # showing that we are over a sha1 ID link.
4066 proc settextcursor {c} {
4067 global ctext curtextcursor
4069 if {[$ctext cget -cursor] == $curtextcursor} {
4070 $ctext config -cursor $c
4072 set curtextcursor $c
4075 proc nowbusy {what} {
4078 if {[array names isbusy] eq {}} {
4079 . config -cursor watch
4085 proc notbusy {what} {
4086 global isbusy maincursor textcursor
4088 catch {unset isbusy($what)}
4089 if {[array names isbusy] eq {}} {
4090 . config -cursor $maincursor
4091 settextcursor $textcursor
4095 proc findmatches {f} {
4096 global findtype findstring
4097 if {$findtype == "Regexp"} {
4098 set matches [regexp -indices -all -inline $findstring $f]
4101 if {$findtype == "IgnCase"} {
4102 set f [string tolower $f]
4103 set fs [string tolower $fs]
4107 set l [string length $fs]
4108 while {[set j [string first $fs $f $i]] >= 0} {
4109 lappend matches [list $j [expr {$j+$l-1}]]
4110 set i [expr {$j + $l}]
4116 proc dofind {{rev 0}} {
4117 global findstring findstartline findcurline selectedline numcommits
4120 cancel_next_highlight
4122 if {$findstring eq {} || $numcommits == 0} return
4123 if {![info exists selectedline]} {
4124 set findstartline [lindex [visiblerows] $rev]
4126 set findstartline $selectedline
4128 set findcurline $findstartline
4133 if {$findcurline == 0} {
4134 set findcurline $numcommits
4141 proc findnext {restart} {
4143 if {![info exists findcurline]} {
4157 if {![info exists findcurline]} {
4166 global commitdata commitinfo numcommits findstring findpattern findloc
4167 global findstartline findcurline displayorder
4169 set fldtypes {Headline Author Date Committer CDate Comments}
4170 set l [expr {$findcurline + 1}]
4171 if {$l >= $numcommits} {
4174 if {$l <= $findstartline} {
4175 set lim [expr {$findstartline + 1}]
4179 if {$lim - $l > 500} {
4180 set lim [expr {$l + 500}]
4183 for {} {$l < $lim} {incr l} {
4184 set id [lindex $displayorder $l]
4185 # shouldn't happen unless git log doesn't give all the commits...
4186 if {![info exists commitdata($id)]} continue
4187 if {![doesmatch $commitdata($id)]} continue
4188 if {![info exists commitinfo($id)]} {
4191 set info $commitinfo($id)
4192 foreach f $info ty $fldtypes {
4193 if {($findloc eq "All fields" || $findloc eq $ty) &&
4201 if {$l == $findstartline + 1} {
4207 set findcurline [expr {$l - 1}]
4211 proc findmorerev {} {
4212 global commitdata commitinfo numcommits findstring findpattern findloc
4213 global findstartline findcurline displayorder
4215 set fldtypes {Headline Author Date Committer CDate Comments}
4221 if {$l >= $findstartline} {
4222 set lim [expr {$findstartline - 1}]
4226 if {$l - $lim > 500} {
4227 set lim [expr {$l - 500}]
4230 for {} {$l > $lim} {incr l -1} {
4231 set id [lindex $displayorder $l]
4232 if {![doesmatch $commitdata($id)]} continue
4233 if {![info exists commitinfo($id)]} {
4236 set info $commitinfo($id)
4237 foreach f $info ty $fldtypes {
4238 if {($findloc eq "All fields" || $findloc eq $ty) &&
4252 set findcurline [expr {$l + 1}]
4256 proc findselectline {l} {
4257 global findloc commentend ctext findcurline markingmatches
4259 set markingmatches 1
4262 if {$findloc == "All fields" || $findloc == "Comments"} {
4263 # highlight the matches in the comments
4264 set f [$ctext get 1.0 $commentend]
4265 set matches [findmatches $f]
4266 foreach match $matches {
4267 set start [lindex $match 0]
4268 set end [expr {[lindex $match 1] + 1}]
4269 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4275 # mark the bits of a headline or author that match a find string
4276 proc markmatches {canv l str tag matches font row} {
4279 set bbox [$canv bbox $tag]
4280 set x0 [lindex $bbox 0]
4281 set y0 [lindex $bbox 1]
4282 set y1 [lindex $bbox 3]
4283 foreach match $matches {
4284 set start [lindex $match 0]
4285 set end [lindex $match 1]
4286 if {$start > $end} continue
4287 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4288 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4289 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4290 [expr {$x0+$xlen+2}] $y1 \
4291 -outline {} -tags [list match$l matches] -fill yellow]
4293 if {[info exists selectedline] && $row == $selectedline} {
4294 $canv raise $t secsel
4299 proc unmarkmatches {} {
4300 global findids markingmatches findcurline
4302 allcanvs delete matches
4303 catch {unset findids}
4304 set markingmatches 0
4305 catch {unset findcurline}
4308 proc selcanvline {w x y} {
4309 global canv canvy0 ctext linespc
4311 set ymax [lindex [$canv cget -scrollregion] 3]
4312 if {$ymax == {}} return
4313 set yfrac [lindex [$canv yview] 0]
4314 set y [expr {$y + $yfrac * $ymax}]
4315 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4320 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4326 proc commit_descriptor {p} {
4328 if {![info exists commitinfo($p)]} {
4332 if {[llength $commitinfo($p)] > 1} {
4333 set l [lindex $commitinfo($p) 0]
4338 # append some text to the ctext widget, and make any SHA1 ID
4339 # that we know about be a clickable link.
4340 proc appendwithlinks {text tags} {
4341 global ctext commitrow linknum curview
4343 set start [$ctext index "end - 1c"]
4344 $ctext insert end $text $tags
4345 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4349 set linkid [string range $text $s $e]
4350 if {![info exists commitrow($curview,$linkid)]} continue
4352 $ctext tag add link "$start + $s c" "$start + $e c"
4353 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4354 $ctext tag bind link$linknum <1> \
4355 [list selectline $commitrow($curview,$linkid) 1]
4358 $ctext tag conf link -foreground blue -underline 1
4359 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4360 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4363 proc viewnextline {dir} {
4367 set ymax [lindex [$canv cget -scrollregion] 3]
4368 set wnow [$canv yview]
4369 set wtop [expr {[lindex $wnow 0] * $ymax}]
4370 set newtop [expr {$wtop + $dir * $linespc}]
4373 } elseif {$newtop > $ymax} {
4376 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4379 # add a list of tag or branch names at position pos
4380 # returns the number of names inserted
4381 proc appendrefs {pos ids var} {
4382 global ctext commitrow linknum curview $var maxrefs
4384 if {[catch {$ctext index $pos}]} {
4387 $ctext conf -state normal
4388 $ctext delete $pos "$pos lineend"
4391 foreach tag [set $var\($id\)] {
4392 lappend tags [list $tag $id]
4395 if {[llength $tags] > $maxrefs} {
4396 $ctext insert $pos "many ([llength $tags])"
4398 set tags [lsort -index 0 -decreasing $tags]
4401 set id [lindex $ti 1]
4404 $ctext tag delete $lk
4405 $ctext insert $pos $sep
4406 $ctext insert $pos [lindex $ti 0] $lk
4407 if {[info exists commitrow($curview,$id)]} {
4408 $ctext tag conf $lk -foreground blue
4409 $ctext tag bind $lk <1> \
4410 [list selectline $commitrow($curview,$id) 1]
4411 $ctext tag conf $lk -underline 1
4412 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4413 $ctext tag bind $lk <Leave> \
4414 { %W configure -cursor $curtextcursor }
4419 $ctext conf -state disabled
4420 return [llength $tags]
4423 # called when we have finished computing the nearby tags
4424 proc dispneartags {delay} {
4425 global selectedline currentid showneartags tagphase
4427 if {![info exists selectedline] || !$showneartags} return
4428 after cancel dispnexttag
4430 after 200 dispnexttag
4433 after idle dispnexttag
4438 proc dispnexttag {} {
4439 global selectedline currentid showneartags tagphase ctext
4441 if {![info exists selectedline] || !$showneartags} return
4442 switch -- $tagphase {
4444 set dtags [desctags $currentid]
4446 appendrefs precedes $dtags idtags
4450 set atags [anctags $currentid]
4452 appendrefs follows $atags idtags
4456 set dheads [descheads $currentid]
4457 if {$dheads ne {}} {
4458 if {[appendrefs branch $dheads idheads] > 1
4459 && [$ctext get "branch -3c"] eq "h"} {
4460 # turn "Branch" into "Branches"
4461 $ctext conf -state normal
4462 $ctext insert "branch -2c" "es"
4463 $ctext conf -state disabled
4468 if {[incr tagphase] <= 2} {
4469 after idle dispnexttag
4473 proc selectline {l isnew} {
4474 global canv canv2 canv3 ctext commitinfo selectedline
4475 global displayorder linehtag linentag linedtag
4476 global canvy0 linespc parentlist children curview
4477 global currentid sha1entry
4478 global commentend idtags linknum
4479 global mergemax numcommits pending_select
4480 global cmitmode showneartags allcommits
4482 catch {unset pending_select}
4485 cancel_next_highlight
4486 if {$l < 0 || $l >= $numcommits} return
4487 set y [expr {$canvy0 + $l * $linespc}]
4488 set ymax [lindex [$canv cget -scrollregion] 3]
4489 set ytop [expr {$y - $linespc - 1}]
4490 set ybot [expr {$y + $linespc + 1}]
4491 set wnow [$canv yview]
4492 set wtop [expr {[lindex $wnow 0] * $ymax}]
4493 set wbot [expr {[lindex $wnow 1] * $ymax}]
4494 set wh [expr {$wbot - $wtop}]
4496 if {$ytop < $wtop} {
4497 if {$ybot < $wtop} {
4498 set newtop [expr {$y - $wh / 2.0}]
4501 if {$newtop > $wtop - $linespc} {
4502 set newtop [expr {$wtop - $linespc}]
4505 } elseif {$ybot > $wbot} {
4506 if {$ytop > $wbot} {
4507 set newtop [expr {$y - $wh / 2.0}]
4509 set newtop [expr {$ybot - $wh}]
4510 if {$newtop < $wtop + $linespc} {
4511 set newtop [expr {$wtop + $linespc}]
4515 if {$newtop != $wtop} {
4519 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4523 if {![info exists linehtag($l)]} return
4525 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4526 -tags secsel -fill [$canv cget -selectbackground]]
4528 $canv2 delete secsel
4529 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4530 -tags secsel -fill [$canv2 cget -selectbackground]]
4532 $canv3 delete secsel
4533 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4534 -tags secsel -fill [$canv3 cget -selectbackground]]
4538 addtohistory [list selectline $l 0]
4543 set id [lindex $displayorder $l]
4545 $sha1entry delete 0 end
4546 $sha1entry insert 0 $id
4547 $sha1entry selection from 0
4548 $sha1entry selection to end
4551 $ctext conf -state normal
4554 set info $commitinfo($id)
4555 set date [formatdate [lindex $info 2]]
4556 $ctext insert end "Author: [lindex $info 1] $date\n"
4557 set date [formatdate [lindex $info 4]]
4558 $ctext insert end "Committer: [lindex $info 3] $date\n"
4559 if {[info exists idtags($id)]} {
4560 $ctext insert end "Tags:"
4561 foreach tag $idtags($id) {
4562 $ctext insert end " $tag"
4564 $ctext insert end "\n"
4568 set olds [lindex $parentlist $l]
4569 if {[llength $olds] > 1} {
4572 if {$np >= $mergemax} {
4577 $ctext insert end "Parent: " $tag
4578 appendwithlinks [commit_descriptor $p] {}
4583 append headers "Parent: [commit_descriptor $p]"
4587 foreach c $children($curview,$id) {
4588 append headers "Child: [commit_descriptor $c]"
4591 # make anything that looks like a SHA1 ID be a clickable link
4592 appendwithlinks $headers {}
4593 if {$showneartags} {
4594 if {![info exists allcommits]} {
4597 $ctext insert end "Branch: "
4598 $ctext mark set branch "end -1c"
4599 $ctext mark gravity branch left
4600 $ctext insert end "\nFollows: "
4601 $ctext mark set follows "end -1c"
4602 $ctext mark gravity follows left
4603 $ctext insert end "\nPrecedes: "
4604 $ctext mark set precedes "end -1c"
4605 $ctext mark gravity precedes left
4606 $ctext insert end "\n"
4609 $ctext insert end "\n"
4610 set comment [lindex $info 5]
4611 if {[string first "\r" $comment] >= 0} {
4612 set comment [string map {"\r" "\n "} $comment]
4614 appendwithlinks $comment {comment}
4616 $ctext tag remove found 1.0 end
4617 $ctext conf -state disabled
4618 set commentend [$ctext index "end - 1c"]
4620 init_flist "Comments"
4621 if {$cmitmode eq "tree"} {
4623 } elseif {[llength $olds] <= 1} {
4630 proc selfirstline {} {
4635 proc sellastline {} {
4638 set l [expr {$numcommits - 1}]
4642 proc selnextline {dir} {
4645 if {![info exists selectedline]} return
4646 set l [expr {$selectedline + $dir}]
4651 proc selnextpage {dir} {
4652 global canv linespc selectedline numcommits
4654 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4658 allcanvs yview scroll [expr {$dir * $lpp}] units
4660 if {![info exists selectedline]} return
4661 set l [expr {$selectedline + $dir * $lpp}]
4664 } elseif {$l >= $numcommits} {
4665 set l [expr $numcommits - 1]
4671 proc unselectline {} {
4672 global selectedline currentid
4674 catch {unset selectedline}
4675 catch {unset currentid}
4676 allcanvs delete secsel
4678 cancel_next_highlight
4681 proc reselectline {} {
4684 if {[info exists selectedline]} {
4685 selectline $selectedline 0
4689 proc addtohistory {cmd} {
4690 global history historyindex curview
4692 set elt [list $curview $cmd]
4693 if {$historyindex > 0
4694 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4698 if {$historyindex < [llength $history]} {
4699 set history [lreplace $history $historyindex end $elt]
4701 lappend history $elt
4704 if {$historyindex > 1} {
4705 .tf.bar.leftbut conf -state normal
4707 .tf.bar.leftbut conf -state disabled
4709 .tf.bar.rightbut conf -state disabled
4715 set view [lindex $elt 0]
4716 set cmd [lindex $elt 1]
4717 if {$curview != $view} {
4724 global history historyindex
4727 if {$historyindex > 1} {
4728 incr historyindex -1
4729 godo [lindex $history [expr {$historyindex - 1}]]
4730 .tf.bar.rightbut conf -state normal
4732 if {$historyindex <= 1} {
4733 .tf.bar.leftbut conf -state disabled
4738 global history historyindex
4741 if {$historyindex < [llength $history]} {
4742 set cmd [lindex $history $historyindex]
4745 .tf.bar.leftbut conf -state normal
4747 if {$historyindex >= [llength $history]} {
4748 .tf.bar.rightbut conf -state disabled
4753 global treefilelist treeidlist diffids diffmergeid treepending
4754 global nullid nullid2
4757 catch {unset diffmergeid}
4758 if {![info exists treefilelist($id)]} {
4759 if {![info exists treepending]} {
4760 if {$id eq $nullid} {
4761 set cmd [list | git ls-files]
4762 } elseif {$id eq $nullid2} {
4763 set cmd [list | git ls-files --stage -t]
4765 set cmd [list | git ls-tree -r $id]
4767 if {[catch {set gtf [open $cmd r]}]} {
4771 set treefilelist($id) {}
4772 set treeidlist($id) {}
4773 fconfigure $gtf -blocking 0
4774 filerun $gtf [list gettreeline $gtf $id]
4781 proc gettreeline {gtf id} {
4782 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4785 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4786 if {$diffids eq $nullid} {
4789 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4790 set i [string first "\t" $line]
4791 if {$i < 0} continue
4792 set sha1 [lindex $line 2]
4793 set fname [string range $line [expr {$i+1}] end]
4794 if {[string index $fname 0] eq "\""} {
4795 set fname [lindex $fname 0]
4797 lappend treeidlist($id) $sha1
4799 lappend treefilelist($id) $fname
4802 return [expr {$nl >= 1000? 2: 1}]
4806 if {$cmitmode ne "tree"} {
4807 if {![info exists diffmergeid]} {
4808 gettreediffs $diffids
4810 } elseif {$id ne $diffids} {
4819 global treefilelist treeidlist diffids nullid nullid2
4820 global ctext commentend
4822 set i [lsearch -exact $treefilelist($diffids) $f]
4824 puts "oops, $f not in list for id $diffids"
4827 if {$diffids eq $nullid} {
4828 if {[catch {set bf [open $f r]} err]} {
4829 puts "oops, can't read $f: $err"
4833 set blob [lindex $treeidlist($diffids) $i]
4834 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4835 puts "oops, error reading blob $blob: $err"
4839 fconfigure $bf -blocking 0
4840 filerun $bf [list getblobline $bf $diffids]
4841 $ctext config -state normal
4842 clear_ctext $commentend
4843 $ctext insert end "\n"
4844 $ctext insert end "$f\n" filesep
4845 $ctext config -state disabled
4846 $ctext yview $commentend
4849 proc getblobline {bf id} {
4850 global diffids cmitmode ctext
4852 if {$id ne $diffids || $cmitmode ne "tree"} {
4856 $ctext config -state normal
4858 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4859 $ctext insert end "$line\n"
4862 # delete last newline
4863 $ctext delete "end - 2c" "end - 1c"
4867 $ctext config -state disabled
4868 return [expr {$nl >= 1000? 2: 1}]
4871 proc mergediff {id l} {
4872 global diffmergeid diffopts mdifffd
4878 # this doesn't seem to actually affect anything...
4879 set env(GIT_DIFF_OPTS) $diffopts
4880 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4881 if {[catch {set mdf [open $cmd r]} err]} {
4882 error_popup "Error getting merge diffs: $err"
4885 fconfigure $mdf -blocking 0
4886 set mdifffd($id) $mdf
4887 set np [llength [lindex $parentlist $l]]
4888 filerun $mdf [list getmergediffline $mdf $id $np]
4891 proc getmergediffline {mdf id np} {
4892 global diffmergeid ctext cflist mergemax
4893 global difffilestart mdifffd
4895 $ctext conf -state normal
4897 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4898 if {![info exists diffmergeid] || $id != $diffmergeid
4899 || $mdf != $mdifffd($id)} {
4903 if {[regexp {^diff --cc (.*)} $line match fname]} {
4904 # start of a new file
4905 $ctext insert end "\n"
4906 set here [$ctext index "end - 1c"]
4907 lappend difffilestart $here
4908 add_flist [list $fname]
4909 set l [expr {(78 - [string length $fname]) / 2}]
4910 set pad [string range "----------------------------------------" 1 $l]
4911 $ctext insert end "$pad $fname $pad\n" filesep
4912 } elseif {[regexp {^@@} $line]} {
4913 $ctext insert end "$line\n" hunksep
4914 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4917 # parse the prefix - one ' ', '-' or '+' for each parent
4922 for {set j 0} {$j < $np} {incr j} {
4923 set c [string range $line $j $j]
4926 } elseif {$c == "-"} {
4928 } elseif {$c == "+"} {
4937 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4938 # line doesn't appear in result, parents in $minuses have the line
4939 set num [lindex $minuses 0]
4940 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4941 # line appears in result, parents in $pluses don't have the line
4942 lappend tags mresult
4943 set num [lindex $spaces 0]
4946 if {$num >= $mergemax} {
4951 $ctext insert end "$line\n" $tags
4954 $ctext conf -state disabled
4959 return [expr {$nr >= 1000? 2: 1}]
4962 proc startdiff {ids} {
4963 global treediffs diffids treepending diffmergeid nullid nullid2
4966 catch {unset diffmergeid}
4967 if {![info exists treediffs($ids)] ||
4968 [lsearch -exact $ids $nullid] >= 0 ||
4969 [lsearch -exact $ids $nullid2] >= 0} {
4970 if {![info exists treepending]} {
4978 proc addtocflist {ids} {
4979 global treediffs cflist
4980 add_flist $treediffs($ids)
4984 proc diffcmd {ids flags} {
4985 global nullid nullid2
4987 set i [lsearch -exact $ids $nullid]
4988 set j [lsearch -exact $ids $nullid2]
4990 if {[llength $ids] > 1 && $j < 0} {
4991 # comparing working directory with some specific revision
4992 set cmd [concat | git diff-index $flags]
4994 lappend cmd -R [lindex $ids 1]
4996 lappend cmd [lindex $ids 0]
4999 # comparing working directory with index
5000 set cmd [concat | git diff-files $flags]
5005 } elseif {$j >= 0} {
5006 set cmd [concat | git diff-index --cached $flags]
5007 if {[llength $ids] > 1} {
5008 # comparing index with specific revision
5010 lappend cmd -R [lindex $ids 1]
5012 lappend cmd [lindex $ids 0]
5015 # comparing index with HEAD
5019 set cmd [concat | git diff-tree -r $flags $ids]
5024 proc gettreediffs {ids} {
5025 global treediff treepending
5027 set treepending $ids
5029 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5030 fconfigure $gdtf -blocking 0
5031 filerun $gdtf [list gettreediffline $gdtf $ids]
5034 proc gettreediffline {gdtf ids} {
5035 global treediff treediffs treepending diffids diffmergeid
5039 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5040 set i [string first "\t" $line]
5042 set file [string range $line [expr {$i+1}] end]
5043 if {[string index $file 0] eq "\""} {
5044 set file [lindex $file 0]
5046 lappend treediff $file
5050 return [expr {$nr >= 1000? 2: 1}]
5053 set treediffs($ids) $treediff
5055 if {$cmitmode eq "tree"} {
5057 } elseif {$ids != $diffids} {
5058 if {![info exists diffmergeid]} {
5059 gettreediffs $diffids
5067 # empty string or positive integer
5068 proc diffcontextvalidate {v} {
5069 return [regexp {^(|[1-9][0-9]*)$} $v]
5072 proc diffcontextchange {n1 n2 op} {
5073 global diffcontextstring diffcontext
5075 if {[string is integer -strict $diffcontextstring]} {
5076 if {$diffcontextstring > 0} {
5077 set diffcontext $diffcontextstring
5083 proc getblobdiffs {ids} {
5084 global diffopts blobdifffd diffids env
5085 global diffinhdr treediffs
5088 set env(GIT_DIFF_OPTS) $diffopts
5089 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5090 puts "error getting diffs: $err"
5094 fconfigure $bdf -blocking 0
5095 set blobdifffd($ids) $bdf
5096 filerun $bdf [list getblobdiffline $bdf $diffids]
5099 proc setinlist {var i val} {
5102 while {[llength [set $var]] < $i} {
5105 if {[llength [set $var]] == $i} {
5112 proc makediffhdr {fname ids} {
5113 global ctext curdiffstart treediffs
5115 set i [lsearch -exact $treediffs($ids) $fname]
5117 setinlist difffilestart $i $curdiffstart
5119 set l [expr {(78 - [string length $fname]) / 2}]
5120 set pad [string range "----------------------------------------" 1 $l]
5121 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5124 proc getblobdiffline {bdf ids} {
5125 global diffids blobdifffd ctext curdiffstart
5126 global diffnexthead diffnextnote difffilestart
5127 global diffinhdr treediffs
5130 $ctext conf -state normal
5131 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5132 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5136 if {![string compare -length 11 "diff --git " $line]} {
5137 # trim off "diff --git "
5138 set line [string range $line 11 end]
5140 # start of a new file
5141 $ctext insert end "\n"
5142 set curdiffstart [$ctext index "end - 1c"]
5143 $ctext insert end "\n" filesep
5144 # If the name hasn't changed the length will be odd,
5145 # the middle char will be a space, and the two bits either
5146 # side will be a/name and b/name, or "a/name" and "b/name".
5147 # If the name has changed we'll get "rename from" and
5148 # "rename to" lines following this, and we'll use them
5149 # to get the filenames.
5150 # This complexity is necessary because spaces in the filename(s)
5151 # don't get escaped.
5152 set l [string length $line]
5153 set i [expr {$l / 2}]
5154 if {!(($l & 1) && [string index $line $i] eq " " &&
5155 [string range $line 2 [expr {$i - 1}]] eq \
5156 [string range $line [expr {$i + 3}] end])} {
5159 # unescape if quoted and chop off the a/ from the front
5160 if {[string index $line 0] eq "\""} {
5161 set fname [string range [lindex $line 0] 2 end]
5163 set fname [string range $line 2 [expr {$i - 1}]]
5165 makediffhdr $fname $ids
5167 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5168 $line match f1l f1c f2l f2c rest]} {
5169 $ctext insert end "$line\n" hunksep
5172 } elseif {$diffinhdr} {
5173 if {![string compare -length 12 "rename from " $line]} {
5174 set fname [string range $line 12 end]
5175 if {[string index $fname 0] eq "\""} {
5176 set fname [lindex $fname 0]
5178 set i [lsearch -exact $treediffs($ids) $fname]
5180 setinlist difffilestart $i $curdiffstart
5182 } elseif {![string compare -length 10 $line "rename to "]} {
5183 set fname [string range $line 10 end]
5184 if {[string index $fname 0] eq "\""} {
5185 set fname [lindex $fname 0]
5187 makediffhdr $fname $ids
5188 } elseif {[string compare -length 3 $line "---"] == 0} {
5191 } elseif {[string compare -length 3 $line "+++"] == 0} {
5195 $ctext insert end "$line\n" filesep
5198 set x [string range $line 0 0]
5199 if {$x == "-" || $x == "+"} {
5200 set tag [expr {$x == "+"}]
5201 $ctext insert end "$line\n" d$tag
5202 } elseif {$x == " "} {
5203 $ctext insert end "$line\n"
5205 # "\ No newline at end of file",
5206 # or something else we don't recognize
5207 $ctext insert end "$line\n" hunksep
5211 $ctext conf -state disabled
5216 return [expr {$nr >= 1000? 2: 1}]
5219 proc changediffdisp {} {
5220 global ctext diffelide
5222 $ctext tag conf d0 -elide [lindex $diffelide 0]
5223 $ctext tag conf d1 -elide [lindex $diffelide 1]
5227 global difffilestart ctext
5228 set prev [lindex $difffilestart 0]
5229 set here [$ctext index @0,0]
5230 foreach loc $difffilestart {
5231 if {[$ctext compare $loc >= $here]} {
5241 global difffilestart ctext
5242 set here [$ctext index @0,0]
5243 foreach loc $difffilestart {
5244 if {[$ctext compare $loc > $here]} {
5251 proc clear_ctext {{first 1.0}} {
5252 global ctext smarktop smarkbot
5254 set l [lindex [split $first .] 0]
5255 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5258 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5261 $ctext delete $first end
5264 proc incrsearch {name ix op} {
5265 global ctext searchstring searchdirn
5267 $ctext tag remove found 1.0 end
5268 if {[catch {$ctext index anchor}]} {
5269 # no anchor set, use start of selection, or of visible area
5270 set sel [$ctext tag ranges sel]
5272 $ctext mark set anchor [lindex $sel 0]
5273 } elseif {$searchdirn eq "-forwards"} {
5274 $ctext mark set anchor @0,0
5276 $ctext mark set anchor @0,[winfo height $ctext]
5279 if {$searchstring ne {}} {
5280 set here [$ctext search $searchdirn -- $searchstring anchor]
5289 global sstring ctext searchstring searchdirn
5292 $sstring icursor end
5293 set searchdirn -forwards
5294 if {$searchstring ne {}} {
5295 set sel [$ctext tag ranges sel]
5297 set start "[lindex $sel 0] + 1c"
5298 } elseif {[catch {set start [$ctext index anchor]}]} {
5301 set match [$ctext search -count mlen -- $searchstring $start]
5302 $ctext tag remove sel 1.0 end
5308 set mend "$match + $mlen c"
5309 $ctext tag add sel $match $mend
5310 $ctext mark unset anchor
5314 proc dosearchback {} {
5315 global sstring ctext searchstring searchdirn
5318 $sstring icursor end
5319 set searchdirn -backwards
5320 if {$searchstring ne {}} {
5321 set sel [$ctext tag ranges sel]
5323 set start [lindex $sel 0]
5324 } elseif {[catch {set start [$ctext index anchor]}]} {
5325 set start @0,[winfo height $ctext]
5327 set match [$ctext search -backwards -count ml -- $searchstring $start]
5328 $ctext tag remove sel 1.0 end
5334 set mend "$match + $ml c"
5335 $ctext tag add sel $match $mend
5336 $ctext mark unset anchor
5340 proc searchmark {first last} {
5341 global ctext searchstring
5345 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5346 if {$match eq {}} break
5347 set mend "$match + $mlen c"
5348 $ctext tag add found $match $mend
5352 proc searchmarkvisible {doall} {
5353 global ctext smarktop smarkbot
5355 set topline [lindex [split [$ctext index @0,0] .] 0]
5356 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5357 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5358 # no overlap with previous
5359 searchmark $topline $botline
5360 set smarktop $topline
5361 set smarkbot $botline
5363 if {$topline < $smarktop} {
5364 searchmark $topline [expr {$smarktop-1}]
5365 set smarktop $topline
5367 if {$botline > $smarkbot} {
5368 searchmark [expr {$smarkbot+1}] $botline
5369 set smarkbot $botline
5374 proc scrolltext {f0 f1} {
5377 .bleft.sb set $f0 $f1
5378 if {$searchstring ne {}} {
5384 global linespc charspc canvx0 canvy0 mainfont
5385 global xspc1 xspc2 lthickness
5387 set linespc [font metrics $mainfont -linespace]
5388 set charspc [font measure $mainfont "m"]
5389 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5390 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5391 set lthickness [expr {int($linespc / 9) + 1}]
5392 set xspc1(0) $linespc
5400 set ymax [lindex [$canv cget -scrollregion] 3]
5401 if {$ymax eq {} || $ymax == 0} return
5402 set span [$canv yview]
5405 allcanvs yview moveto [lindex $span 0]
5407 if {[info exists selectedline]} {
5408 selectline $selectedline 0
5409 allcanvs yview moveto [lindex $span 0]
5413 proc incrfont {inc} {
5414 global mainfont textfont ctext canv phase cflist
5415 global charspc tabstop
5416 global stopped entries
5418 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5419 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5421 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5422 $cflist conf -font $textfont
5423 $ctext tag conf filesep -font [concat $textfont bold]
5424 foreach e $entries {
5425 $e conf -font $mainfont
5427 if {$phase eq "getcommits"} {
5428 $canv itemconf textitems -font $mainfont
5434 global sha1entry sha1string
5435 if {[string length $sha1string] == 40} {
5436 $sha1entry delete 0 end
5440 proc sha1change {n1 n2 op} {
5441 global sha1string currentid sha1but
5442 if {$sha1string == {}
5443 || ([info exists currentid] && $sha1string == $currentid)} {
5448 if {[$sha1but cget -state] == $state} return
5449 if {$state == "normal"} {
5450 $sha1but conf -state normal -relief raised -text "Goto: "
5452 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5456 proc gotocommit {} {
5457 global sha1string currentid commitrow tagids headids
5458 global displayorder numcommits curview
5460 if {$sha1string == {}
5461 || ([info exists currentid] && $sha1string == $currentid)} return
5462 if {[info exists tagids($sha1string)]} {
5463 set id $tagids($sha1string)
5464 } elseif {[info exists headids($sha1string)]} {
5465 set id $headids($sha1string)
5467 set id [string tolower $sha1string]
5468 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5470 foreach i $displayorder {
5471 if {[string match $id* $i]} {
5475 if {$matches ne {}} {
5476 if {[llength $matches] > 1} {
5477 error_popup "Short SHA1 id $id is ambiguous"
5480 set id [lindex $matches 0]
5484 if {[info exists commitrow($curview,$id)]} {
5485 selectline $commitrow($curview,$id) 1
5488 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5493 error_popup "$type $sha1string is not known"
5496 proc lineenter {x y id} {
5497 global hoverx hovery hoverid hovertimer
5498 global commitinfo canv
5500 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5504 if {[info exists hovertimer]} {
5505 after cancel $hovertimer
5507 set hovertimer [after 500 linehover]
5511 proc linemotion {x y id} {
5512 global hoverx hovery hoverid hovertimer
5514 if {[info exists hoverid] && $id == $hoverid} {
5517 if {[info exists hovertimer]} {
5518 after cancel $hovertimer
5520 set hovertimer [after 500 linehover]
5524 proc lineleave {id} {
5525 global hoverid hovertimer canv
5527 if {[info exists hoverid] && $id == $hoverid} {
5529 if {[info exists hovertimer]} {
5530 after cancel $hovertimer
5538 global hoverx hovery hoverid hovertimer
5539 global canv linespc lthickness
5540 global commitinfo mainfont
5542 set text [lindex $commitinfo($hoverid) 0]
5543 set ymax [lindex [$canv cget -scrollregion] 3]
5544 if {$ymax == {}} return
5545 set yfrac [lindex [$canv yview] 0]
5546 set x [expr {$hoverx + 2 * $linespc}]
5547 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5548 set x0 [expr {$x - 2 * $lthickness}]
5549 set y0 [expr {$y - 2 * $lthickness}]
5550 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5551 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5552 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5553 -fill \#ffff80 -outline black -width 1 -tags hover]
5555 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5560 proc clickisonarrow {id y} {
5563 set ranges [rowranges $id]
5564 set thresh [expr {2 * $lthickness + 6}]
5565 set n [expr {[llength $ranges] - 1}]
5566 for {set i 1} {$i < $n} {incr i} {
5567 set row [lindex $ranges $i]
5568 if {abs([yc $row] - $y) < $thresh} {
5575 proc arrowjump {id n y} {
5578 # 1 <-> 2, 3 <-> 4, etc...
5579 set n [expr {(($n - 1) ^ 1) + 1}]
5580 set row [lindex [rowranges $id] $n]
5582 set ymax [lindex [$canv cget -scrollregion] 3]
5583 if {$ymax eq {} || $ymax <= 0} return
5584 set view [$canv yview]
5585 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5586 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5590 allcanvs yview moveto $yfrac
5593 proc lineclick {x y id isnew} {
5594 global ctext commitinfo children canv thickerline curview
5596 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5601 # draw this line thicker than normal
5605 set ymax [lindex [$canv cget -scrollregion] 3]
5606 if {$ymax eq {}} return
5607 set yfrac [lindex [$canv yview] 0]
5608 set y [expr {$y + $yfrac * $ymax}]
5610 set dirn [clickisonarrow $id $y]
5612 arrowjump $id $dirn $y
5617 addtohistory [list lineclick $x $y $id 0]
5619 # fill the details pane with info about this line
5620 $ctext conf -state normal
5622 $ctext tag conf link -foreground blue -underline 1
5623 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5624 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5625 $ctext insert end "Parent:\t"
5626 $ctext insert end $id [list link link0]
5627 $ctext tag bind link0 <1> [list selbyid $id]
5628 set info $commitinfo($id)
5629 $ctext insert end "\n\t[lindex $info 0]\n"
5630 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5631 set date [formatdate [lindex $info 2]]
5632 $ctext insert end "\tDate:\t$date\n"
5633 set kids $children($curview,$id)
5635 $ctext insert end "\nChildren:"
5637 foreach child $kids {
5639 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5640 set info $commitinfo($child)
5641 $ctext insert end "\n\t"
5642 $ctext insert end $child [list link link$i]
5643 $ctext tag bind link$i <1> [list selbyid $child]
5644 $ctext insert end "\n\t[lindex $info 0]"
5645 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5646 set date [formatdate [lindex $info 2]]
5647 $ctext insert end "\n\tDate:\t$date\n"
5650 $ctext conf -state disabled
5654 proc normalline {} {
5656 if {[info exists thickerline]} {
5664 global commitrow curview
5665 if {[info exists commitrow($curview,$id)]} {
5666 selectline $commitrow($curview,$id) 1
5672 if {![info exists startmstime]} {
5673 set startmstime [clock clicks -milliseconds]
5675 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5678 proc rowmenu {x y id} {
5679 global rowctxmenu commitrow selectedline rowmenuid curview
5680 global nullid nullid2 fakerowmenu mainhead
5683 if {![info exists selectedline]
5684 || $commitrow($curview,$id) eq $selectedline} {
5689 if {$id ne $nullid && $id ne $nullid2} {
5690 set menu $rowctxmenu
5691 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5693 set menu $fakerowmenu
5695 $menu entryconfigure "Diff this*" -state $state
5696 $menu entryconfigure "Diff selected*" -state $state
5697 $menu entryconfigure "Make patch" -state $state
5698 tk_popup $menu $x $y
5701 proc diffvssel {dirn} {
5702 global rowmenuid selectedline displayorder
5704 if {![info exists selectedline]} return
5706 set oldid [lindex $displayorder $selectedline]
5707 set newid $rowmenuid
5709 set oldid $rowmenuid
5710 set newid [lindex $displayorder $selectedline]
5712 addtohistory [list doseldiff $oldid $newid]
5713 doseldiff $oldid $newid
5716 proc doseldiff {oldid newid} {
5720 $ctext conf -state normal
5723 $ctext insert end "From "
5724 $ctext tag conf link -foreground blue -underline 1
5725 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5726 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5727 $ctext tag bind link0 <1> [list selbyid $oldid]
5728 $ctext insert end $oldid [list link link0]
5729 $ctext insert end "\n "
5730 $ctext insert end [lindex $commitinfo($oldid) 0]
5731 $ctext insert end "\n\nTo "
5732 $ctext tag bind link1 <1> [list selbyid $newid]
5733 $ctext insert end $newid [list link link1]
5734 $ctext insert end "\n "
5735 $ctext insert end [lindex $commitinfo($newid) 0]
5736 $ctext insert end "\n"
5737 $ctext conf -state disabled
5738 $ctext tag remove found 1.0 end
5739 startdiff [list $oldid $newid]
5743 global rowmenuid currentid commitinfo patchtop patchnum
5745 if {![info exists currentid]} return
5746 set oldid $currentid
5747 set oldhead [lindex $commitinfo($oldid) 0]
5748 set newid $rowmenuid
5749 set newhead [lindex $commitinfo($newid) 0]
5752 catch {destroy $top}
5754 label $top.title -text "Generate patch"
5755 grid $top.title - -pady 10
5756 label $top.from -text "From:"
5757 entry $top.fromsha1 -width 40 -relief flat
5758 $top.fromsha1 insert 0 $oldid
5759 $top.fromsha1 conf -state readonly
5760 grid $top.from $top.fromsha1 -sticky w
5761 entry $top.fromhead -width 60 -relief flat
5762 $top.fromhead insert 0 $oldhead
5763 $top.fromhead conf -state readonly
5764 grid x $top.fromhead -sticky w
5765 label $top.to -text "To:"
5766 entry $top.tosha1 -width 40 -relief flat
5767 $top.tosha1 insert 0 $newid
5768 $top.tosha1 conf -state readonly
5769 grid $top.to $top.tosha1 -sticky w
5770 entry $top.tohead -width 60 -relief flat
5771 $top.tohead insert 0 $newhead
5772 $top.tohead conf -state readonly
5773 grid x $top.tohead -sticky w
5774 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5775 grid $top.rev x -pady 10
5776 label $top.flab -text "Output file:"
5777 entry $top.fname -width 60
5778 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5780 grid $top.flab $top.fname -sticky w
5782 button $top.buts.gen -text "Generate" -command mkpatchgo
5783 button $top.buts.can -text "Cancel" -command mkpatchcan
5784 grid $top.buts.gen $top.buts.can
5785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5787 grid $top.buts - -pady 10 -sticky ew
5791 proc mkpatchrev {} {
5794 set oldid [$patchtop.fromsha1 get]
5795 set oldhead [$patchtop.fromhead get]
5796 set newid [$patchtop.tosha1 get]
5797 set newhead [$patchtop.tohead get]
5798 foreach e [list fromsha1 fromhead tosha1 tohead] \
5799 v [list $newid $newhead $oldid $oldhead] {
5800 $patchtop.$e conf -state normal
5801 $patchtop.$e delete 0 end
5802 $patchtop.$e insert 0 $v
5803 $patchtop.$e conf -state readonly
5808 global patchtop nullid nullid2
5810 set oldid [$patchtop.fromsha1 get]
5811 set newid [$patchtop.tosha1 get]
5812 set fname [$patchtop.fname get]
5813 set cmd [diffcmd [list $oldid $newid] -p]
5814 lappend cmd >$fname &
5815 if {[catch {eval exec $cmd} err]} {
5816 error_popup "Error creating patch: $err"
5818 catch {destroy $patchtop}
5822 proc mkpatchcan {} {
5825 catch {destroy $patchtop}
5830 global rowmenuid mktagtop commitinfo
5834 catch {destroy $top}
5836 label $top.title -text "Create tag"
5837 grid $top.title - -pady 10
5838 label $top.id -text "ID:"
5839 entry $top.sha1 -width 40 -relief flat
5840 $top.sha1 insert 0 $rowmenuid
5841 $top.sha1 conf -state readonly
5842 grid $top.id $top.sha1 -sticky w
5843 entry $top.head -width 60 -relief flat
5844 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5845 $top.head conf -state readonly
5846 grid x $top.head -sticky w
5847 label $top.tlab -text "Tag name:"
5848 entry $top.tag -width 60
5849 grid $top.tlab $top.tag -sticky w
5851 button $top.buts.gen -text "Create" -command mktaggo
5852 button $top.buts.can -text "Cancel" -command mktagcan
5853 grid $top.buts.gen $top.buts.can
5854 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5855 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5856 grid $top.buts - -pady 10 -sticky ew
5861 global mktagtop env tagids idtags
5863 set id [$mktagtop.sha1 get]
5864 set tag [$mktagtop.tag get]
5866 error_popup "No tag name specified"
5869 if {[info exists tagids($tag)]} {
5870 error_popup "Tag \"$tag\" already exists"
5875 set fname [file join $dir "refs/tags" $tag]
5876 set f [open $fname w]
5880 error_popup "Error creating tag: $err"
5884 set tagids($tag) $id
5885 lappend idtags($id) $tag
5890 proc redrawtags {id} {
5891 global canv linehtag commitrow idpos selectedline curview
5892 global mainfont canvxmax iddrawn
5894 if {![info exists commitrow($curview,$id)]} return
5895 if {![info exists iddrawn($id)]} return
5896 drawcommits $commitrow($curview,$id)
5897 $canv delete tag.$id
5898 set xt [eval drawtags $id $idpos($id)]
5899 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5900 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5901 set xr [expr {$xt + [font measure $mainfont $text]}]
5902 if {$xr > $canvxmax} {
5906 if {[info exists selectedline]
5907 && $selectedline == $commitrow($curview,$id)} {
5908 selectline $selectedline 0
5915 catch {destroy $mktagtop}
5924 proc writecommit {} {
5925 global rowmenuid wrcomtop commitinfo wrcomcmd
5927 set top .writecommit
5929 catch {destroy $top}
5931 label $top.title -text "Write commit to file"
5932 grid $top.title - -pady 10
5933 label $top.id -text "ID:"
5934 entry $top.sha1 -width 40 -relief flat
5935 $top.sha1 insert 0 $rowmenuid
5936 $top.sha1 conf -state readonly
5937 grid $top.id $top.sha1 -sticky w
5938 entry $top.head -width 60 -relief flat
5939 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5940 $top.head conf -state readonly
5941 grid x $top.head -sticky w
5942 label $top.clab -text "Command:"
5943 entry $top.cmd -width 60 -textvariable wrcomcmd
5944 grid $top.clab $top.cmd -sticky w -pady 10
5945 label $top.flab -text "Output file:"
5946 entry $top.fname -width 60
5947 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5948 grid $top.flab $top.fname -sticky w
5950 button $top.buts.gen -text "Write" -command wrcomgo
5951 button $top.buts.can -text "Cancel" -command wrcomcan
5952 grid $top.buts.gen $top.buts.can
5953 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5954 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5955 grid $top.buts - -pady 10 -sticky ew
5962 set id [$wrcomtop.sha1 get]
5963 set cmd "echo $id | [$wrcomtop.cmd get]"
5964 set fname [$wrcomtop.fname get]
5965 if {[catch {exec sh -c $cmd >$fname &} err]} {
5966 error_popup "Error writing commit: $err"
5968 catch {destroy $wrcomtop}
5975 catch {destroy $wrcomtop}
5980 global rowmenuid mkbrtop
5983 catch {destroy $top}
5985 label $top.title -text "Create new branch"
5986 grid $top.title - -pady 10
5987 label $top.id -text "ID:"
5988 entry $top.sha1 -width 40 -relief flat
5989 $top.sha1 insert 0 $rowmenuid
5990 $top.sha1 conf -state readonly
5991 grid $top.id $top.sha1 -sticky w
5992 label $top.nlab -text "Name:"
5993 entry $top.name -width 40
5994 grid $top.nlab $top.name -sticky w
5996 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5997 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5998 grid $top.buts.go $top.buts.can
5999 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6000 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6001 grid $top.buts - -pady 10 -sticky ew
6006 global headids idheads
6008 set name [$top.name get]
6009 set id [$top.sha1 get]
6011 error_popup "Please specify a name for the new branch"
6014 catch {destroy $top}
6018 exec git branch $name $id
6023 set headids($name) $id
6024 lappend idheads($id) $name
6032 proc cherrypick {} {
6033 global rowmenuid curview commitrow
6036 set oldhead [exec git rev-parse HEAD]
6037 set dheads [descheads $rowmenuid]
6038 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6039 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6040 included in branch $mainhead -- really re-apply it?"]
6045 # Unfortunately git-cherry-pick writes stuff to stderr even when
6046 # no error occurs, and exec takes that as an indication of error...
6047 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6052 set newhead [exec git rev-parse HEAD]
6053 if {$newhead eq $oldhead} {
6055 error_popup "No changes committed"
6058 addnewchild $newhead $oldhead
6059 if {[info exists commitrow($curview,$oldhead)]} {
6060 insertrow $commitrow($curview,$oldhead) $newhead
6061 if {$mainhead ne {}} {
6062 movehead $newhead $mainhead
6063 movedhead $newhead $mainhead
6072 global mainheadid mainhead rowmenuid confirm_ok resettype
6073 global showlocalchanges
6076 set w ".confirmreset"
6079 wm title $w "Confirm reset"
6080 message $w.m -text \
6081 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6082 -justify center -aspect 1000
6083 pack $w.m -side top -fill x -padx 20 -pady 20
6084 frame $w.f -relief sunken -border 2
6085 message $w.f.rt -text "Reset type:" -aspect 1000
6086 grid $w.f.rt -sticky w
6088 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6089 -text "Soft: Leave working tree and index untouched"
6090 grid $w.f.soft -sticky w
6091 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6092 -text "Mixed: Leave working tree untouched, reset index"
6093 grid $w.f.mixed -sticky w
6094 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6095 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6096 grid $w.f.hard -sticky w
6097 pack $w.f -side top -fill x
6098 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6099 pack $w.ok -side left -fill x -padx 20 -pady 20
6100 button $w.cancel -text Cancel -command "destroy $w"
6101 pack $w.cancel -side right -fill x -padx 20 -pady 20
6102 bind $w <Visibility> "grab $w; focus $w"
6104 if {!$confirm_ok} return
6105 if {[catch {set fd [open \
6106 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6110 set w ".resetprogress"
6111 filerun $fd [list readresetstat $fd $w]
6114 wm title $w "Reset progress"
6115 message $w.m -text "Reset in progress, please wait..." \
6116 -justify center -aspect 1000
6117 pack $w.m -side top -fill x -padx 20 -pady 5
6118 canvas $w.c -width 150 -height 20 -bg white
6119 $w.c create rect 0 0 0 20 -fill green -tags rect
6120 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6125 proc readresetstat {fd w} {
6126 global mainhead mainheadid showlocalchanges
6128 if {[gets $fd line] >= 0} {
6129 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6130 set x [expr {($m * 150) / $n}]
6131 $w.c coords rect 0 0 $x 20
6137 if {[catch {close $fd} err]} {
6140 set oldhead $mainheadid
6141 set newhead [exec git rev-parse HEAD]
6142 if {$newhead ne $oldhead} {
6143 movehead $newhead $mainhead
6144 movedhead $newhead $mainhead
6145 set mainheadid $newhead
6149 if {$showlocalchanges} {
6155 # context menu for a head
6156 proc headmenu {x y id head} {
6157 global headmenuid headmenuhead headctxmenu mainhead
6160 set headmenuhead $head
6162 if {$head eq $mainhead} {
6165 $headctxmenu entryconfigure 0 -state $state
6166 $headctxmenu entryconfigure 1 -state $state
6167 tk_popup $headctxmenu $x $y
6171 global headmenuid headmenuhead mainhead headids
6172 global showlocalchanges mainheadid
6174 # check the tree is clean first??
6175 set oldmainhead $mainhead
6180 exec git checkout -q $headmenuhead
6186 set mainhead $headmenuhead
6187 set mainheadid $headmenuid
6188 if {[info exists headids($oldmainhead)]} {
6189 redrawtags $headids($oldmainhead)
6191 redrawtags $headmenuid
6193 if {$showlocalchanges} {
6199 global headmenuid headmenuhead mainhead
6202 set head $headmenuhead
6204 # this check shouldn't be needed any more...
6205 if {$head eq $mainhead} {
6206 error_popup "Cannot delete the currently checked-out branch"
6209 set dheads [descheads $id]
6210 if {$idheads($dheads) eq $head} {
6211 # the stuff on this branch isn't on any other branch
6212 if {![confirm_popup "The commits on branch $head aren't on any other\
6213 branch.\nReally delete branch $head?"]} return
6217 if {[catch {exec git branch -D $head} err]} {
6222 removehead $id $head
6223 removedhead $id $head
6229 # Stuff for finding nearby tags
6230 proc getallcommits {} {
6231 global allcommits allids nbmp nextarc seeds
6233 if {![info exists allcommits]} {
6241 set cmd [concat | git rev-list --all --parents]
6245 set fd [open $cmd r]
6246 fconfigure $fd -blocking 0
6249 filerun $fd [list getallclines $fd]
6252 # Since most commits have 1 parent and 1 child, we group strings of
6253 # such commits into "arcs" joining branch/merge points (BMPs), which
6254 # are commits that either don't have 1 parent or don't have 1 child.
6256 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6257 # arcout(id) - outgoing arcs for BMP
6258 # arcids(a) - list of IDs on arc including end but not start
6259 # arcstart(a) - BMP ID at start of arc
6260 # arcend(a) - BMP ID at end of arc
6261 # growing(a) - arc a is still growing
6262 # arctags(a) - IDs out of arcids (excluding end) that have tags
6263 # archeads(a) - IDs out of arcids (excluding end) that have heads
6264 # The start of an arc is at the descendent end, so "incoming" means
6265 # coming from descendents, and "outgoing" means going towards ancestors.
6267 proc getallclines {fd} {
6268 global allids allparents allchildren idtags idheads nextarc nbmp
6269 global arcnos arcids arctags arcout arcend arcstart archeads growing
6270 global seeds allcommits
6273 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6274 set id [lindex $line 0]
6275 if {[info exists allparents($id)]} {
6280 set olds [lrange $line 1 end]
6281 set allparents($id) $olds
6282 if {![info exists allchildren($id)]} {
6283 set allchildren($id) {}
6288 if {[llength $olds] == 1 && [llength $a] == 1} {
6289 lappend arcids($a) $id
6290 if {[info exists idtags($id)]} {
6291 lappend arctags($a) $id
6293 if {[info exists idheads($id)]} {
6294 lappend archeads($a) $id
6296 if {[info exists allparents($olds)]} {
6297 # seen parent already
6298 if {![info exists arcout($olds)]} {
6301 lappend arcids($a) $olds
6302 set arcend($a) $olds
6305 lappend allchildren($olds) $id
6306 lappend arcnos($olds) $a
6311 foreach a $arcnos($id) {
6312 lappend arcids($a) $id
6319 lappend allchildren($p) $id
6320 set a [incr nextarc]
6321 set arcstart($a) $id
6328 if {[info exists allparents($p)]} {
6329 # seen it already, may need to make a new branch
6330 if {![info exists arcout($p)]} {
6333 lappend arcids($a) $p
6337 lappend arcnos($p) $a
6342 global cached_dheads cached_dtags cached_atags
6343 catch {unset cached_dheads}
6344 catch {unset cached_dtags}
6345 catch {unset cached_atags}
6348 return [expr {$nid >= 1000? 2: 1}]
6351 if {[incr allcommits -1] == 0} {
6358 proc recalcarc {a} {
6359 global arctags archeads arcids idtags idheads
6363 foreach id [lrange $arcids($a) 0 end-1] {
6364 if {[info exists idtags($id)]} {
6367 if {[info exists idheads($id)]} {
6372 set archeads($a) $ah
6376 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6377 global arcstart arcend arcout allparents growing
6380 if {[llength $a] != 1} {
6381 puts "oops splitarc called but [llength $a] arcs already"
6385 set i [lsearch -exact $arcids($a) $p]
6387 puts "oops splitarc $p not in arc $a"
6390 set na [incr nextarc]
6391 if {[info exists arcend($a)]} {
6392 set arcend($na) $arcend($a)
6394 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6395 set j [lsearch -exact $arcnos($l) $a]
6396 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6398 set tail [lrange $arcids($a) [expr {$i+1}] end]
6399 set arcids($a) [lrange $arcids($a) 0 $i]
6401 set arcstart($na) $p
6403 set arcids($na) $tail
6404 if {[info exists growing($a)]} {
6411 if {[llength $arcnos($id)] == 1} {
6414 set j [lsearch -exact $arcnos($id) $a]
6415 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6419 # reconstruct tags and heads lists
6420 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6425 set archeads($na) {}
6429 # Update things for a new commit added that is a child of one
6430 # existing commit. Used when cherry-picking.
6431 proc addnewchild {id p} {
6432 global allids allparents allchildren idtags nextarc nbmp
6433 global arcnos arcids arctags arcout arcend arcstart archeads growing
6437 set allparents($id) [list $p]
6438 set allchildren($id) {}
6442 lappend allchildren($p) $id
6443 set a [incr nextarc]
6444 set arcstart($a) $id
6447 set arcids($a) [list $p]
6449 if {![info exists arcout($p)]} {
6452 lappend arcnos($p) $a
6453 set arcout($id) [list $a]
6456 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6457 # or 0 if neither is true.
6458 proc anc_or_desc {a b} {
6459 global arcout arcstart arcend arcnos cached_isanc
6461 if {$arcnos($a) eq $arcnos($b)} {
6462 # Both are on the same arc(s); either both are the same BMP,
6463 # or if one is not a BMP, the other is also not a BMP or is
6464 # the BMP at end of the arc (and it only has 1 incoming arc).
6465 # Or both can be BMPs with no incoming arcs.
6466 if {$a eq $b || $arcnos($a) eq {}} {
6469 # assert {[llength $arcnos($a)] == 1}
6470 set arc [lindex $arcnos($a) 0]
6471 set i [lsearch -exact $arcids($arc) $a]
6472 set j [lsearch -exact $arcids($arc) $b]
6473 if {$i < 0 || $i > $j} {
6480 if {![info exists arcout($a)]} {
6481 set arc [lindex $arcnos($a) 0]
6482 if {[info exists arcend($arc)]} {
6483 set aend $arcend($arc)
6487 set a $arcstart($arc)
6491 if {![info exists arcout($b)]} {
6492 set arc [lindex $arcnos($b) 0]
6493 if {[info exists arcend($arc)]} {
6494 set bend $arcend($arc)
6498 set b $arcstart($arc)
6508 if {[info exists cached_isanc($a,$bend)]} {
6509 if {$cached_isanc($a,$bend)} {
6513 if {[info exists cached_isanc($b,$aend)]} {
6514 if {$cached_isanc($b,$aend)} {
6517 if {[info exists cached_isanc($a,$bend)]} {
6522 set todo [list $a $b]
6525 for {set i 0} {$i < [llength $todo]} {incr i} {
6526 set x [lindex $todo $i]
6527 if {$anc($x) eq {}} {
6530 foreach arc $arcnos($x) {
6531 set xd $arcstart($arc)
6533 set cached_isanc($a,$bend) 1
6534 set cached_isanc($b,$aend) 0
6536 } elseif {$xd eq $aend} {
6537 set cached_isanc($b,$aend) 1
6538 set cached_isanc($a,$bend) 0
6541 if {![info exists anc($xd)]} {
6542 set anc($xd) $anc($x)
6544 } elseif {$anc($xd) ne $anc($x)} {
6549 set cached_isanc($a,$bend) 0
6550 set cached_isanc($b,$aend) 0
6554 # This identifies whether $desc has an ancestor that is
6555 # a growing tip of the graph and which is not an ancestor of $anc
6556 # and returns 0 if so and 1 if not.
6557 # If we subsequently discover a tag on such a growing tip, and that
6558 # turns out to be a descendent of $anc (which it could, since we
6559 # don't necessarily see children before parents), then $desc
6560 # isn't a good choice to display as a descendent tag of
6561 # $anc (since it is the descendent of another tag which is
6562 # a descendent of $anc). Similarly, $anc isn't a good choice to
6563 # display as a ancestor tag of $desc.
6565 proc is_certain {desc anc} {
6566 global arcnos arcout arcstart arcend growing problems
6569 if {[llength $arcnos($anc)] == 1} {
6570 # tags on the same arc are certain
6571 if {$arcnos($desc) eq $arcnos($anc)} {
6574 if {![info exists arcout($anc)]} {
6575 # if $anc is partway along an arc, use the start of the arc instead
6576 set a [lindex $arcnos($anc) 0]
6577 set anc $arcstart($a)
6580 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6583 set a [lindex $arcnos($desc) 0]
6589 set anclist [list $x]
6593 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6594 set x [lindex $anclist $i]
6599 foreach a $arcout($x) {
6600 if {[info exists growing($a)]} {
6601 if {![info exists growanc($x)] && $dl($x)} {
6607 if {[info exists dl($y)]} {
6611 if {![info exists done($y)]} {
6614 if {[info exists growanc($x)]} {
6618 for {set k 0} {$k < [llength $xl]} {incr k} {
6619 set z [lindex $xl $k]
6620 foreach c $arcout($z) {
6621 if {[info exists arcend($c)]} {
6623 if {[info exists dl($v)] && $dl($v)} {
6625 if {![info exists done($v)]} {
6628 if {[info exists growanc($v)]} {
6638 } elseif {$y eq $anc || !$dl($x)} {
6649 foreach x [array names growanc] {
6658 proc validate_arctags {a} {
6659 global arctags idtags
6663 foreach id $arctags($a) {
6665 if {![info exists idtags($id)]} {
6666 set na [lreplace $na $i $i]
6673 proc validate_archeads {a} {
6674 global archeads idheads
6677 set na $archeads($a)
6678 foreach id $archeads($a) {
6680 if {![info exists idheads($id)]} {
6681 set na [lreplace $na $i $i]
6685 set archeads($a) $na
6688 # Return the list of IDs that have tags that are descendents of id,
6689 # ignoring IDs that are descendents of IDs already reported.
6690 proc desctags {id} {
6691 global arcnos arcstart arcids arctags idtags allparents
6692 global growing cached_dtags
6694 if {![info exists allparents($id)]} {
6697 set t1 [clock clicks -milliseconds]
6699 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6700 # part-way along an arc; check that arc first
6701 set a [lindex $arcnos($id) 0]
6702 if {$arctags($a) ne {}} {
6704 set i [lsearch -exact $arcids($a) $id]
6706 foreach t $arctags($a) {
6707 set j [lsearch -exact $arcids($a) $t]
6715 set id $arcstart($a)
6716 if {[info exists idtags($id)]} {
6720 if {[info exists cached_dtags($id)]} {
6721 return $cached_dtags($id)
6728 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6729 set id [lindex $todo $i]
6731 set ta [info exists hastaggedancestor($id)]
6735 # ignore tags on starting node
6736 if {!$ta && $i > 0} {
6737 if {[info exists idtags($id)]} {
6740 } elseif {[info exists cached_dtags($id)]} {
6741 set tagloc($id) $cached_dtags($id)
6745 foreach a $arcnos($id) {
6747 if {!$ta && $arctags($a) ne {}} {
6749 if {$arctags($a) ne {}} {
6750 lappend tagloc($id) [lindex $arctags($a) end]
6753 if {$ta || $arctags($a) ne {}} {
6754 set tomark [list $d]
6755 for {set j 0} {$j < [llength $tomark]} {incr j} {
6756 set dd [lindex $tomark $j]
6757 if {![info exists hastaggedancestor($dd)]} {
6758 if {[info exists done($dd)]} {
6759 foreach b $arcnos($dd) {
6760 lappend tomark $arcstart($b)
6762 if {[info exists tagloc($dd)]} {
6765 } elseif {[info exists queued($dd)]} {
6768 set hastaggedancestor($dd) 1
6772 if {![info exists queued($d)]} {
6775 if {![info exists hastaggedancestor($d)]} {
6782 foreach id [array names tagloc] {
6783 if {![info exists hastaggedancestor($id)]} {
6784 foreach t $tagloc($id) {
6785 if {[lsearch -exact $tags $t] < 0} {
6791 set t2 [clock clicks -milliseconds]
6794 # remove tags that are descendents of other tags
6795 for {set i 0} {$i < [llength $tags]} {incr i} {
6796 set a [lindex $tags $i]
6797 for {set j 0} {$j < $i} {incr j} {
6798 set b [lindex $tags $j]
6799 set r [anc_or_desc $a $b]
6801 set tags [lreplace $tags $j $j]
6804 } elseif {$r == -1} {
6805 set tags [lreplace $tags $i $i]
6812 if {[array names growing] ne {}} {
6813 # graph isn't finished, need to check if any tag could get
6814 # eclipsed by another tag coming later. Simply ignore any
6815 # tags that could later get eclipsed.
6818 if {[is_certain $t $origid]} {
6822 if {$tags eq $ctags} {
6823 set cached_dtags($origid) $tags
6828 set cached_dtags($origid) $tags
6830 set t3 [clock clicks -milliseconds]
6831 if {0 && $t3 - $t1 >= 100} {
6832 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6833 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6839 global arcnos arcids arcout arcend arctags idtags allparents
6840 global growing cached_atags
6842 if {![info exists allparents($id)]} {
6845 set t1 [clock clicks -milliseconds]
6847 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6848 # part-way along an arc; check that arc first
6849 set a [lindex $arcnos($id) 0]
6850 if {$arctags($a) ne {}} {
6852 set i [lsearch -exact $arcids($a) $id]
6853 foreach t $arctags($a) {
6854 set j [lsearch -exact $arcids($a) $t]
6860 if {![info exists arcend($a)]} {
6864 if {[info exists idtags($id)]} {
6868 if {[info exists cached_atags($id)]} {
6869 return $cached_atags($id)
6877 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6878 set id [lindex $todo $i]
6880 set td [info exists hastaggeddescendent($id)]
6884 # ignore tags on starting node
6885 if {!$td && $i > 0} {
6886 if {[info exists idtags($id)]} {
6889 } elseif {[info exists cached_atags($id)]} {
6890 set tagloc($id) $cached_atags($id)
6894 foreach a $arcout($id) {
6895 if {!$td && $arctags($a) ne {}} {
6897 if {$arctags($a) ne {}} {
6898 lappend tagloc($id) [lindex $arctags($a) 0]
6901 if {![info exists arcend($a)]} continue
6903 if {$td || $arctags($a) ne {}} {
6904 set tomark [list $d]
6905 for {set j 0} {$j < [llength $tomark]} {incr j} {
6906 set dd [lindex $tomark $j]
6907 if {![info exists hastaggeddescendent($dd)]} {
6908 if {[info exists done($dd)]} {
6909 foreach b $arcout($dd) {
6910 if {[info exists arcend($b)]} {
6911 lappend tomark $arcend($b)
6914 if {[info exists tagloc($dd)]} {
6917 } elseif {[info exists queued($dd)]} {
6920 set hastaggeddescendent($dd) 1
6924 if {![info exists queued($d)]} {
6927 if {![info exists hastaggeddescendent($d)]} {
6933 set t2 [clock clicks -milliseconds]
6936 foreach id [array names tagloc] {
6937 if {![info exists hastaggeddescendent($id)]} {
6938 foreach t $tagloc($id) {
6939 if {[lsearch -exact $tags $t] < 0} {
6946 # remove tags that are ancestors of other tags
6947 for {set i 0} {$i < [llength $tags]} {incr i} {
6948 set a [lindex $tags $i]
6949 for {set j 0} {$j < $i} {incr j} {
6950 set b [lindex $tags $j]
6951 set r [anc_or_desc $a $b]
6953 set tags [lreplace $tags $j $j]
6956 } elseif {$r == 1} {
6957 set tags [lreplace $tags $i $i]
6964 if {[array names growing] ne {}} {
6965 # graph isn't finished, need to check if any tag could get
6966 # eclipsed by another tag coming later. Simply ignore any
6967 # tags that could later get eclipsed.
6970 if {[is_certain $origid $t]} {
6974 if {$tags eq $ctags} {
6975 set cached_atags($origid) $tags
6980 set cached_atags($origid) $tags
6982 set t3 [clock clicks -milliseconds]
6983 if {0 && $t3 - $t1 >= 100} {
6984 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6985 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6990 # Return the list of IDs that have heads that are descendents of id,
6991 # including id itself if it has a head.
6992 proc descheads {id} {
6993 global arcnos arcstart arcids archeads idheads cached_dheads
6996 if {![info exists allparents($id)]} {
7000 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7001 # part-way along an arc; check it first
7002 set a [lindex $arcnos($id) 0]
7003 if {$archeads($a) ne {}} {
7004 validate_archeads $a
7005 set i [lsearch -exact $arcids($a) $id]
7006 foreach t $archeads($a) {
7007 set j [lsearch -exact $arcids($a) $t]
7012 set id $arcstart($a)
7018 for {set i 0} {$i < [llength $todo]} {incr i} {
7019 set id [lindex $todo $i]
7020 if {[info exists cached_dheads($id)]} {
7021 set ret [concat $ret $cached_dheads($id)]
7023 if {[info exists idheads($id)]} {
7026 foreach a $arcnos($id) {
7027 if {$archeads($a) ne {}} {
7028 validate_archeads $a
7029 if {$archeads($a) ne {}} {
7030 set ret [concat $ret $archeads($a)]
7034 if {![info exists seen($d)]} {
7041 set ret [lsort -unique $ret]
7042 set cached_dheads($origid) $ret
7043 return [concat $ret $aret]
7046 proc addedtag {id} {
7047 global arcnos arcout cached_dtags cached_atags
7049 if {![info exists arcnos($id)]} return
7050 if {![info exists arcout($id)]} {
7051 recalcarc [lindex $arcnos($id) 0]
7053 catch {unset cached_dtags}
7054 catch {unset cached_atags}
7057 proc addedhead {hid head} {
7058 global arcnos arcout cached_dheads
7060 if {![info exists arcnos($hid)]} return
7061 if {![info exists arcout($hid)]} {
7062 recalcarc [lindex $arcnos($hid) 0]
7064 catch {unset cached_dheads}
7067 proc removedhead {hid head} {
7068 global cached_dheads
7070 catch {unset cached_dheads}
7073 proc movedhead {hid head} {
7074 global arcnos arcout cached_dheads
7076 if {![info exists arcnos($hid)]} return
7077 if {![info exists arcout($hid)]} {
7078 recalcarc [lindex $arcnos($hid) 0]
7080 catch {unset cached_dheads}
7083 proc changedrefs {} {
7084 global cached_dheads cached_dtags cached_atags
7085 global arctags archeads arcnos arcout idheads idtags
7087 foreach id [concat [array names idheads] [array names idtags]] {
7088 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7089 set a [lindex $arcnos($id) 0]
7090 if {![info exists donearc($a)]} {
7096 catch {unset cached_dtags}
7097 catch {unset cached_atags}
7098 catch {unset cached_dheads}
7101 proc rereadrefs {} {
7102 global idtags idheads idotherrefs mainhead
7104 set refids [concat [array names idtags] \
7105 [array names idheads] [array names idotherrefs]]
7106 foreach id $refids {
7107 if {![info exists ref($id)]} {
7108 set ref($id) [listrefs $id]
7111 set oldmainhead $mainhead
7114 set refids [lsort -unique [concat $refids [array names idtags] \
7115 [array names idheads] [array names idotherrefs]]]
7116 foreach id $refids {
7117 set v [listrefs $id]
7118 if {![info exists ref($id)] || $ref($id) != $v ||
7119 ($id eq $oldmainhead && $id ne $mainhead) ||
7120 ($id eq $mainhead && $id ne $oldmainhead)} {
7126 proc listrefs {id} {
7127 global idtags idheads idotherrefs
7130 if {[info exists idtags($id)]} {
7134 if {[info exists idheads($id)]} {
7138 if {[info exists idotherrefs($id)]} {
7139 set z $idotherrefs($id)
7141 return [list $x $y $z]
7144 proc showtag {tag isnew} {
7145 global ctext tagcontents tagids linknum tagobjid
7148 addtohistory [list showtag $tag 0]
7150 $ctext conf -state normal
7153 if {![info exists tagcontents($tag)]} {
7155 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7158 if {[info exists tagcontents($tag)]} {
7159 set text $tagcontents($tag)
7161 set text "Tag: $tag\nId: $tagids($tag)"
7163 appendwithlinks $text {}
7164 $ctext conf -state disabled
7176 global maxwidth maxgraphpct diffopts
7177 global oldprefs prefstop showneartags showlocalchanges
7178 global bgcolor fgcolor ctext diffcolors selectbgcolor
7179 global uifont tabstop
7183 if {[winfo exists $top]} {
7187 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7188 set oldprefs($v) [set $v]
7191 wm title $top "Gitk preferences"
7192 label $top.ldisp -text "Commit list display options"
7193 $top.ldisp configure -font $uifont
7194 grid $top.ldisp - -sticky w -pady 10
7195 label $top.spacer -text " "
7196 label $top.maxwidthl -text "Maximum graph width (lines)" \
7198 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7199 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7200 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7202 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7203 grid x $top.maxpctl $top.maxpct -sticky w
7204 frame $top.showlocal
7205 label $top.showlocal.l -text "Show local changes" -font optionfont
7206 checkbutton $top.showlocal.b -variable showlocalchanges
7207 pack $top.showlocal.b $top.showlocal.l -side left
7208 grid x $top.showlocal -sticky w
7210 label $top.ddisp -text "Diff display options"
7211 $top.ddisp configure -font $uifont
7212 grid $top.ddisp - -sticky w -pady 10
7213 label $top.diffoptl -text "Options for diff program" \
7215 entry $top.diffopt -width 20 -textvariable diffopts
7216 grid x $top.diffoptl $top.diffopt -sticky w
7218 label $top.ntag.l -text "Display nearby tags" -font optionfont
7219 checkbutton $top.ntag.b -variable showneartags
7220 pack $top.ntag.b $top.ntag.l -side left
7221 grid x $top.ntag -sticky w
7222 label $top.tabstopl -text "tabstop" -font optionfont
7223 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7224 grid x $top.tabstopl $top.tabstop -sticky w
7226 label $top.cdisp -text "Colors: press to choose"
7227 $top.cdisp configure -font $uifont
7228 grid $top.cdisp - -sticky w -pady 10
7229 label $top.bg -padx 40 -relief sunk -background $bgcolor
7230 button $top.bgbut -text "Background" -font optionfont \
7231 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7232 grid x $top.bgbut $top.bg -sticky w
7233 label $top.fg -padx 40 -relief sunk -background $fgcolor
7234 button $top.fgbut -text "Foreground" -font optionfont \
7235 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7236 grid x $top.fgbut $top.fg -sticky w
7237 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7238 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7239 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7240 [list $ctext tag conf d0 -foreground]]
7241 grid x $top.diffoldbut $top.diffold -sticky w
7242 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7243 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7244 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7245 [list $ctext tag conf d1 -foreground]]
7246 grid x $top.diffnewbut $top.diffnew -sticky w
7247 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7248 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7249 -command [list choosecolor diffcolors 2 $top.hunksep \
7250 "diff hunk header" \
7251 [list $ctext tag conf hunksep -foreground]]
7252 grid x $top.hunksepbut $top.hunksep -sticky w
7253 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7254 button $top.selbgbut -text "Select bg" -font optionfont \
7255 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7256 grid x $top.selbgbut $top.selbgsep -sticky w
7259 button $top.buts.ok -text "OK" -command prefsok -default active
7260 $top.buts.ok configure -font $uifont
7261 button $top.buts.can -text "Cancel" -command prefscan -default normal
7262 $top.buts.can configure -font $uifont
7263 grid $top.buts.ok $top.buts.can
7264 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7265 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7266 grid $top.buts - - -pady 10 -sticky ew
7267 bind $top <Visibility> "focus $top.buts.ok"
7270 proc choosecolor {v vi w x cmd} {
7273 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7274 -title "Gitk: choose color for $x"]
7275 if {$c eq {}} return
7276 $w conf -background $c
7282 global bglist cflist
7284 $w configure -selectbackground $c
7286 $cflist tag configure highlight \
7287 -background [$cflist cget -selectbackground]
7288 allcanvs itemconf secsel -fill $c
7295 $w conf -background $c
7303 $w conf -foreground $c
7305 allcanvs itemconf text -fill $c
7306 $canv itemconf circle -outline $c
7310 global maxwidth maxgraphpct diffopts
7311 global oldprefs prefstop showneartags showlocalchanges
7313 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7314 set $v $oldprefs($v)
7316 catch {destroy $prefstop}
7321 global maxwidth maxgraphpct
7322 global oldprefs prefstop showneartags showlocalchanges
7323 global charspc ctext tabstop
7325 catch {destroy $prefstop}
7327 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7328 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7329 if {$showlocalchanges} {
7335 if {$maxwidth != $oldprefs(maxwidth)
7336 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7338 } elseif {$showneartags != $oldprefs(showneartags)} {
7343 proc formatdate {d} {
7345 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7350 # This list of encoding names and aliases is distilled from
7351 # http://www.iana.org/assignments/character-sets.
7352 # Not all of them are supported by Tcl.
7353 set encoding_aliases {
7354 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7355 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7356 { ISO-10646-UTF-1 csISO10646UTF1 }
7357 { ISO_646.basic:1983 ref csISO646basic1983 }
7358 { INVARIANT csINVARIANT }
7359 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7360 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7361 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7362 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7363 { NATS-DANO iso-ir-9-1 csNATSDANO }
7364 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7365 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7366 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7367 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7368 { ISO-2022-KR csISO2022KR }
7370 { ISO-2022-JP csISO2022JP }
7371 { ISO-2022-JP-2 csISO2022JP2 }
7372 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7374 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7375 { IT iso-ir-15 ISO646-IT csISO15Italian }
7376 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7377 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7378 { greek7-old iso-ir-18 csISO18Greek7Old }
7379 { latin-greek iso-ir-19 csISO19LatinGreek }
7380 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7381 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7382 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7383 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7384 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7385 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7386 { INIS iso-ir-49 csISO49INIS }
7387 { INIS-8 iso-ir-50 csISO50INIS8 }
7388 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7389 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7390 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7391 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7392 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7393 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7395 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7396 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7397 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7398 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7399 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7400 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7401 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7402 { greek7 iso-ir-88 csISO88Greek7 }
7403 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7404 { iso-ir-90 csISO90 }
7405 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7406 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7407 csISO92JISC62991984b }
7408 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7409 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7410 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7411 csISO95JIS62291984handadd }
7412 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7413 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7414 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7415 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7417 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7418 { T.61-7bit iso-ir-102 csISO102T617bit }
7419 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7420 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7421 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7422 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7423 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7424 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7425 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7426 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7427 arabic csISOLatinArabic }
7428 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7429 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7430 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7431 greek greek8 csISOLatinGreek }
7432 { T.101-G2 iso-ir-128 csISO128T101G2 }
7433 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7435 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7436 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7437 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7438 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7439 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7440 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7441 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7442 csISOLatinCyrillic }
7443 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7444 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7445 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7446 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7447 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7448 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7449 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7450 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7451 { ISO_10367-box iso-ir-155 csISO10367Box }
7452 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7453 { latin-lap lap iso-ir-158 csISO158Lap }
7454 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7455 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7458 { JIS_X0201 X0201 csHalfWidthKatakana }
7459 { KSC5636 ISO646-KR csKSC5636 }
7460 { ISO-10646-UCS-2 csUnicode }
7461 { ISO-10646-UCS-4 csUCS4 }
7462 { DEC-MCS dec csDECMCS }
7463 { hp-roman8 roman8 r8 csHPRoman8 }
7464 { macintosh mac csMacintosh }
7465 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7467 { IBM038 EBCDIC-INT cp038 csIBM038 }
7468 { IBM273 CP273 csIBM273 }
7469 { IBM274 EBCDIC-BE CP274 csIBM274 }
7470 { IBM275 EBCDIC-BR cp275 csIBM275 }
7471 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7472 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7473 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7474 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7475 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7476 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7477 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7478 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7479 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7480 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7481 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7482 { IBM437 cp437 437 csPC8CodePage437 }
7483 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7484 { IBM775 cp775 csPC775Baltic }
7485 { IBM850 cp850 850 csPC850Multilingual }
7486 { IBM851 cp851 851 csIBM851 }
7487 { IBM852 cp852 852 csPCp852 }
7488 { IBM855 cp855 855 csIBM855 }
7489 { IBM857 cp857 857 csIBM857 }
7490 { IBM860 cp860 860 csIBM860 }
7491 { IBM861 cp861 861 cp-is csIBM861 }
7492 { IBM862 cp862 862 csPC862LatinHebrew }
7493 { IBM863 cp863 863 csIBM863 }
7494 { IBM864 cp864 csIBM864 }
7495 { IBM865 cp865 865 csIBM865 }
7496 { IBM866 cp866 866 csIBM866 }
7497 { IBM868 CP868 cp-ar csIBM868 }
7498 { IBM869 cp869 869 cp-gr csIBM869 }
7499 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7500 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7501 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7502 { IBM891 cp891 csIBM891 }
7503 { IBM903 cp903 csIBM903 }
7504 { IBM904 cp904 904 csIBBM904 }
7505 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7506 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7507 { IBM1026 CP1026 csIBM1026 }
7508 { EBCDIC-AT-DE csIBMEBCDICATDE }
7509 { EBCDIC-AT-DE-A csEBCDICATDEA }
7510 { EBCDIC-CA-FR csEBCDICCAFR }
7511 { EBCDIC-DK-NO csEBCDICDKNO }
7512 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7513 { EBCDIC-FI-SE csEBCDICFISE }
7514 { EBCDIC-FI-SE-A csEBCDICFISEA }
7515 { EBCDIC-FR csEBCDICFR }
7516 { EBCDIC-IT csEBCDICIT }
7517 { EBCDIC-PT csEBCDICPT }
7518 { EBCDIC-ES csEBCDICES }
7519 { EBCDIC-ES-A csEBCDICESA }
7520 { EBCDIC-ES-S csEBCDICESS }
7521 { EBCDIC-UK csEBCDICUK }
7522 { EBCDIC-US csEBCDICUS }
7523 { UNKNOWN-8BIT csUnknown8BiT }
7524 { MNEMONIC csMnemonic }
7529 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7530 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7531 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7532 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7533 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7534 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7535 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7536 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7537 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7538 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7539 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7540 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7541 { IBM1047 IBM-1047 }
7542 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7543 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7544 { UNICODE-1-1 csUnicode11 }
7547 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7548 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7550 { ISO-8859-15 ISO_8859-15 Latin-9 }
7551 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7552 { GBK CP936 MS936 windows-936 }
7553 { JIS_Encoding csJISEncoding }
7554 { Shift_JIS MS_Kanji csShiftJIS }
7555 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7557 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7558 { ISO-10646-UCS-Basic csUnicodeASCII }
7559 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7560 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7561 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7562 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7563 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7564 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7565 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7566 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7567 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7568 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7569 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7570 { Ventura-US csVenturaUS }
7571 { Ventura-International csVenturaInternational }
7572 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7573 { PC8-Turkish csPC8Turkish }
7574 { IBM-Symbols csIBMSymbols }
7575 { IBM-Thai csIBMThai }
7576 { HP-Legal csHPLegal }
7577 { HP-Pi-font csHPPiFont }
7578 { HP-Math8 csHPMath8 }
7579 { Adobe-Symbol-Encoding csHPPSMath }
7580 { HP-DeskTop csHPDesktop }
7581 { Ventura-Math csVenturaMath }
7582 { Microsoft-Publishing csMicrosoftPublishing }
7583 { Windows-31J csWindows31J }
7588 proc tcl_encoding {enc} {
7589 global encoding_aliases
7590 set names [encoding names]
7591 set lcnames [string tolower $names]
7592 set enc [string tolower $enc]
7593 set i [lsearch -exact $lcnames $enc]
7595 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7596 if {[regsub {^iso[-_]} $enc iso encx]} {
7597 set i [lsearch -exact $lcnames $encx]
7601 foreach l $encoding_aliases {
7602 set ll [string tolower $l]
7603 if {[lsearch -exact $ll $enc] < 0} continue
7604 # look through the aliases for one that tcl knows about
7606 set i [lsearch -exact $lcnames $e]
7608 if {[regsub {^iso[-_]} $e iso ex]} {
7609 set i [lsearch -exact $lcnames $ex]
7618 return [lindex $names $i]
7625 set diffopts "-U 5 -p"
7626 set wrcomcmd "git diff-tree --stdin -p --pretty"
7630 set gitencoding [exec git config --get i18n.commitencoding]
7632 if {$gitencoding == ""} {
7633 set gitencoding "utf-8"
7635 set tclencoding [tcl_encoding $gitencoding]
7636 if {$tclencoding == {}} {
7637 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7640 set mainfont {Helvetica 9}
7641 set textfont {Courier 9}
7642 set uifont {Helvetica 9 bold}
7644 set findmergefiles 0
7652 set cmitmode "patch"
7653 set wrapcomment "none"
7657 set showlocalchanges 1
7659 set colors {green red blue magenta darkgrey brown orange}
7662 set diffcolors {red "#00a000" blue}
7664 set selectbgcolor gray85
7666 catch {source ~/.gitk}
7668 font create optionfont -family sans-serif -size -12
7670 # check that we can find a .git directory somewhere...
7671 if {[catch {set gitdir [gitdir]}]} {
7672 show_error {} . "Cannot find a git repository here."
7675 if {![file isdirectory $gitdir]} {
7676 show_error {} . "Cannot find the git directory \"$gitdir\"."
7681 set cmdline_files {}
7686 "-d" { set datemode 1 }
7688 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7692 lappend revtreeargs $arg
7698 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7699 # no -- on command line, but some arguments (other than -d)
7701 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7702 set cmdline_files [split $f "\n"]
7703 set n [llength $cmdline_files]
7704 set revtreeargs [lrange $revtreeargs 0 end-$n]
7705 # Unfortunately git rev-parse doesn't produce an error when
7706 # something is both a revision and a filename. To be consistent
7707 # with git log and git rev-list, check revtreeargs for filenames.
7708 foreach arg $revtreeargs {
7709 if {[file exists $arg]} {
7710 show_error {} . "Ambiguous argument '$arg': both revision\
7716 # unfortunately we get both stdout and stderr in $err,
7717 # so look for "fatal:".
7718 set i [string first "fatal:" $err]
7720 set err [string range $err [expr {$i + 6}] end]
7722 show_error {} . "Bad arguments to gitk:\n$err"
7727 set nullid "0000000000000000000000000000000000000000"
7728 set nullid2 "0000000000000000000000000000000000000001"
7736 set highlight_paths {}
7737 set searchdirn -forwards
7741 set markingmatches 0
7748 set selectedhlview None
7757 set lookingforhead 0
7763 # wait for the window to become visible
7765 wm title . "[file tail $argv0]: [file tail [pwd]]"
7768 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7769 # create a view for the files/dirs specified on the command line
7773 set viewname(1) "Command line"
7774 set viewfiles(1) $cmdline_files
7775 set viewargs(1) $revtreeargs
7778 .bar.view entryconf Edit* -state normal
7779 .bar.view entryconf Delete* -state normal
7782 if {[info exists permviews]} {
7783 foreach v $permviews {
7786 set viewname($n) [lindex $v 0]
7787 set viewfiles($n) [lindex $v 1]
7788 set viewargs($n) [lindex $v 2]