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 args
$viewargs($view)
91 if {$viewfiles($view) ne
{}} {
92 set args
[concat
$args "--" $viewfiles($view)]
94 set order
"--topo-order"
96 set order
"--date-order"
99 set fd
[open
[concat | git rev-list
--header $order \
100 --parents --boundary --default HEAD
$args] r
]
102 puts stderr
"Error executing git rev-list: $err"
105 set commfd
($view) $fd
106 set leftover
($view) {}
107 set lookingforhead
$showlocalchanges
108 fconfigure
$fd -blocking 0 -translation lf
109 if {$tclencoding != {}} {
110 fconfigure
$fd -encoding $tclencoding
112 filerun
$fd [list getcommitlines
$fd $view]
116 proc stop_rev_list
{} {
117 global commfd curview
119 if {![info exists commfd
($curview)]} return
120 set fd
$commfd($curview)
126 unset commfd
($curview)
130 global phase canv mainfont curview
134 start_rev_list
$curview
135 show_status
"Reading commits..."
138 proc getcommitlines
{fd view
} {
140 global leftover commfd
141 global displayorder commitidx commitrow commitdata
142 global parentlist children curview hlview
143 global vparentlist vdisporder vcmitlisted
145 set stuff
[read $fd 500000]
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]
198 set ids
[string range
$cmit 0 [expr {$j - 1}]]
199 if {[string range
$ids 0 0] == "-"} {
201 set ids
[string range
$ids 1 end
]
205 if {[string length
$id] != 40} {
213 if {[string length
$shortcmit] > 80} {
214 set shortcmit
"[string range $shortcmit 0 80]..."
216 error_popup
"Can't parse git rev-list output: {$shortcmit}"
219 set id
[lindex
$ids 0]
221 set olds
[lrange
$ids 1 end
]
224 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
225 lappend children
($view,$p) $id
232 if {![info exists children
($view,$id)]} {
233 set children
($view,$id) {}
235 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
236 set commitrow
($view,$id) $commitidx($view)
237 incr commitidx
($view)
238 if {$view == $curview} {
239 lappend parentlist
$olds
240 lappend displayorder
$id
241 lappend commitlisted
$listed
243 lappend vparentlist
($view) $olds
244 lappend vdisporder
($view) $id
245 lappend vcmitlisted
($view) $listed
250 run chewcommits
$view
255 proc chewcommits
{view
} {
256 global curview hlview commfd
257 global selectedline pending_select
260 if {$view == $curview} {
261 set allread
[expr {![info exists commfd
($view)]}]
262 set tlimit
[expr {[clock clicks
-milliseconds] + 50}]
263 set more [layoutmore
$tlimit $allread]
264 if {$allread && !$more} {
265 global displayorder nullid commitidx phase
266 global numcommits startmsecs
268 if {[info exists pending_select
]} {
269 set row
[expr {[lindex
$displayorder 0] eq
$nullid}]
272 if {$commitidx($curview) > 0} {
273 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
274 #puts "overall $ms ms for $numcommits commits"
276 show_status
"No commits selected"
282 if {[info exists hlview
] && $view == $hlview} {
288 proc readcommit
{id
} {
289 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
290 parsecommit
$id $contents 0
293 proc updatecommits
{} {
294 global viewdata curview phase displayorder
295 global children commitrow selectedline thickerline
302 foreach id
$displayorder {
303 catch
{unset children
($n,$id)}
304 catch
{unset commitrow
($n,$id)}
307 catch
{unset selectedline
}
308 catch
{unset thickerline
}
309 catch
{unset viewdata
($n)}
316 proc parsecommit
{id contents listed
} {
317 global commitinfo cdate
326 set hdrend
[string first
"\n\n" $contents]
328 # should never happen...
329 set hdrend
[string length
$contents]
331 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
332 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
333 foreach line
[split $header "\n"] {
334 set tag
[lindex
$line 0]
335 if {$tag == "author"} {
336 set audate
[lindex
$line end-1
]
337 set auname
[lrange
$line 1 end-2
]
338 } elseif
{$tag == "committer"} {
339 set comdate
[lindex
$line end-1
]
340 set comname
[lrange
$line 1 end-2
]
344 # take the first non-blank line of the comment as the headline
345 set headline
[string trimleft
$comment]
346 set i
[string first
"\n" $headline]
348 set headline
[string range
$headline 0 $i]
350 set headline
[string trimright
$headline]
351 set i
[string first
"\r" $headline]
353 set headline
[string trimright
[string range
$headline 0 $i]]
356 # git rev-list indents the comment by 4 spaces;
357 # if we got this via git cat-file, add the indentation
359 foreach line
[split $comment "\n"] {
360 append newcomment
" "
361 append newcomment
$line
362 append newcomment
"\n"
364 set comment
$newcomment
366 if {$comdate != {}} {
367 set cdate
($id) $comdate
369 set commitinfo
($id) [list
$headline $auname $audate \
370 $comname $comdate $comment]
373 proc getcommit
{id
} {
374 global commitdata commitinfo
376 if {[info exists commitdata
($id)]} {
377 parsecommit
$id $commitdata($id) 1
380 if {![info exists commitinfo
($id)]} {
381 set commitinfo
($id) {"No commit information available"}
388 global tagids idtags headids idheads tagobjid
389 global otherrefids idotherrefs mainhead mainheadid
391 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
394 set refd
[open
[list | git show-ref
-d] r
]
395 while {[gets
$refd line
] >= 0} {
396 if {[string index
$line 40] ne
" "} continue
397 set id
[string range
$line 0 39]
398 set ref
[string range
$line 41 end
]
399 if {![string match
"refs/*" $ref]} continue
400 set name
[string range
$ref 5 end
]
401 if {[string match
"remotes/*" $name]} {
402 if {![string match
"*/HEAD" $name]} {
403 set headids
($name) $id
404 lappend idheads
($id) $name
406 } elseif
{[string match
"heads/*" $name]} {
407 set name
[string range
$name 6 end
]
408 set headids
($name) $id
409 lappend idheads
($id) $name
410 } elseif
{[string match
"tags/*" $name]} {
411 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
412 # which is what we want since the former is the commit ID
413 set name
[string range
$name 5 end
]
414 if {[string match
"*^{}" $name]} {
415 set name
[string range
$name 0 end-3
]
417 set tagobjid
($name) $id
419 set tagids
($name) $id
420 lappend idtags
($id) $name
422 set otherrefids
($name) $id
423 lappend idotherrefs
($id) $name
430 set thehead
[exec git symbolic-ref HEAD
]
431 if {[string match
"refs/heads/*" $thehead]} {
432 set mainhead
[string range
$thehead 11 end
]
433 if {[info exists headids
($mainhead)]} {
434 set mainheadid
$headids($mainhead)
440 # update things for a head moved to a child of its previous location
441 proc movehead
{id name
} {
442 global headids idheads
444 removehead
$headids($name) $name
445 set headids
($name) $id
446 lappend idheads
($id) $name
449 # update things when a head has been removed
450 proc removehead
{id name
} {
451 global headids idheads
453 if {$idheads($id) eq
$name} {
456 set i
[lsearch
-exact $idheads($id) $name]
458 set idheads
($id) [lreplace
$idheads($id) $i $i]
464 proc show_error
{w top msg
} {
465 message
$w.m
-text $msg -justify center
-aspect 400
466 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
467 button
$w.ok
-text OK
-command "destroy $top"
468 pack
$w.ok
-side bottom
-fill x
469 bind $top <Visibility
> "grab $top; focus $top"
470 bind $top <Key-Return
> "destroy $top"
474 proc error_popup msg
{
478 show_error
$w $w $msg
481 proc confirm_popup msg
{
487 message
$w.m
-text $msg -justify center
-aspect 400
488 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
489 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
490 pack
$w.ok
-side left
-fill x
491 button
$w.cancel
-text Cancel
-command "destroy $w"
492 pack
$w.cancel
-side right
-fill x
493 bind $w <Visibility
> "grab $w; focus $w"
499 global canv canv2 canv3 linespc charspc ctext cflist
500 global textfont mainfont uifont tabstop
501 global findtype findtypemenu findloc findstring fstring geometry
502 global entries sha1entry sha1string sha1but
503 global maincursor textcursor curtextcursor
504 global rowctxmenu fakerowmenu mergemax wrapcomment
505 global highlight_files gdttype
506 global searchstring sstring
507 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
511 .bar add cascade
-label "File" -menu .bar.
file
512 .bar configure
-font $uifont
514 .bar.
file add
command -label "Update" -command updatecommits
515 .bar.
file add
command -label "Reread references" -command rereadrefs
516 .bar.
file add
command -label "Quit" -command doquit
517 .bar.
file configure
-font $uifont
519 .bar add cascade
-label "Edit" -menu .bar.edit
520 .bar.edit add
command -label "Preferences" -command doprefs
521 .bar.edit configure
-font $uifont
523 menu .bar.view
-font $uifont
524 .bar add cascade
-label "View" -menu .bar.view
525 .bar.view add
command -label "New view..." -command {newview
0}
526 .bar.view add
command -label "Edit view..." -command editview \
528 .bar.view add
command -label "Delete view" -command delview
-state disabled
529 .bar.view add separator
530 .bar.view add radiobutton
-label "All files" -command {showview
0} \
531 -variable selectedview
-value 0
534 .bar add cascade
-label "Help" -menu .bar.
help
535 .bar.
help add
command -label "About gitk" -command about
536 .bar.
help add
command -label "Key bindings" -command keys
537 .bar.
help configure
-font $uifont
538 . configure
-menu .bar
540 # the gui has upper and lower half, parts of a paned window.
541 panedwindow .ctop
-orient vertical
543 # possibly use assumed geometry
544 if {![info exists geometry
(pwsash0
)]} {
545 set geometry
(topheight
) [expr {15 * $linespc}]
546 set geometry
(topwidth
) [expr {80 * $charspc}]
547 set geometry
(botheight
) [expr {15 * $linespc}]
548 set geometry
(botwidth
) [expr {50 * $charspc}]
549 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
550 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
553 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
554 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
556 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
558 # create three canvases
559 set cscroll .tf.histframe.csb
560 set canv .tf.histframe.pwclist.canv
562 -selectbackground $selectbgcolor \
563 -background $bgcolor -bd 0 \
564 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
565 .tf.histframe.pwclist add
$canv
566 set canv2 .tf.histframe.pwclist.canv2
568 -selectbackground $selectbgcolor \
569 -background $bgcolor -bd 0 -yscrollincr $linespc
570 .tf.histframe.pwclist add
$canv2
571 set canv3 .tf.histframe.pwclist.canv3
573 -selectbackground $selectbgcolor \
574 -background $bgcolor -bd 0 -yscrollincr $linespc
575 .tf.histframe.pwclist add
$canv3
576 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
577 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
579 # a scroll bar to rule them
580 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
581 pack
$cscroll -side right
-fill y
582 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
583 lappend bglist
$canv $canv2 $canv3
584 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
586 # we have two button bars at bottom of top frame. Bar 1
588 frame .tf.lbar
-height 15
590 set sha1entry .tf.bar.sha1
591 set entries
$sha1entry
592 set sha1but .tf.bar.sha1label
593 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
594 -command gotocommit
-width 8 -font $uifont
595 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
596 pack .tf.bar.sha1label
-side left
597 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
598 trace add variable sha1string
write sha1change
599 pack
$sha1entry -side left
-pady 2
601 image create bitmap bm-left
-data {
602 #define left_width 16
603 #define left_height 16
604 static unsigned char left_bits
[] = {
605 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
606 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
607 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
609 image create bitmap bm-right
-data {
610 #define right_width 16
611 #define right_height 16
612 static unsigned char right_bits
[] = {
613 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
614 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
615 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
617 button .tf.bar.leftbut
-image bm-left
-command goback \
618 -state disabled
-width 26
619 pack .tf.bar.leftbut
-side left
-fill y
620 button .tf.bar.rightbut
-image bm-right
-command goforw \
621 -state disabled
-width 26
622 pack .tf.bar.rightbut
-side left
-fill y
624 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
625 pack .tf.bar.findbut
-side left
627 set fstring .tf.bar.findstring
628 lappend entries
$fstring
629 entry
$fstring -width 30 -font $textfont -textvariable findstring
630 trace add variable findstring
write find_change
631 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
633 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
634 findtype Exact IgnCase Regexp
]
635 trace add variable findtype
write find_change
636 .tf.bar.findtype configure
-font $uifont
637 .tf.bar.findtype.menu configure
-font $uifont
638 set findloc
"All fields"
639 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
640 Comments Author Committer
641 trace add variable findloc
write find_change
642 .tf.bar.findloc configure
-font $uifont
643 .tf.bar.findloc.menu configure
-font $uifont
644 pack .tf.bar.findloc
-side right
645 pack .tf.bar.findtype
-side right
647 # build up the bottom bar of upper window
648 label .tf.lbar.flabel
-text "Highlight: Commits " \
650 pack .tf.lbar.flabel
-side left
-fill y
651 set gdttype
"touching paths:"
652 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
653 "adding/removing string:"]
654 trace add variable gdttype
write hfiles_change
655 $gm conf
-font $uifont
656 .tf.lbar.gdttype conf
-font $uifont
657 pack .tf.lbar.gdttype
-side left
-fill y
658 entry .tf.lbar.fent
-width 25 -font $textfont \
659 -textvariable highlight_files
660 trace add variable highlight_files
write hfiles_change
661 lappend entries .tf.lbar.fent
662 pack .tf.lbar.fent
-side left
-fill x
-expand 1
663 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
664 pack .tf.lbar.vlabel
-side left
-fill y
665 global viewhlmenu selectedhlview
666 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
667 $viewhlmenu entryconf None
-command delvhighlight
668 $viewhlmenu conf
-font $uifont
669 .tf.lbar.vhl conf
-font $uifont
670 pack .tf.lbar.vhl
-side left
-fill y
671 label .tf.lbar.rlabel
-text " OR " -font $uifont
672 pack .tf.lbar.rlabel
-side left
-fill y
673 global highlight_related
674 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
675 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
676 $m conf
-font $uifont
677 .tf.lbar.relm conf
-font $uifont
678 trace add variable highlight_related
write vrel_change
679 pack .tf.lbar.relm
-side left
-fill y
681 # Finish putting the upper half of the viewer together
682 pack .tf.lbar
-in .tf
-side bottom
-fill x
683 pack .tf.bar
-in .tf
-side bottom
-fill x
684 pack .tf.histframe
-fill both
-side top
-expand 1
686 .ctop paneconfigure .tf
-height $geometry(topheight
)
687 .ctop paneconfigure .tf
-width $geometry(topwidth
)
689 # now build up the bottom
690 panedwindow .pwbottom
-orient horizontal
692 # lower left, a text box over search bar, scroll bar to the right
693 # if we know window height, then that will set the lower text height, otherwise
694 # we set lower text height which will drive window height
695 if {[info exists geometry
(main
)]} {
696 frame .bleft
-width $geometry(botwidth
)
698 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
703 button .bleft.top.search
-text "Search" -command dosearch \
705 pack .bleft.top.search
-side left
-padx 5
706 set sstring .bleft.top.sstring
707 entry
$sstring -width 20 -font $textfont -textvariable searchstring
708 lappend entries
$sstring
709 trace add variable searchstring
write incrsearch
710 pack
$sstring -side left
-expand 1 -fill x
711 radiobutton .bleft.mid.
diff -text "Diff" \
712 -command changediffdisp
-variable diffelide
-value {0 0}
713 radiobutton .bleft.mid.old
-text "Old version" \
714 -command changediffdisp
-variable diffelide
-value {0 1}
715 radiobutton .bleft.mid.new
-text "New version" \
716 -command changediffdisp
-variable diffelide
-value {1 0}
717 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
718 set ctext .bleft.ctext
719 text
$ctext -background $bgcolor -foreground $fgcolor \
720 -tabs "[expr {$tabstop * $charspc}]" \
721 -state disabled
-font $textfont \
722 -yscrollcommand scrolltext
-wrap none
723 scrollbar .bleft.sb
-command "$ctext yview"
724 pack .bleft.top
-side top
-fill x
725 pack .bleft.mid
-side top
-fill x
726 pack .bleft.sb
-side right
-fill y
727 pack
$ctext -side left
-fill both
-expand 1
728 lappend bglist
$ctext
729 lappend fglist
$ctext
731 $ctext tag conf comment
-wrap $wrapcomment
732 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
733 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
734 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
735 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
736 $ctext tag conf m0
-fore red
737 $ctext tag conf m1
-fore blue
738 $ctext tag conf m2
-fore green
739 $ctext tag conf m3
-fore purple
740 $ctext tag conf
m4 -fore brown
741 $ctext tag conf m5
-fore "#009090"
742 $ctext tag conf m6
-fore magenta
743 $ctext tag conf m7
-fore "#808000"
744 $ctext tag conf m8
-fore "#009000"
745 $ctext tag conf m9
-fore "#ff0080"
746 $ctext tag conf m10
-fore cyan
747 $ctext tag conf m11
-fore "#b07070"
748 $ctext tag conf m12
-fore "#70b0f0"
749 $ctext tag conf m13
-fore "#70f0b0"
750 $ctext tag conf m14
-fore "#f0b070"
751 $ctext tag conf m15
-fore "#ff70b0"
752 $ctext tag conf mmax
-fore darkgrey
754 $ctext tag conf mresult
-font [concat
$textfont bold
]
755 $ctext tag conf msep
-font [concat
$textfont bold
]
756 $ctext tag conf found
-back yellow
759 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
764 radiobutton .bright.mode.
patch -text "Patch" \
765 -command reselectline
-variable cmitmode
-value "patch"
766 .bright.mode.
patch configure
-font $uifont
767 radiobutton .bright.mode.tree
-text "Tree" \
768 -command reselectline
-variable cmitmode
-value "tree"
769 .bright.mode.tree configure
-font $uifont
770 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
771 pack .bright.mode
-side top
-fill x
772 set cflist .bright.cfiles
773 set indent
[font measure
$mainfont "nn"]
775 -selectbackground $selectbgcolor \
776 -background $bgcolor -foreground $fgcolor \
778 -tabs [list
$indent [expr {2 * $indent}]] \
779 -yscrollcommand ".bright.sb set" \
780 -cursor [. cget
-cursor] \
781 -spacing1 1 -spacing3 1
782 lappend bglist
$cflist
783 lappend fglist
$cflist
784 scrollbar .bright.sb
-command "$cflist yview"
785 pack .bright.sb
-side right
-fill y
786 pack
$cflist -side left
-fill both
-expand 1
787 $cflist tag configure highlight \
788 -background [$cflist cget
-selectbackground]
789 $cflist tag configure bold
-font [concat
$mainfont bold
]
791 .pwbottom add .bright
794 # restore window position if known
795 if {[info exists geometry
(main
)]} {
796 wm geometry .
"$geometry(main)"
799 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
800 pack .ctop
-fill both
-expand 1
801 bindall
<1> {selcanvline
%W
%x
%y
}
802 #bindall <B1-Motion> {selcanvline %W %x %y}
803 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
804 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
805 bindall
<2> "canvscan mark %W %x %y"
806 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
807 bindkey
<Home
> selfirstline
808 bindkey
<End
> sellastline
809 bind .
<Key-Up
> "selnextline -1"
810 bind .
<Key-Down
> "selnextline 1"
811 bind .
<Shift-Key-Up
> "next_highlight -1"
812 bind .
<Shift-Key-Down
> "next_highlight 1"
813 bindkey
<Key-Right
> "goforw"
814 bindkey
<Key-Left
> "goback"
815 bind .
<Key-Prior
> "selnextpage -1"
816 bind .
<Key-Next
> "selnextpage 1"
817 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
818 bind .
<Control-End
> "allcanvs yview moveto 1.0"
819 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
820 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
821 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
822 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
823 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
824 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
825 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
826 bindkey p
"selnextline -1"
827 bindkey n
"selnextline 1"
830 bindkey i
"selnextline -1"
831 bindkey k
"selnextline 1"
834 bindkey b
"$ctext yview scroll -1 pages"
835 bindkey d
"$ctext yview scroll 18 units"
836 bindkey u
"$ctext yview scroll -18 units"
837 bindkey
/ {findnext
1}
838 bindkey
<Key-Return
> {findnext
0}
841 bindkey
<F5
> updatecommits
842 bind .
<Control-q
> doquit
843 bind .
<Control-f
> dofind
844 bind .
<Control-g
> {findnext
0}
845 bind .
<Control-r
> dosearchback
846 bind .
<Control-s
> dosearch
847 bind .
<Control-equal
> {incrfont
1}
848 bind .
<Control-KP_Add
> {incrfont
1}
849 bind .
<Control-minus
> {incrfont
-1}
850 bind .
<Control-KP_Subtract
> {incrfont
-1}
851 wm protocol . WM_DELETE_WINDOW doquit
852 bind .
<Button-1
> "click %W"
853 bind $fstring <Key-Return
> dofind
854 bind $sha1entry <Key-Return
> gotocommit
855 bind $sha1entry <<PasteSelection>> clearsha1
856 bind $cflist <1> {sel_flist %W %x %y; break}
857 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
858 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
860 set maincursor [. cget -cursor]
861 set textcursor [$ctext cget -cursor]
862 set curtextcursor $textcursor
864 set rowctxmenu .rowctxmenu
865 menu $rowctxmenu -tearoff 0
866 $rowctxmenu add command -label "Diff this -> selected" \
867 -command {diffvssel 0}
868 $rowctxmenu add command -label "Diff selected -> this" \
869 -command {diffvssel 1}
870 $rowctxmenu add command -label "Make patch" -command mkpatch
871 $rowctxmenu add command -label "Create tag" -command mktag
872 $rowctxmenu add command -label "Write commit to file" -command writecommit
873 $rowctxmenu add command -label "Create new branch" -command mkbranch
874 $rowctxmenu add command -label "Cherry-pick this commit" \
876 $rowctxmenu add command -label "Reset HEAD branch to here" \
879 set fakerowmenu .fakerowmenu
880 menu $fakerowmenu -tearoff 0
881 $fakerowmenu add command -label "Diff this -> selected" \
882 -command {diffvssel 0}
883 $fakerowmenu add command -label "Diff selected -> this" \
884 -command {diffvssel 1}
885 $fakerowmenu add command -label "Make patch" -command mkpatch
886 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
887 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
888 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
890 set headctxmenu .headctxmenu
891 menu $headctxmenu -tearoff 0
892 $headctxmenu add command -label "Check out this branch" \
894 $headctxmenu add command -label "Remove this branch" \
898 # mouse-2 makes all windows scan vertically, but only the one
899 # the cursor is in scans horizontally
900 proc canvscan {op w x y} {
901 global canv canv2 canv3
902 foreach c [list $canv $canv2 $canv3] {
911 proc scrollcanv {cscroll f0 f1} {
917 # when we make a key binding for the toplevel, make sure
918 # it doesn't get triggered when that key is pressed in the
919 # find string entry widget.
920 proc bindkey {ev script} {
923 set escript [bind Entry $ev]
924 if {$escript == {}} {
925 set escript [bind Entry <Key>]
928 bind $e $ev "$escript; break"
932 # set the focus back to the toplevel for any click outside
943 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
944 global stuffsaved findmergefiles maxgraphpct
945 global maxwidth showneartags showlocalchanges
946 global viewname viewfiles viewargs viewperm nextviewnum
947 global cmitmode wrapcomment
948 global colors bgcolor fgcolor diffcolors selectbgcolor
950 if {$stuffsaved} return
951 if {![winfo viewable .]} return
953 set f [open "~/.gitk-new" w]
954 puts $f [list set mainfont $mainfont]
955 puts $f [list set textfont $textfont]
956 puts $f [list set uifont $uifont]
957 puts $f [list set tabstop $tabstop]
958 puts $f [list set findmergefiles $findmergefiles]
959 puts $f [list set maxgraphpct $maxgraphpct]
960 puts $f [list set maxwidth $maxwidth]
961 puts $f [list set cmitmode $cmitmode]
962 puts $f [list set wrapcomment $wrapcomment]
963 puts $f [list set showneartags $showneartags]
964 puts $f [list set showlocalchanges $showlocalchanges]
965 puts $f [list set bgcolor $bgcolor]
966 puts $f [list set fgcolor $fgcolor]
967 puts $f [list set colors $colors]
968 puts $f [list set diffcolors $diffcolors]
969 puts $f [list set selectbgcolor $selectbgcolor]
971 puts $f "set geometry(main) [wm geometry .]"
972 puts $f "set geometry(topwidth) [winfo width .tf]"
973 puts $f "set geometry(topheight) [winfo height .tf]"
974 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
975 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
976 puts $f "set geometry(botwidth) [winfo width .bleft]"
977 puts $f "set geometry(botheight) [winfo height .bleft]"
979 puts -nonewline $f "set permviews {"
980 for {set v 0} {$v < $nextviewnum} {incr v} {
982 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
987 file rename -force "~/.gitk-new" "~/.gitk"
992 proc resizeclistpanes {win w} {
994 if {[info exists oldwidth($win)]} {
995 set s0 [$win sash coord 0]
996 set s1 [$win sash coord 1]
998 set sash0 [expr {int($w/2 - 2)}]
999 set sash1 [expr {int($w*5/6 - 2)}]
1001 set factor [expr {1.0 * $w / $oldwidth($win)}]
1002 set sash0 [expr {int($factor * [lindex $s0 0])}]
1003 set sash1 [expr {int($factor * [lindex $s1 0])}]
1007 if {$sash1 < $sash0 + 20} {
1008 set sash1 [expr {$sash0 + 20}]
1010 if {$sash1 > $w - 10} {
1011 set sash1 [expr {$w - 10}]
1012 if {$sash0 > $sash1 - 20} {
1013 set sash0 [expr {$sash1 - 20}]
1017 $win sash place 0 $sash0 [lindex $s0 1]
1018 $win sash place 1 $sash1 [lindex $s1 1]
1020 set oldwidth($win) $w
1023 proc resizecdetpanes {win w} {
1025 if {[info exists oldwidth($win)]} {
1026 set s0 [$win sash coord 0]
1028 set sash0 [expr {int($w*3/4 - 2)}]
1030 set factor [expr {1.0 * $w / $oldwidth($win)}]
1031 set sash0 [expr {int($factor * [lindex $s0 0])}]
1035 if {$sash0 > $w - 15} {
1036 set sash0 [expr {$w - 15}]
1039 $win sash place 0 $sash0 [lindex $s0 1]
1041 set oldwidth($win) $w
1044 proc allcanvs args {
1045 global canv canv2 canv3
1051 proc bindall {event action} {
1052 global canv canv2 canv3
1053 bind $canv $event $action
1054 bind $canv2 $event $action
1055 bind $canv3 $event $action
1061 if {[winfo exists $w]} {
1066 wm title $w "About gitk"
1067 message $w.m -text {
1068 Gitk - a commit viewer for git
1070 Copyright © 2005-2006 Paul Mackerras
1072 Use and redistribute under the terms of the GNU General Public License} \
1073 -justify center -aspect 400 -border 2 -bg white -relief groove
1074 pack $w.m -side top -fill x -padx 2 -pady 2
1075 $w.m configure -font $uifont
1076 button $w.ok -text Close -command "destroy $w" -default active
1077 pack $w.ok -side bottom
1078 $w.ok configure -font $uifont
1079 bind $w <Visibility> "focus $w.ok"
1080 bind $w <Key-Escape> "destroy $w"
1081 bind $w <Key-Return> "destroy $w"
1087 if {[winfo exists $w]} {
1092 wm title $w "Gitk key bindings"
1093 message $w.m -text {
1097 <Home> Move to first commit
1098 <End> Move to last commit
1099 <Up>, p, i Move up one commit
1100 <Down>, n, k Move down one commit
1101 <Left>, z, j Go back in history list
1102 <Right>, x, l Go forward in history list
1103 <PageUp> Move up one page in commit list
1104 <PageDown> Move down one page in commit list
1105 <Ctrl-Home> Scroll to top of commit list
1106 <Ctrl-End> Scroll to bottom of commit list
1107 <Ctrl-Up> Scroll commit list up one line
1108 <Ctrl-Down> Scroll commit list down one line
1109 <Ctrl-PageUp> Scroll commit list up one page
1110 <Ctrl-PageDown> Scroll commit list down one page
1111 <Shift-Up> Move to previous highlighted line
1112 <Shift-Down> Move to next highlighted line
1113 <Delete>, b Scroll diff view up one page
1114 <Backspace> Scroll diff view up one page
1115 <Space> Scroll diff view down one page
1116 u Scroll diff view up 18 lines
1117 d Scroll diff view down 18 lines
1119 <Ctrl-G> Move to next find hit
1120 <Return> Move to next find hit
1121 / Move to next find hit, or redo find
1122 ? Move to previous find hit
1123 f Scroll diff view to next file
1124 <Ctrl-S> Search for next hit in diff view
1125 <Ctrl-R> Search for previous hit in diff view
1126 <Ctrl-KP+> Increase font size
1127 <Ctrl-plus> Increase font size
1128 <Ctrl-KP-> Decrease font size
1129 <Ctrl-minus> Decrease font size
1132 -justify left -bg white -border 2 -relief groove
1133 pack $w.m -side top -fill both -padx 2 -pady 2
1134 $w.m configure -font $uifont
1135 button $w.ok -text Close -command "destroy $w" -default active
1136 pack $w.ok -side bottom
1137 $w.ok configure -font $uifont
1138 bind $w <Visibility> "focus $w.ok"
1139 bind $w <Key-Escape> "destroy $w"
1140 bind $w <Key-Return> "destroy $w"
1143 # Procedures for manipulating the file list window at the
1144 # bottom right of the overall window.
1146 proc treeview {w l openlevs} {
1147 global treecontents treediropen treeheight treeparent treeindex
1157 set treecontents() {}
1158 $w conf -state normal
1160 while {[string range $f 0 $prefixend] ne $prefix} {
1161 if {$lev <= $openlevs} {
1162 $w mark set e:$treeindex($prefix) "end -1c"
1163 $w mark gravity e:$treeindex($prefix) left
1165 set treeheight($prefix) $ht
1166 incr ht [lindex $htstack end]
1167 set htstack [lreplace $htstack end end]
1168 set prefixend [lindex $prefendstack end]
1169 set prefendstack [lreplace $prefendstack end end]
1170 set prefix [string range $prefix 0 $prefixend]
1173 set tail [string range $f [expr {$prefixend+1}] end]
1174 while {[set slash [string first "/" $tail]] >= 0} {
1177 lappend prefendstack $prefixend
1178 incr prefixend [expr {$slash + 1}]
1179 set d [string range $tail 0 $slash]
1180 lappend treecontents($prefix) $d
1181 set oldprefix $prefix
1183 set treecontents($prefix) {}
1184 set treeindex($prefix) [incr ix]
1185 set treeparent($prefix) $oldprefix
1186 set tail [string range $tail [expr {$slash+1}] end]
1187 if {$lev <= $openlevs} {
1189 set treediropen($prefix) [expr {$lev < $openlevs}]
1190 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1191 $w mark set d:$ix "end -1c"
1192 $w mark gravity d:$ix left
1194 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1196 $w image create end -align center -image $bm -padx 1 \
1198 $w insert end $d [highlight_tag $prefix]
1199 $w mark set s:$ix "end -1c"
1200 $w mark gravity s:$ix left
1205 if {$lev <= $openlevs} {
1208 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1210 $w insert end $tail [highlight_tag $f]
1212 lappend treecontents($prefix) $tail
1215 while {$htstack ne {}} {
1216 set treeheight($prefix) $ht
1217 incr ht [lindex $htstack end]
1218 set htstack [lreplace $htstack end end]
1220 $w conf -state disabled
1223 proc linetoelt {l} {
1224 global treeheight treecontents
1229 foreach e $treecontents($prefix) {
1234 if {[string index $e end] eq "/"} {
1235 set n $treeheight($prefix$e)
1247 proc highlight_tree {y prefix} {
1248 global treeheight treecontents cflist
1250 foreach e $treecontents($prefix) {
1252 if {[highlight_tag $path] ne {}} {
1253 $cflist tag add bold $y.0 "$y.0 lineend"
1256 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1257 set y [highlight_tree $y $path]
1263 proc treeclosedir {w dir} {
1264 global treediropen treeheight treeparent treeindex
1266 set ix $treeindex($dir)
1267 $w conf -state normal
1268 $w delete s:$ix e:$ix
1269 set treediropen($dir) 0
1270 $w image configure a:$ix -image tri-rt
1271 $w conf -state disabled
1272 set n [expr {1 - $treeheight($dir)}]
1273 while {$dir ne {}} {
1274 incr treeheight($dir) $n
1275 set dir $treeparent($dir)
1279 proc treeopendir {w dir} {
1280 global treediropen treeheight treeparent treecontents treeindex
1282 set ix $treeindex($dir)
1283 $w conf -state normal
1284 $w image configure a:$ix -image tri-dn
1285 $w mark set e:$ix s:$ix
1286 $w mark gravity e:$ix right
1289 set n [llength $treecontents($dir)]
1290 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1293 incr treeheight($x) $n
1295 foreach e $treecontents($dir) {
1297 if {[string index $e end] eq "/"} {
1298 set iy $treeindex($de)
1299 $w mark set d:$iy e:$ix
1300 $w mark gravity d:$iy left
1301 $w insert e:$ix $str
1302 set treediropen($de) 0
1303 $w image create e:$ix -align center -image tri-rt -padx 1 \
1305 $w insert e:$ix $e [highlight_tag $de]
1306 $w mark set s:$iy e:$ix
1307 $w mark gravity s:$iy left
1308 set treeheight($de) 1
1310 $w insert e:$ix $str
1311 $w insert e:$ix $e [highlight_tag $de]
1314 $w mark gravity e:$ix left
1315 $w conf -state disabled
1316 set treediropen($dir) 1
1317 set top [lindex [split [$w index @0,0] .] 0]
1318 set ht [$w cget -height]
1319 set l [lindex [split [$w index s:$ix] .] 0]
1322 } elseif {$l + $n + 1 > $top + $ht} {
1323 set top [expr {$l + $n + 2 - $ht}]
1331 proc treeclick {w x y} {
1332 global treediropen cmitmode ctext cflist cflist_top
1334 if {$cmitmode ne "tree"} return
1335 if {![info exists cflist_top]} return
1336 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1337 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1338 $cflist tag add highlight $l.0 "$l.0 lineend"
1344 set e [linetoelt $l]
1345 if {[string index $e end] ne "/"} {
1347 } elseif {$treediropen($e)} {
1354 proc setfilelist {id} {
1355 global treefilelist cflist
1357 treeview $cflist $treefilelist($id) 0
1360 image create bitmap tri-rt -background black -foreground blue -data {
1361 #define tri-rt_width 13
1362 #define tri-rt_height 13
1363 static unsigned char tri-rt_bits[] = {
1364 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1365 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1368 #define tri-rt-mask_width 13
1369 #define tri-rt-mask_height 13
1370 static unsigned char tri-rt-mask_bits[] = {
1371 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1372 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1375 image create bitmap tri-dn -background black -foreground blue -data {
1376 #define tri-dn_width 13
1377 #define tri-dn_height 13
1378 static unsigned char tri-dn_bits[] = {
1379 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1380 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1383 #define tri-dn-mask_width 13
1384 #define tri-dn-mask_height 13
1385 static unsigned char tri-dn-mask_bits[] = {
1386 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1387 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1391 proc init_flist {first} {
1392 global cflist cflist_top selectedline difffilestart
1394 $cflist conf -state normal
1395 $cflist delete 0.0 end
1397 $cflist insert end $first
1399 $cflist tag add highlight 1.0 "1.0 lineend"
1401 catch {unset cflist_top}
1403 $cflist conf -state disabled
1404 set difffilestart {}
1407 proc highlight_tag {f} {
1408 global highlight_paths
1410 foreach p $highlight_paths {
1411 if {[string match $p $f]} {
1418 proc highlight_filelist {} {
1419 global cmitmode cflist
1421 $cflist conf -state normal
1422 if {$cmitmode ne "tree"} {
1423 set end [lindex [split [$cflist index end] .] 0]
1424 for {set l 2} {$l < $end} {incr l} {
1425 set line [$cflist get $l.0 "$l.0 lineend"]
1426 if {[highlight_tag $line] ne {}} {
1427 $cflist tag add bold $l.0 "$l.0 lineend"
1433 $cflist conf -state disabled
1436 proc unhighlight_filelist {} {
1439 $cflist conf -state normal
1440 $cflist tag remove bold 1.0 end
1441 $cflist conf -state disabled
1444 proc add_flist {fl} {
1447 $cflist conf -state normal
1449 $cflist insert end "\n"
1450 $cflist insert end $f [highlight_tag $f]
1452 $cflist conf -state disabled
1455 proc sel_flist {w x y} {
1456 global ctext difffilestart cflist cflist_top cmitmode
1458 if {$cmitmode eq "tree"} return
1459 if {![info exists cflist_top]} return
1460 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1461 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1462 $cflist tag add highlight $l.0 "$l.0 lineend"
1467 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1471 # Functions for adding and removing shell-type quoting
1473 proc shellquote {str} {
1474 if {![string match "*\['\"\\ \t]*" $str]} {
1477 if {![string match "*\['\"\\]*" $str]} {
1480 if {![string match "*'*" $str]} {
1483 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1486 proc shellarglist {l} {
1492 append str [shellquote $a]
1497 proc shelldequote {str} {
1502 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1503 append ret [string range $str $used end]
1504 set used [string length $str]
1507 set first [lindex $first 0]
1508 set ch [string index $str $first]
1509 if {$first > $used} {
1510 append ret [string range $str $used [expr {$first - 1}]]
1513 if {$ch eq " " || $ch eq "\t"} break
1516 set first [string first "'" $str $used]
1518 error "unmatched single-quote"
1520 append ret [string range $str $used [expr {$first - 1}]]
1525 if {$used >= [string length $str]} {
1526 error "trailing backslash"
1528 append ret [string index $str $used]
1533 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1534 error "unmatched double-quote"
1536 set first [lindex $first 0]
1537 set ch [string index $str $first]
1538 if {$first > $used} {
1539 append ret [string range $str $used [expr {$first - 1}]]
1542 if {$ch eq "\""} break
1544 append ret [string index $str $used]
1548 return [list $used $ret]
1551 proc shellsplit {str} {
1554 set str [string trimleft $str]
1555 if {$str eq {}} break
1556 set dq [shelldequote $str]
1557 set n [lindex $dq 0]
1558 set word [lindex $dq 1]
1559 set str [string range $str $n end]
1565 # Code to implement multiple views
1567 proc newview {ishighlight} {
1568 global nextviewnum newviewname newviewperm uifont newishighlight
1569 global newviewargs revtreeargs
1571 set newishighlight $ishighlight
1573 if {[winfo exists $top]} {
1577 set newviewname($nextviewnum) "View $nextviewnum"
1578 set newviewperm($nextviewnum) 0
1579 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1580 vieweditor $top $nextviewnum "Gitk view definition"
1585 global viewname viewperm newviewname newviewperm
1586 global viewargs newviewargs
1588 set top .gitkvedit-$curview
1589 if {[winfo exists $top]} {
1593 set newviewname($curview) $viewname($curview)
1594 set newviewperm($curview) $viewperm($curview)
1595 set newviewargs($curview) [shellarglist $viewargs($curview)]
1596 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1599 proc vieweditor {top n title} {
1600 global newviewname newviewperm viewfiles
1604 wm title $top $title
1605 label $top.nl -text "Name" -font $uifont
1606 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1607 grid $top.nl $top.name -sticky w -pady 5
1608 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1610 grid $top.perm - -pady 5 -sticky w
1611 message $top.al -aspect 1000 -font $uifont \
1612 -text "Commits to include (arguments to git rev-list):"
1613 grid $top.al - -sticky w -pady 5
1614 entry $top.args -width 50 -textvariable newviewargs($n) \
1615 -background white -font $uifont
1616 grid $top.args - -sticky ew -padx 5
1617 message $top.l -aspect 1000 -font $uifont \
1618 -text "Enter files and directories to include, one per line:"
1619 grid $top.l - -sticky w
1620 text $top.t -width 40 -height 10 -background white -font $uifont
1621 if {[info exists viewfiles($n)]} {
1622 foreach f $viewfiles($n) {
1623 $top.t insert end $f
1624 $top.t insert end "\n"
1626 $top.t delete {end - 1c} end
1627 $top.t mark set insert 0.0
1629 grid $top.t - -sticky ew -padx 5
1631 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1633 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1635 grid $top.buts.ok $top.buts.can
1636 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1637 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1638 grid $top.buts - -pady 10 -sticky ew
1642 proc doviewmenu {m first cmd op argv} {
1643 set nmenu [$m index end]
1644 for {set i $first} {$i <= $nmenu} {incr i} {
1645 if {[$m entrycget $i -command] eq $cmd} {
1646 eval $m $op $i $argv
1652 proc allviewmenus {n op args} {
1655 doviewmenu .bar.view 5 [list showview $n] $op $args
1656 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1659 proc newviewok {top n} {
1660 global nextviewnum newviewperm newviewname newishighlight
1661 global viewname viewfiles viewperm selectedview curview
1662 global viewargs newviewargs viewhlmenu
1665 set newargs [shellsplit $newviewargs($n)]
1667 error_popup "Error in commit selection arguments: $err"
1673 foreach f [split [$top.t get 0.0 end] "\n"] {
1674 set ft [string trim $f]
1679 if {![info exists viewfiles($n)]} {
1680 # creating a new view
1682 set viewname($n) $newviewname($n)
1683 set viewperm($n) $newviewperm($n)
1684 set viewfiles($n) $files
1685 set viewargs($n) $newargs
1687 if {!$newishighlight} {
1690 run addvhighlight $n
1693 # editing an existing view
1694 set viewperm($n) $newviewperm($n)
1695 if {$newviewname($n) ne $viewname($n)} {
1696 set viewname($n) $newviewname($n)
1697 doviewmenu .bar.view 5 [list showview $n] \
1698 entryconf [list -label $viewname($n)]
1699 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1700 entryconf [list -label $viewname($n) -value $viewname($n)]
1702 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1703 set viewfiles($n) $files
1704 set viewargs($n) $newargs
1705 if {$curview == $n} {
1710 catch {destroy $top}
1714 global curview viewdata viewperm hlview selectedhlview
1716 if {$curview == 0} return
1717 if {[info exists hlview] && $hlview == $curview} {
1718 set selectedhlview None
1721 allviewmenus $curview delete
1722 set viewdata($curview) {}
1723 set viewperm($curview) 0
1727 proc addviewmenu {n} {
1728 global viewname viewhlmenu
1730 .bar.view add radiobutton -label $viewname($n) \
1731 -command [list showview $n] -variable selectedview -value $n
1732 $viewhlmenu add radiobutton -label $viewname($n) \
1733 -command [list addvhighlight $n] -variable selectedhlview
1736 proc flatten {var} {
1740 foreach i [array names $var] {
1741 lappend ret $i [set $var\($i\)]
1746 proc unflatten {var l} {
1756 global curview viewdata viewfiles
1757 global displayorder parentlist rowidlist rowoffsets
1758 global colormap rowtextx commitrow nextcolor canvxmax
1759 global numcommits rowrangelist commitlisted idrowranges rowchk
1760 global selectedline currentid canv canvy0
1762 global pending_select phase
1763 global commitidx rowlaidout rowoptim
1765 global selectedview selectfirst
1766 global vparentlist vdisporder vcmitlisted
1767 global hlview selectedhlview
1769 if {$n == $curview} return
1771 if {[info exists selectedline]} {
1772 set selid $currentid
1773 set y [yc $selectedline]
1774 set ymax [lindex [$canv cget -scrollregion] 3]
1775 set span [$canv yview]
1776 set ytop [expr {[lindex $span 0] * $ymax}]
1777 set ybot [expr {[lindex $span 1] * $ymax}]
1778 if {$ytop < $y && $y < $ybot} {
1779 set yscreen [expr {$y - $ytop}]
1781 set yscreen [expr {($ybot - $ytop) / 2}]
1783 } elseif {[info exists pending_select]} {
1784 set selid $pending_select
1785 unset pending_select
1790 if {$curview >= 0} {
1791 set vparentlist($curview) $parentlist
1792 set vdisporder($curview) $displayorder
1793 set vcmitlisted($curview) $commitlisted
1795 set viewdata($curview) \
1796 [list $phase $rowidlist $rowoffsets $rowrangelist \
1797 [flatten idrowranges] [flatten idinlist] \
1798 $rowlaidout $rowoptim $numcommits]
1799 } elseif {![info exists viewdata($curview)]
1800 || [lindex $viewdata($curview) 0] ne {}} {
1801 set viewdata($curview) \
1802 [list {} $rowidlist $rowoffsets $rowrangelist]
1805 catch {unset treediffs}
1807 if {[info exists hlview] && $hlview == $n} {
1809 set selectedhlview None
1814 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1815 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1817 if {![info exists viewdata($n)]} {
1819 set pending_select $selid
1826 set phase [lindex $v 0]
1827 set displayorder $vdisporder($n)
1828 set parentlist $vparentlist($n)
1829 set commitlisted $vcmitlisted($n)
1830 set rowidlist [lindex $v 1]
1831 set rowoffsets [lindex $v 2]
1832 set rowrangelist [lindex $v 3]
1834 set numcommits [llength $displayorder]
1835 catch {unset idrowranges}
1837 unflatten idrowranges [lindex $v 4]
1838 unflatten idinlist [lindex $v 5]
1839 set rowlaidout [lindex $v 6]
1840 set rowoptim [lindex $v 7]
1841 set numcommits [lindex $v 8]
1842 catch {unset rowchk}
1845 catch {unset colormap}
1846 catch {unset rowtextx}
1848 set canvxmax [$canv cget -width]
1855 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1856 set row $commitrow($n,$selid)
1857 # try to get the selected row in the same position on the screen
1858 set ymax [lindex [$canv cget -scrollregion] 3]
1859 set ytop [expr {[yc $row] - $yscreen}]
1863 set yf [expr {$ytop * 1.0 / $ymax}]
1865 allcanvs yview moveto $yf
1869 } elseif {$selid ne {}} {
1870 set pending_select $selid
1872 set row [expr {[lindex $displayorder 0] eq $nullid}]
1873 if {$row < $numcommits} {
1880 if {$phase eq "getcommits"} {
1881 show_status "Reading commits..."
1884 } elseif {$numcommits == 0} {
1885 show_status "No commits selected"
1889 # Stuff relating to the highlighting facility
1891 proc ishighlighted {row} {
1892 global vhighlights fhighlights nhighlights rhighlights
1894 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1895 return $nhighlights($row)
1897 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1898 return $vhighlights($row)
1900 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1901 return $fhighlights($row)
1903 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1904 return $rhighlights($row)
1909 proc bolden {row font} {
1910 global canv linehtag selectedline boldrows
1912 lappend boldrows $row
1913 $canv itemconf $linehtag($row) -font $font
1914 if {[info exists selectedline] && $row == $selectedline} {
1916 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1917 -outline {{}} -tags secsel \
1918 -fill [$canv cget -selectbackground]]
1923 proc bolden_name {row font} {
1924 global canv2 linentag selectedline boldnamerows
1926 lappend boldnamerows $row
1927 $canv2 itemconf $linentag($row) -font $font
1928 if {[info exists selectedline] && $row == $selectedline} {
1929 $canv2 delete secsel
1930 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1931 -outline {{}} -tags secsel \
1932 -fill [$canv2 cget -selectbackground]]
1938 global mainfont boldrows
1941 foreach row $boldrows {
1942 if {![ishighlighted $row]} {
1943 bolden $row $mainfont
1945 lappend stillbold $row
1948 set boldrows $stillbold
1951 proc addvhighlight {n} {
1952 global hlview curview viewdata vhl_done vhighlights commitidx
1954 if {[info exists hlview]} {
1958 if {$n != $curview && ![info exists viewdata($n)]} {
1959 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1960 set vparentlist($n) {}
1961 set vdisporder($n) {}
1962 set vcmitlisted($n) {}
1965 set vhl_done $commitidx($hlview)
1966 if {$vhl_done > 0} {
1971 proc delvhighlight {} {
1972 global hlview vhighlights
1974 if {![info exists hlview]} return
1976 catch {unset vhighlights}
1980 proc vhighlightmore {} {
1981 global hlview vhl_done commitidx vhighlights
1982 global displayorder vdisporder curview mainfont
1984 set font [concat $mainfont bold]
1985 set max $commitidx($hlview)
1986 if {$hlview == $curview} {
1987 set disp $displayorder
1989 set disp $vdisporder($hlview)
1991 set vr [visiblerows]
1992 set r0 [lindex $vr 0]
1993 set r1 [lindex $vr 1]
1994 for {set i $vhl_done} {$i < $max} {incr i} {
1995 set id [lindex $disp $i]
1996 if {[info exists commitrow($curview,$id)]} {
1997 set row $commitrow($curview,$id)
1998 if {$r0 <= $row && $row <= $r1} {
1999 if {![highlighted $row]} {
2002 set vhighlights($row) 1
2009 proc askvhighlight {row id} {
2010 global hlview vhighlights commitrow iddrawn mainfont
2012 if {[info exists commitrow($hlview,$id)]} {
2013 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2014 bolden $row [concat $mainfont bold]
2016 set vhighlights($row) 1
2018 set vhighlights($row) 0
2022 proc hfiles_change {name ix op} {
2023 global highlight_files filehighlight fhighlights fh_serial
2024 global mainfont highlight_paths
2026 if {[info exists filehighlight]} {
2027 # delete previous highlights
2028 catch {close $filehighlight}
2030 catch {unset fhighlights}
2032 unhighlight_filelist
2034 set highlight_paths {}
2035 after cancel do_file_hl $fh_serial
2037 if {$highlight_files ne {}} {
2038 after 300 do_file_hl $fh_serial
2042 proc makepatterns {l} {
2045 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2046 if {[string index $ee end] eq "/"} {
2056 proc do_file_hl {serial} {
2057 global highlight_files filehighlight highlight_paths gdttype fhl_list
2059 if {$gdttype eq "touching paths:"} {
2060 if {[catch {set paths [shellsplit $highlight_files]}]} return
2061 set highlight_paths [makepatterns $paths]
2063 set gdtargs [concat -- $paths]
2065 set gdtargs [list "-S$highlight_files"]
2067 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2068 set filehighlight [open $cmd r+]
2069 fconfigure $filehighlight -blocking 0
2070 filerun $filehighlight readfhighlight
2076 proc flushhighlights {} {
2077 global filehighlight fhl_list
2079 if {[info exists filehighlight]} {
2081 puts $filehighlight ""
2082 flush $filehighlight
2086 proc askfilehighlight {row id} {
2087 global filehighlight fhighlights fhl_list
2089 lappend fhl_list $id
2090 set fhighlights($row) -1
2091 puts $filehighlight $id
2094 proc readfhighlight {} {
2095 global filehighlight fhighlights commitrow curview mainfont iddrawn
2098 if {![info exists filehighlight]} {
2102 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2103 set line [string trim $line]
2104 set i [lsearch -exact $fhl_list $line]
2105 if {$i < 0} continue
2106 for {set j 0} {$j < $i} {incr j} {
2107 set id [lindex $fhl_list $j]
2108 if {[info exists commitrow($curview,$id)]} {
2109 set fhighlights($commitrow($curview,$id)) 0
2112 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2113 if {$line eq {}} continue
2114 if {![info exists commitrow($curview,$line)]} continue
2115 set row $commitrow($curview,$line)
2116 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2117 bolden $row [concat $mainfont bold]
2119 set fhighlights($row) 1
2121 if {[eof $filehighlight]} {
2123 puts "oops, git diff-tree died"
2124 catch {close $filehighlight}
2132 proc find_change {name ix op} {
2133 global nhighlights mainfont boldnamerows
2134 global findstring findpattern findtype markingmatches
2136 # delete previous highlights, if any
2137 foreach row $boldnamerows {
2138 bolden_name $row $mainfont
2141 catch {unset nhighlights}
2144 if {$findtype ne "Regexp"} {
2145 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2147 set findpattern "*$e*"
2149 set markingmatches [expr {$findstring ne {}}]
2153 proc doesmatch {f} {
2154 global findtype findstring findpattern
2156 if {$findtype eq "Regexp"} {
2157 return [regexp $findstring $f]
2158 } elseif {$findtype eq "IgnCase"} {
2159 return [string match -nocase $findpattern $f]
2161 return [string match $findpattern $f]
2165 proc askfindhighlight {row id} {
2166 global nhighlights commitinfo iddrawn mainfont
2168 global markingmatches
2170 if {![info exists commitinfo($id)]} {
2173 set info $commitinfo($id)
2175 set fldtypes {Headline Author Date Committer CDate Comments}
2176 foreach f $info ty $fldtypes {
2177 if {($findloc eq "All fields" || $findloc eq $ty) &&
2179 if {$ty eq "Author"} {
2186 if {$isbold && [info exists iddrawn($id)]} {
2187 set f [concat $mainfont bold]
2188 if {![ishighlighted $row]} {
2194 if {$markingmatches} {
2195 markrowmatches $row [lindex $info 0] [lindex $info 1]
2198 set nhighlights($row) $isbold
2201 proc markrowmatches {row headline author} {
2202 global canv canv2 linehtag linentag
2204 $canv delete match$row
2205 $canv2 delete match$row
2206 set m [findmatches $headline]
2208 markmatches $canv $row $headline $linehtag($row) $m \
2209 [$canv itemcget $linehtag($row) -font]
2211 set m [findmatches $author]
2213 markmatches $canv2 $row $author $linentag($row) $m \
2214 [$canv2 itemcget $linentag($row) -font]
2218 proc vrel_change {name ix op} {
2219 global highlight_related
2222 if {$highlight_related ne "None"} {
2227 # prepare for testing whether commits are descendents or ancestors of a
2228 proc rhighlight_sel {a} {
2229 global descendent desc_todo ancestor anc_todo
2230 global highlight_related rhighlights
2232 catch {unset descendent}
2233 set desc_todo [list $a]
2234 catch {unset ancestor}
2235 set anc_todo [list $a]
2236 if {$highlight_related ne "None"} {
2242 proc rhighlight_none {} {
2245 catch {unset rhighlights}
2249 proc is_descendent {a} {
2250 global curview children commitrow descendent desc_todo
2253 set la $commitrow($v,$a)
2257 for {set i 0} {$i < [llength $todo]} {incr i} {
2258 set do [lindex $todo $i]
2259 if {$commitrow($v,$do) < $la} {
2260 lappend leftover $do
2263 foreach nk $children($v,$do) {
2264 if {![info exists descendent($nk)]} {
2265 set descendent($nk) 1
2273 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2277 set descendent($a) 0
2278 set desc_todo $leftover
2281 proc is_ancestor {a} {
2282 global curview parentlist commitrow ancestor anc_todo
2285 set la $commitrow($v,$a)
2289 for {set i 0} {$i < [llength $todo]} {incr i} {
2290 set do [lindex $todo $i]
2291 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2292 lappend leftover $do
2295 foreach np [lindex $parentlist $commitrow($v,$do)] {
2296 if {![info exists ancestor($np)]} {
2305 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2310 set anc_todo $leftover
2313 proc askrelhighlight {row id} {
2314 global descendent highlight_related iddrawn mainfont rhighlights
2315 global selectedline ancestor
2317 if {![info exists selectedline]} return
2319 if {$highlight_related eq "Descendent" ||
2320 $highlight_related eq "Not descendent"} {
2321 if {![info exists descendent($id)]} {
2324 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2327 } elseif {$highlight_related eq "Ancestor" ||
2328 $highlight_related eq "Not ancestor"} {
2329 if {![info exists ancestor($id)]} {
2332 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2336 if {[info exists iddrawn($id)]} {
2337 if {$isbold && ![ishighlighted $row]} {
2338 bolden $row [concat $mainfont bold]
2341 set rhighlights($row) $isbold
2344 proc next_hlcont {} {
2345 global fhl_row fhl_dirn displayorder numcommits
2346 global vhighlights fhighlights nhighlights rhighlights
2347 global hlview filehighlight findstring highlight_related
2349 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2352 if {$row < 0 || $row >= $numcommits} {
2357 set id [lindex $displayorder $row]
2358 if {[info exists hlview]} {
2359 if {![info exists vhighlights($row)]} {
2360 askvhighlight $row $id
2362 if {$vhighlights($row) > 0} break
2364 if {$findstring ne {}} {
2365 if {![info exists nhighlights($row)]} {
2366 askfindhighlight $row $id
2368 if {$nhighlights($row) > 0} break
2370 if {$highlight_related ne "None"} {
2371 if {![info exists rhighlights($row)]} {
2372 askrelhighlight $row $id
2374 if {$rhighlights($row) > 0} break
2376 if {[info exists filehighlight]} {
2377 if {![info exists fhighlights($row)]} {
2378 # ask for a few more while we're at it...
2380 for {set n 0} {$n < 100} {incr n} {
2381 if {![info exists fhighlights($r)]} {
2382 askfilehighlight $r [lindex $displayorder $r]
2385 if {$r < 0 || $r >= $numcommits} break
2389 if {$fhighlights($row) < 0} {
2393 if {$fhighlights($row) > 0} break
2401 proc next_highlight {dirn} {
2402 global selectedline fhl_row fhl_dirn
2403 global hlview filehighlight findstring highlight_related
2405 if {![info exists selectedline]} return
2406 if {!([info exists hlview] || $findstring ne {} ||
2407 $highlight_related ne "None" || [info exists filehighlight])} return
2408 set fhl_row [expr {$selectedline + $dirn}]
2413 proc cancel_next_highlight {} {
2419 # Graph layout functions
2421 proc shortids {ids} {
2424 if {[llength $id] > 1} {
2425 lappend res [shortids $id]
2426 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2427 lappend res [string range $id 0 7]
2435 proc incrange {l x o} {
2438 set e [lindex $l $x]
2440 lset l $x [expr {$e + $o}]
2449 for {} {$n > 0} {incr n -1} {
2455 proc usedinrange {id l1 l2} {
2456 global children commitrow curview
2458 if {[info exists commitrow($curview,$id)]} {
2459 set r $commitrow($curview,$id)
2460 if {$l1 <= $r && $r <= $l2} {
2461 return [expr {$r - $l1 + 1}]
2464 set kids $children($curview,$id)
2466 set r $commitrow($curview,$c)
2467 if {$l1 <= $r && $r <= $l2} {
2468 return [expr {$r - $l1 + 1}]
2474 proc sanity {row {full 0}} {
2475 global rowidlist rowoffsets
2478 set ids [lindex $rowidlist $row]
2481 if {$id eq {}} continue
2482 if {$col < [llength $ids] - 1 &&
2483 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2484 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2486 set o [lindex $rowoffsets $row $col]
2492 if {[lindex $rowidlist $y $x] != $id} {
2493 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2494 puts " id=[shortids $id] check started at row $row"
2495 for {set i $row} {$i >= $y} {incr i -1} {
2496 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2501 set o [lindex $rowoffsets $y $x]
2506 proc makeuparrow {oid x y z} {
2507 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2509 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2512 set off0 [lindex $rowoffsets $y]
2513 for {set x0 $x} {1} {incr x0} {
2514 if {$x0 >= [llength $off0]} {
2515 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2518 set z [lindex $off0 $x0]
2524 set z [expr {$x0 - $x}]
2525 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2526 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2528 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2529 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2530 lappend idrowranges($oid) [lindex $displayorder $y]
2533 proc initlayout {} {
2534 global rowidlist rowoffsets displayorder commitlisted
2535 global rowlaidout rowoptim
2536 global idinlist rowchk rowrangelist idrowranges
2537 global numcommits canvxmax canv
2540 global colormap rowtextx
2551 catch {unset idinlist}
2552 catch {unset rowchk}
2555 set canvxmax [$canv cget -width]
2556 catch {unset colormap}
2557 catch {unset rowtextx}
2558 catch {unset idrowranges}
2562 proc setcanvscroll {} {
2563 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2565 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2566 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2567 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2568 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2571 proc visiblerows {} {
2572 global canv numcommits linespc
2574 set ymax [lindex [$canv cget -scrollregion] 3]
2575 if {$ymax eq {} || $ymax == 0} return
2577 set y0 [expr {int([lindex $f 0] * $ymax)}]
2578 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2582 set y1 [expr {int([lindex $f 1] * $ymax)}]
2583 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2584 if {$r1 >= $numcommits} {
2585 set r1 [expr {$numcommits - 1}]
2587 return [list $r0 $r1]
2590 proc layoutmore {tmax allread} {
2591 global rowlaidout rowoptim commitidx numcommits optim_delay
2592 global uparrowlen curview rowidlist idinlist
2595 set showdelay $optim_delay
2596 set optdelay [expr {$uparrowlen + 1}]
2598 if {$rowoptim - $showdelay > $numcommits} {
2599 showstuff [expr {$rowoptim - $showdelay}] $showlast
2600 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2601 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2605 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2607 } elseif {$commitidx($curview) > $rowlaidout} {
2608 set nr [expr {$commitidx($curview) - $rowlaidout}]
2609 # may need to increase this threshold if uparrowlen or
2610 # mingaplen are increased...
2615 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2616 if {$rowlaidout == $row} {
2619 } elseif {$allread} {
2621 set nrows $commitidx($curview)
2622 if {[lindex $rowidlist $nrows] ne {} ||
2623 [array names idinlist] ne {}} {
2625 set rowlaidout $commitidx($curview)
2626 } elseif {$rowoptim == $nrows} {
2629 if {$numcommits == $nrows} {
2636 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2642 proc showstuff {canshow last} {
2643 global numcommits commitrow pending_select selectedline curview
2644 global lookingforhead mainheadid displayorder nullid selectfirst
2645 global lastscrollset
2647 if {$numcommits == 0} {
2649 set phase "incrdraw"
2653 set prev $numcommits
2654 set numcommits $canshow
2655 set t [clock clicks -milliseconds]
2656 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2657 set lastscrollset $t
2660 set rows [visiblerows]
2661 set r1 [lindex $rows 1]
2662 if {$r1 >= $canshow} {
2663 set r1 [expr {$canshow - 1}]
2668 if {[info exists pending_select] &&
2669 [info exists commitrow($curview,$pending_select)] &&
2670 $commitrow($curview,$pending_select) < $numcommits} {
2671 selectline $commitrow($curview,$pending_select) 1
2674 if {[info exists selectedline] || [info exists pending_select]} {
2677 set l [expr {[lindex $displayorder 0] eq $nullid}]
2682 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2683 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2684 set lookingforhead 0
2689 proc doshowlocalchanges {} {
2690 global lookingforhead curview mainheadid phase commitrow
2692 if {[info exists commitrow($curview,$mainheadid)] &&
2693 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2695 } elseif {$phase ne {}} {
2696 set lookingforhead 1
2700 proc dohidelocalchanges {} {
2701 global lookingforhead localrow lserial
2703 set lookingforhead 0
2704 if {$localrow >= 0} {
2711 # spawn off a process to do git diff-index HEAD
2712 proc dodiffindex {} {
2713 global localrow lserial
2717 set fd [open "|git diff-index HEAD" r]
2718 fconfigure $fd -blocking 0
2719 filerun $fd [list readdiffindex $fd $lserial]
2722 proc readdiffindex {fd serial} {
2723 global localrow commitrow mainheadid nullid curview
2724 global commitinfo commitdata lserial
2726 if {[gets $fd line] < 0} {
2733 # we only need to see one line and we don't really care what it says...
2736 if {$serial == $lserial && $localrow == -1} {
2737 # add the line for the local diff to the graph
2738 set localrow $commitrow($curview,$mainheadid)
2739 set hl "Local uncommitted changes"
2740 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2741 set commitdata($nullid) "\n $hl\n"
2742 insertrow $localrow $nullid
2747 proc layoutrows {row endrow last} {
2748 global rowidlist rowoffsets displayorder
2749 global uparrowlen downarrowlen maxwidth mingaplen
2750 global children parentlist
2752 global commitidx curview
2753 global idinlist rowchk rowrangelist
2755 set idlist [lindex $rowidlist $row]
2756 set offs [lindex $rowoffsets $row]
2757 while {$row < $endrow} {
2758 set id [lindex $displayorder $row]
2761 foreach p [lindex $parentlist $row] {
2762 if {![info exists idinlist($p)]} {
2764 } elseif {!$idinlist($p)} {
2768 set nev [expr {[llength $idlist] + [llength $newolds]
2769 + [llength $oldolds] - $maxwidth + 1}]
2772 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2773 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2774 set i [lindex $idlist $x]
2775 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2776 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2777 [expr {$row + $uparrowlen + $mingaplen}]]
2779 set idlist [lreplace $idlist $x $x]
2780 set offs [lreplace $offs $x $x]
2781 set offs [incrange $offs $x 1]
2783 set rm1 [expr {$row - 1}]
2784 lappend idrowranges($i) [lindex $displayorder $rm1]
2785 if {[incr nev -1] <= 0} break
2788 set rowchk($id) [expr {$row + $r}]
2791 lset rowidlist $row $idlist
2792 lset rowoffsets $row $offs
2794 set col [lsearch -exact $idlist $id]
2796 set col [llength $idlist]
2798 lset rowidlist $row $idlist
2800 if {$children($curview,$id) ne {}} {
2801 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2805 lset rowoffsets $row $offs
2807 makeuparrow $id $col $row $z
2813 if {[info exists idrowranges($id)]} {
2814 set ranges $idrowranges($id)
2816 unset idrowranges($id)
2818 lappend rowrangelist $ranges
2820 set offs [ntimes [llength $idlist] 0]
2821 set l [llength $newolds]
2822 set idlist [eval lreplace \$idlist $col $col $newolds]
2825 set offs [lrange $offs 0 [expr {$col - 1}]]
2826 foreach x $newolds {
2831 set tmp [expr {[llength $idlist] - [llength $offs]}]
2833 set offs [concat $offs [ntimes $tmp $o]]
2838 foreach i $newolds {
2840 set idrowranges($i) $id
2843 foreach oid $oldolds {
2844 set idinlist($oid) 1
2845 set idlist [linsert $idlist $col $oid]
2846 set offs [linsert $offs $col $o]
2847 makeuparrow $oid $col $row $o
2850 lappend rowidlist $idlist
2851 lappend rowoffsets $offs
2856 proc addextraid {id row} {
2857 global displayorder commitrow commitinfo
2858 global commitidx commitlisted
2859 global parentlist children curview
2861 incr commitidx($curview)
2862 lappend displayorder $id
2863 lappend commitlisted 0
2864 lappend parentlist {}
2865 set commitrow($curview,$id) $row
2867 if {![info exists commitinfo($id)]} {
2868 set commitinfo($id) {"No commit information available"}
2870 if {![info exists children($curview,$id)]} {
2871 set children($curview,$id) {}
2875 proc layouttail {} {
2876 global rowidlist rowoffsets idinlist commitidx curview
2877 global idrowranges rowrangelist
2879 set row $commitidx($curview)
2880 set idlist [lindex $rowidlist $row]
2881 while {$idlist ne {}} {
2882 set col [expr {[llength $idlist] - 1}]
2883 set id [lindex $idlist $col]
2886 lappend idrowranges($id) $row
2887 lappend rowrangelist $idrowranges($id)
2888 unset idrowranges($id)
2890 set offs [ntimes $col 0]
2891 set idlist [lreplace $idlist $col $col]
2892 lappend rowidlist $idlist
2893 lappend rowoffsets $offs
2896 foreach id [array names idinlist] {
2899 lset rowidlist $row [list $id]
2900 lset rowoffsets $row 0
2901 makeuparrow $id 0 $row 0
2902 lappend idrowranges($id) $row
2903 lappend rowrangelist $idrowranges($id)
2904 unset idrowranges($id)
2906 lappend rowidlist {}
2907 lappend rowoffsets {}
2911 proc insert_pad {row col npad} {
2912 global rowidlist rowoffsets
2914 set pad [ntimes $npad {}]
2915 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2916 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2917 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2920 proc optimize_rows {row col endrow} {
2921 global rowidlist rowoffsets displayorder
2923 for {} {$row < $endrow} {incr row} {
2924 set idlist [lindex $rowidlist $row]
2925 set offs [lindex $rowoffsets $row]
2927 for {} {$col < [llength $offs]} {incr col} {
2928 if {[lindex $idlist $col] eq {}} {
2932 set z [lindex $offs $col]
2933 if {$z eq {}} continue
2935 set x0 [expr {$col + $z}]
2936 set y0 [expr {$row - 1}]
2937 set z0 [lindex $rowoffsets $y0 $x0]
2939 set id [lindex $idlist $col]
2940 set ranges [rowranges $id]
2941 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2945 # Looking at lines from this row to the previous row,
2946 # make them go straight up if they end in an arrow on
2947 # the previous row; otherwise make them go straight up
2949 if {$z < -1 || ($z < 0 && $isarrow)} {
2950 # Line currently goes left too much;
2951 # insert pads in the previous row, then optimize it
2952 set npad [expr {-1 - $z + $isarrow}]
2953 set offs [incrange $offs $col $npad]
2954 insert_pad $y0 $x0 $npad
2956 optimize_rows $y0 $x0 $row
2958 set z [lindex $offs $col]
2959 set x0 [expr {$col + $z}]
2960 set z0 [lindex $rowoffsets $y0 $x0]
2961 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2962 # Line currently goes right too much;
2963 # insert pads in this line and adjust the next's rowoffsets
2964 set npad [expr {$z - 1 + $isarrow}]
2965 set y1 [expr {$row + 1}]
2966 set offs2 [lindex $rowoffsets $y1]
2970 if {$z eq {} || $x1 + $z < $col} continue
2971 if {$x1 + $z > $col} {
2974 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2977 set pad [ntimes $npad {}]
2978 set idlist [eval linsert \$idlist $col $pad]
2979 set tmp [eval linsert \$offs $col $pad]
2981 set offs [incrange $tmp $col [expr {-$npad}]]
2982 set z [lindex $offs $col]
2985 if {$z0 eq {} && !$isarrow} {
2986 # this line links to its first child on row $row-2
2987 set rm2 [expr {$row - 2}]
2988 set id [lindex $displayorder $rm2]
2989 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2991 set z0 [expr {$xc - $x0}]
2994 # avoid lines jigging left then immediately right
2995 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2996 insert_pad $y0 $x0 1
2997 set offs [incrange $offs $col 1]
2998 optimize_rows $y0 [expr {$x0 + 1}] $row
3003 # Find the first column that doesn't have a line going right
3004 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3005 set o [lindex $offs $col]
3007 # check if this is the link to the first child
3008 set id [lindex $idlist $col]
3009 set ranges [rowranges $id]
3010 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3011 # it is, work out offset to child
3012 set y0 [expr {$row - 1}]
3013 set id [lindex $displayorder $y0]
3014 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3016 set o [expr {$x0 - $col}]
3020 if {$o eq {} || $o <= 0} break
3022 # Insert a pad at that column as long as it has a line and
3023 # isn't the last column, and adjust the next row' offsets
3024 if {$o ne {} && [incr col] < [llength $idlist]} {
3025 set y1 [expr {$row + 1}]
3026 set offs2 [lindex $rowoffsets $y1]
3030 if {$z eq {} || $x1 + $z < $col} continue
3031 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3034 set idlist [linsert $idlist $col {}]
3035 set tmp [linsert $offs $col {}]
3037 set offs [incrange $tmp $col -1]
3040 lset rowidlist $row $idlist
3041 lset rowoffsets $row $offs
3047 global canvx0 linespc
3048 return [expr {$canvx0 + $col * $linespc}]
3052 global canvy0 linespc
3053 return [expr {$canvy0 + $row * $linespc}]
3056 proc linewidth {id} {
3057 global thickerline lthickness
3060 if {[info exists thickerline] && $id eq $thickerline} {
3061 set wid [expr {2 * $lthickness}]
3066 proc rowranges {id} {
3067 global phase idrowranges commitrow rowlaidout rowrangelist curview
3071 ([info exists commitrow($curview,$id)]
3072 && $commitrow($curview,$id) < $rowlaidout)} {
3073 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3074 } elseif {[info exists idrowranges($id)]} {
3075 set ranges $idrowranges($id)
3078 foreach rid $ranges {
3079 lappend linenos $commitrow($curview,$rid)
3081 if {$linenos ne {}} {
3082 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3087 # work around tk8.4 refusal to draw arrows on diagonal segments
3088 proc adjarrowhigh {coords} {
3091 set x0 [lindex $coords 0]
3092 set x1 [lindex $coords 2]
3094 set y0 [lindex $coords 1]
3095 set y1 [lindex $coords 3]
3096 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3097 # we have a nearby vertical segment, just trim off the diag bit
3098 set coords [lrange $coords 2 end]
3100 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3101 set xi [expr {$x0 - $slope * $linespc / 2}]
3102 set yi [expr {$y0 - $linespc / 2}]
3103 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3109 proc drawlineseg {id row endrow arrowlow} {
3110 global rowidlist displayorder iddrawn linesegs
3111 global canv colormap linespc curview maxlinelen
3113 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3114 set le [expr {$row + 1}]
3117 set c [lsearch -exact [lindex $rowidlist $le] $id]
3123 set x [lindex $displayorder $le]
3128 if {[info exists iddrawn($x)] || $le == $endrow} {
3129 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3145 if {[info exists linesegs($id)]} {
3146 set lines $linesegs($id)
3148 set r0 [lindex $li 0]
3150 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3160 set li [lindex $lines [expr {$i-1}]]
3161 set r1 [lindex $li 1]
3162 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3167 set x [lindex $cols [expr {$le - $row}]]
3168 set xp [lindex $cols [expr {$le - 1 - $row}]]
3169 set dir [expr {$xp - $x}]
3171 set ith [lindex $lines $i 2]
3172 set coords [$canv coords $ith]
3173 set ah [$canv itemcget $ith -arrow]
3174 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3175 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3176 if {$x2 ne {} && $x - $x2 == $dir} {
3177 set coords [lrange $coords 0 end-2]
3180 set coords [list [xc $le $x] [yc $le]]
3183 set itl [lindex $lines [expr {$i-1}] 2]
3184 set al [$canv itemcget $itl -arrow]
3185 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3186 } elseif {$arrowlow &&
3187 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3190 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3191 for {set y $le} {[incr y -1] > $row} {} {
3193 set xp [lindex $cols [expr {$y - 1 - $row}]]
3194 set ndir [expr {$xp - $x}]
3195 if {$dir != $ndir || $xp < 0} {
3196 lappend coords [xc $y $x] [yc $y]
3202 # join parent line to first child
3203 set ch [lindex $displayorder $row]
3204 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3206 puts "oops: drawlineseg: child $ch not on row $row"
3209 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3210 } elseif {$xc > $x + 1} {
3211 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3215 lappend coords [xc $row $x] [yc $row]
3217 set xn [xc $row $xp]
3219 # work around tk8.4 refusal to draw arrows on diagonal segments
3220 if {$arrowlow && $xn != [lindex $coords end-1]} {
3221 if {[llength $coords] < 4 ||
3222 [lindex $coords end-3] != [lindex $coords end-1] ||
3223 [lindex $coords end] - $yn > 2 * $linespc} {
3224 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3225 set yo [yc [expr {$row + 0.5}]]
3226 lappend coords $xn $yo $xn $yn
3229 lappend coords $xn $yn
3234 set coords [adjarrowhigh $coords]
3237 set t [$canv create line $coords -width [linewidth $id] \
3238 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3241 set lines [linsert $lines $i [list $row $le $t]]
3243 $canv coords $ith $coords
3244 if {$arrow ne $ah} {
3245 $canv itemconf $ith -arrow $arrow
3247 lset lines $i 0 $row
3250 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3251 set ndir [expr {$xo - $xp}]
3252 set clow [$canv coords $itl]
3253 if {$dir == $ndir} {
3254 set clow [lrange $clow 2 end]
3256 set coords [concat $coords $clow]
3258 lset lines [expr {$i-1}] 1 $le
3260 set coords [adjarrowhigh $coords]
3263 # coalesce two pieces
3265 set b [lindex $lines [expr {$i-1}] 0]
3266 set e [lindex $lines $i 1]
3267 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3269 $canv coords $itl $coords
3270 if {$arrow ne $al} {
3271 $canv itemconf $itl -arrow $arrow
3275 set linesegs($id) $lines
3279 proc drawparentlinks {id row} {
3280 global rowidlist canv colormap curview parentlist
3283 set rowids [lindex $rowidlist $row]
3284 set col [lsearch -exact $rowids $id]
3285 if {$col < 0} return
3286 set olds [lindex $parentlist $row]
3287 set row2 [expr {$row + 1}]
3288 set x [xc $row $col]
3291 set ids [lindex $rowidlist $row2]
3292 # rmx = right-most X coord used
3295 set i [lsearch -exact $ids $p]
3297 puts "oops, parent $p of $id not in list"
3300 set x2 [xc $row2 $i]
3304 if {[lsearch -exact $rowids $p] < 0} {
3305 # drawlineseg will do this one for us
3309 # should handle duplicated parents here...
3310 set coords [list $x $y]
3311 if {$i < $col - 1} {
3312 lappend coords [xc $row [expr {$i + 1}]] $y
3313 } elseif {$i > $col + 1} {
3314 lappend coords [xc $row [expr {$i - 1}]] $y
3316 lappend coords $x2 $y2
3317 set t [$canv create line $coords -width [linewidth $p] \
3318 -fill $colormap($p) -tags lines.$p]
3322 if {$rmx > [lindex $idpos($id) 1]} {
3323 lset idpos($id) 1 $rmx
3328 proc drawlines {id} {
3331 $canv itemconf lines.$id -width [linewidth $id]
3334 proc drawcmittext {id row col} {
3335 global linespc canv canv2 canv3 canvy0 fgcolor
3336 global commitlisted commitinfo rowidlist parentlist
3337 global rowtextx idpos idtags idheads idotherrefs
3338 global linehtag linentag linedtag markingmatches
3339 global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3341 if {$id eq $nullid} {
3344 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3346 set x [xc $row $col]
3348 set orad [expr {$linespc / 3}]
3349 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3350 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3351 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3353 $canv bind $t <1> {selcanvline {} %x %y}
3354 set rmx [llength [lindex $rowidlist $row]]
3355 set olds [lindex $parentlist $row]
3357 set nextids [lindex $rowidlist [expr {$row + 1}]]
3359 set i [lsearch -exact $nextids $p]
3365 set xt [xc $row $rmx]
3366 set rowtextx($row) $xt
3367 set idpos($id) [list $x $xt $y]
3368 if {[info exists idtags($id)] || [info exists idheads($id)]
3369 || [info exists idotherrefs($id)]} {
3370 set xt [drawtags $id $x $xt $y]
3372 set headline [lindex $commitinfo($id) 0]
3373 set name [lindex $commitinfo($id) 1]
3374 set date [lindex $commitinfo($id) 2]
3375 set date [formatdate $date]
3378 set isbold [ishighlighted $row]
3380 lappend boldrows $row
3383 lappend boldnamerows $row
3387 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3388 -text $headline -font $font -tags text]
3389 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3390 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3391 -text $name -font $nfont -tags text]
3392 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3393 -text $date -font $mainfont -tags text]
3394 set xr [expr {$xt + [font measure $mainfont $headline]}]
3395 if {$markingmatches} {
3396 markrowmatches $row $headline $name
3398 if {$xr > $canvxmax} {
3404 proc drawcmitrow {row} {
3405 global displayorder rowidlist
3407 global commitinfo parentlist numcommits
3408 global filehighlight fhighlights findstring nhighlights
3409 global hlview vhighlights
3410 global highlight_related rhighlights
3412 if {$row >= $numcommits} return
3414 set id [lindex $displayorder $row]
3415 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3416 askvhighlight $row $id
3418 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3419 askfilehighlight $row $id
3421 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3422 askfindhighlight $row $id
3424 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3425 askrelhighlight $row $id
3427 if {[info exists iddrawn($id)]} return
3428 set col [lsearch -exact [lindex $rowidlist $row] $id]
3430 puts "oops, row $row id $id not in list"
3433 if {![info exists commitinfo($id)]} {
3437 drawcmittext $id $row $col
3441 proc drawcommits {row {endrow {}}} {
3442 global numcommits iddrawn displayorder curview
3443 global parentlist rowidlist
3448 if {$endrow eq {}} {
3451 if {$endrow >= $numcommits} {
3452 set endrow [expr {$numcommits - 1}]
3455 # make the lines join to already-drawn rows either side
3456 set r [expr {$row - 1}]
3457 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3460 set er [expr {$endrow + 1}]
3461 if {$er >= $numcommits ||
3462 ![info exists iddrawn([lindex $displayorder $er])]} {
3465 for {} {$r <= $er} {incr r} {
3466 set id [lindex $displayorder $r]
3467 set wasdrawn [info exists iddrawn($id)]
3469 if {$r == $er} break
3470 set nextid [lindex $displayorder [expr {$r + 1}]]
3471 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3472 catch {unset prevlines}
3475 drawparentlinks $id $r
3477 if {[info exists lineends($r)]} {
3478 foreach lid $lineends($r) {
3479 unset prevlines($lid)
3482 set rowids [lindex $rowidlist $r]
3483 foreach lid $rowids {
3484 if {$lid eq {}} continue
3486 # see if this is the first child of any of its parents
3487 foreach p [lindex $parentlist $r] {
3488 if {[lsearch -exact $rowids $p] < 0} {
3489 # make this line extend up to the child
3490 set le [drawlineseg $p $r $er 0]
3491 lappend lineends($le) $p
3495 } elseif {![info exists prevlines($lid)]} {
3496 set le [drawlineseg $lid $r $er 1]
3497 lappend lineends($le) $lid
3498 set prevlines($lid) 1
3504 proc drawfrac {f0 f1} {
3507 set ymax [lindex [$canv cget -scrollregion] 3]
3508 if {$ymax eq {} || $ymax == 0} return
3509 set y0 [expr {int($f0 * $ymax)}]
3510 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3511 set y1 [expr {int($f1 * $ymax)}]
3512 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3513 drawcommits $row $endrow
3516 proc drawvisible {} {
3518 eval drawfrac [$canv yview]
3521 proc clear_display {} {
3522 global iddrawn linesegs
3523 global vhighlights fhighlights nhighlights rhighlights
3526 catch {unset iddrawn}
3527 catch {unset linesegs}
3528 catch {unset vhighlights}
3529 catch {unset fhighlights}
3530 catch {unset nhighlights}
3531 catch {unset rhighlights}
3534 proc findcrossings {id} {
3535 global rowidlist parentlist numcommits rowoffsets displayorder
3539 foreach {s e} [rowranges $id] {
3540 if {$e >= $numcommits} {
3541 set e [expr {$numcommits - 1}]
3543 if {$e <= $s} continue
3544 set x [lsearch -exact [lindex $rowidlist $e] $id]
3546 puts "findcrossings: oops, no [shortids $id] in row $e"
3549 for {set row $e} {[incr row -1] >= $s} {} {
3550 set olds [lindex $parentlist $row]
3551 set kid [lindex $displayorder $row]
3552 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3553 if {$kidx < 0} continue
3554 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3556 set px [lsearch -exact $nextrow $p]
3557 if {$px < 0} continue
3558 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3559 if {[lsearch -exact $ccross $p] >= 0} continue
3560 if {$x == $px + ($kidx < $px? -1: 1)} {
3562 } elseif {[lsearch -exact $cross $p] < 0} {
3567 set inc [lindex $rowoffsets $row $x]
3568 if {$inc eq {}} break
3572 return [concat $ccross {{}} $cross]
3575 proc assigncolor {id} {
3576 global colormap colors nextcolor
3577 global commitrow parentlist children children curview
3579 if {[info exists colormap($id)]} return
3580 set ncolors [llength $colors]
3581 if {[info exists children($curview,$id)]} {
3582 set kids $children($curview,$id)
3586 if {[llength $kids] == 1} {
3587 set child [lindex $kids 0]
3588 if {[info exists colormap($child)]
3589 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3590 set colormap($id) $colormap($child)
3596 foreach x [findcrossings $id] {
3598 # delimiter between corner crossings and other crossings
3599 if {[llength $badcolors] >= $ncolors - 1} break
3600 set origbad $badcolors
3602 if {[info exists colormap($x)]
3603 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3604 lappend badcolors $colormap($x)
3607 if {[llength $badcolors] >= $ncolors} {
3608 set badcolors $origbad
3610 set origbad $badcolors
3611 if {[llength $badcolors] < $ncolors - 1} {
3612 foreach child $kids {
3613 if {[info exists colormap($child)]
3614 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3615 lappend badcolors $colormap($child)
3617 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3618 if {[info exists colormap($p)]
3619 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3620 lappend badcolors $colormap($p)
3624 if {[llength $badcolors] >= $ncolors} {
3625 set badcolors $origbad
3628 for {set i 0} {$i <= $ncolors} {incr i} {
3629 set c [lindex $colors $nextcolor]
3630 if {[incr nextcolor] >= $ncolors} {
3633 if {[lsearch -exact $badcolors $c]} break
3635 set colormap($id) $c
3638 proc bindline {t id} {
3641 $canv bind $t <Enter> "lineenter %x %y $id"
3642 $canv bind $t <Motion> "linemotion %x %y $id"
3643 $canv bind $t <Leave> "lineleave $id"
3644 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3647 proc drawtags {id x xt y1} {
3648 global idtags idheads idotherrefs mainhead
3649 global linespc lthickness
3650 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3655 if {[info exists idtags($id)]} {
3656 set marks $idtags($id)
3657 set ntags [llength $marks]
3659 if {[info exists idheads($id)]} {
3660 set marks [concat $marks $idheads($id)]
3661 set nheads [llength $idheads($id)]
3663 if {[info exists idotherrefs($id)]} {
3664 set marks [concat $marks $idotherrefs($id)]
3670 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3671 set yt [expr {$y1 - 0.5 * $linespc}]
3672 set yb [expr {$yt + $linespc - 1}]
3676 foreach tag $marks {
3678 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3679 set wid [font measure [concat $mainfont bold] $tag]
3681 set wid [font measure $mainfont $tag]
3685 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3687 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3688 -width $lthickness -fill black -tags tag.$id]
3690 foreach tag $marks x $xvals wid $wvals {
3691 set xl [expr {$x + $delta}]
3692 set xr [expr {$x + $delta + $wid + $lthickness}]
3694 if {[incr ntags -1] >= 0} {
3696 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3697 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3698 -width 1 -outline black -fill yellow -tags tag.$id]
3699 $canv bind $t <1> [list showtag $tag 1]
3700 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3702 # draw a head or other ref
3703 if {[incr nheads -1] >= 0} {
3705 if {$tag eq $mainhead} {
3711 set xl [expr {$xl - $delta/2}]
3712 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3713 -width 1 -outline black -fill $col -tags tag.$id
3714 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3715 set rwid [font measure $mainfont $remoteprefix]
3716 set xi [expr {$x + 1}]
3717 set yti [expr {$yt + 1}]
3718 set xri [expr {$x + $rwid}]
3719 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3720 -width 0 -fill "#ffddaa" -tags tag.$id
3723 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3724 -font $font -tags [list tag.$id text]]
3726 $canv bind $t <1> [list showtag $tag 1]
3727 } elseif {$nheads >= 0} {
3728 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3734 proc xcoord {i level ln} {
3735 global canvx0 xspc1 xspc2
3737 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3738 if {$i > 0 && $i == $level} {
3739 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3740 } elseif {$i > $level} {
3741 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3746 proc show_status {msg} {
3747 global canv mainfont fgcolor
3750 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3751 -tags text -fill $fgcolor
3754 # Insert a new commit as the child of the commit on row $row.
3755 # The new commit will be displayed on row $row and the commits
3756 # on that row and below will move down one row.
3757 proc insertrow {row newcmit} {
3758 global displayorder parentlist commitlisted children
3759 global commitrow curview rowidlist rowoffsets numcommits
3760 global rowrangelist rowlaidout rowoptim numcommits
3761 global selectedline rowchk commitidx
3763 if {$row >= $numcommits} {
3764 puts "oops, inserting new row $row but only have $numcommits rows"
3767 set p [lindex $displayorder $row]
3768 set displayorder [linsert $displayorder $row $newcmit]
3769 set parentlist [linsert $parentlist $row $p]
3770 set kids $children($curview,$p)
3771 lappend kids $newcmit
3772 set children($curview,$p) $kids
3773 set children($curview,$newcmit) {}
3774 set commitlisted [linsert $commitlisted $row 1]
3775 set l [llength $displayorder]
3776 for {set r $row} {$r < $l} {incr r} {
3777 set id [lindex $displayorder $r]
3778 set commitrow($curview,$id) $r
3780 incr commitidx($curview)
3782 set idlist [lindex $rowidlist $row]
3783 set offs [lindex $rowoffsets $row]
3786 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3792 if {[llength $kids] == 1} {
3793 set col [lsearch -exact $idlist $p]
3794 lset idlist $col $newcmit
3796 set col [llength $idlist]
3797 lappend idlist $newcmit
3799 lset rowoffsets $row $offs
3801 set rowidlist [linsert $rowidlist $row $idlist]
3802 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3804 set rowrangelist [linsert $rowrangelist $row {}]
3805 if {[llength $kids] > 1} {
3806 set rp1 [expr {$row + 1}]
3807 set ranges [lindex $rowrangelist $rp1]
3808 if {$ranges eq {}} {
3809 set ranges [list $newcmit $p]
3810 } elseif {[lindex $ranges end-1] eq $p} {
3811 lset ranges end-1 $newcmit
3813 lset rowrangelist $rp1 $ranges
3816 catch {unset rowchk}
3822 if {[info exists selectedline] && $selectedline >= $row} {
3828 # Remove a commit that was inserted with insertrow on row $row.
3829 proc removerow {row} {
3830 global displayorder parentlist commitlisted children
3831 global commitrow curview rowidlist rowoffsets numcommits
3832 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3833 global linesegends selectedline rowchk commitidx
3835 if {$row >= $numcommits} {
3836 puts "oops, removing row $row but only have $numcommits rows"
3839 set rp1 [expr {$row + 1}]
3840 set id [lindex $displayorder $row]
3841 set p [lindex $parentlist $row]
3842 set displayorder [lreplace $displayorder $row $row]
3843 set parentlist [lreplace $parentlist $row $row]
3844 set commitlisted [lreplace $commitlisted $row $row]
3845 set kids $children($curview,$p)
3846 set i [lsearch -exact $kids $id]
3848 set kids [lreplace $kids $i $i]
3849 set children($curview,$p) $kids
3851 set l [llength $displayorder]
3852 for {set r $row} {$r < $l} {incr r} {
3853 set id [lindex $displayorder $r]
3854 set commitrow($curview,$id) $r
3856 incr commitidx($curview) -1
3858 set rowidlist [lreplace $rowidlist $row $row]
3859 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3861 set offs [lindex $rowoffsets $row]
3862 set offs [lreplace $offs end end]
3863 lset rowoffsets $row $offs
3866 set rowrangelist [lreplace $rowrangelist $row $row]
3867 if {[llength $kids] > 0} {
3868 set ranges [lindex $rowrangelist $row]
3869 if {[lindex $ranges end-1] eq $id} {
3870 set ranges [lreplace $ranges end-1 end]
3871 lset rowrangelist $row $ranges
3875 catch {unset rowchk}
3881 if {[info exists selectedline] && $selectedline > $row} {
3882 incr selectedline -1
3887 # Don't change the text pane cursor if it is currently the hand cursor,
3888 # showing that we are over a sha1 ID link.
3889 proc settextcursor {c} {
3890 global ctext curtextcursor
3892 if {[$ctext cget -cursor] == $curtextcursor} {
3893 $ctext config -cursor $c
3895 set curtextcursor $c
3898 proc nowbusy {what} {
3901 if {[array names isbusy] eq {}} {
3902 . config -cursor watch
3908 proc notbusy {what} {
3909 global isbusy maincursor textcursor
3911 catch {unset isbusy($what)}
3912 if {[array names isbusy] eq {}} {
3913 . config -cursor $maincursor
3914 settextcursor $textcursor
3918 proc findmatches {f} {
3919 global findtype findstring
3920 if {$findtype == "Regexp"} {
3921 set matches [regexp -indices -all -inline $findstring $f]
3924 if {$findtype == "IgnCase"} {
3925 set f [string tolower $f]
3926 set fs [string tolower $fs]
3930 set l [string length $fs]
3931 while {[set j [string first $fs $f $i]] >= 0} {
3932 lappend matches [list $j [expr {$j+$l-1}]]
3933 set i [expr {$j + $l}]
3939 proc dofind {{rev 0}} {
3940 global findstring findstartline findcurline selectedline numcommits
3944 cancel_next_highlight
3946 if {$findstring eq {} || $numcommits == 0} return
3947 if {![info exists selectedline]} {
3948 set findstartline [lindex [visiblerows] $rev]
3950 set findstartline $selectedline
3952 set findcurline $findstartline
3957 set findcurline $findstartline
3958 if {$findcurline == 0} {
3959 set findcurline $numcommits
3966 proc findnext {restart} {
3968 if {![info exists findcurline]} {
3982 if {![info exists findcurline]} {
3991 global commitdata commitinfo numcommits findstring findpattern findloc
3992 global findstartline findcurline markingmatches displayorder
3994 set fldtypes {Headline Author Date Committer CDate Comments}
3995 set l [expr {$findcurline + 1}]
3996 if {$l >= $numcommits} {
3999 if {$l <= $findstartline} {
4000 set lim [expr {$findstartline + 1}]
4004 if {$lim - $l > 500} {
4005 set lim [expr {$l + 500}]
4008 for {} {$l < $lim} {incr l} {
4009 set id [lindex $displayorder $l]
4010 if {![doesmatch $commitdata($id)]} continue
4011 if {![info exists commitinfo($id)]} {
4014 set info $commitinfo($id)
4015 foreach f $info ty $fldtypes {
4016 if {($findloc eq "All fields" || $findloc eq $ty) &&
4018 set markingmatches 1
4025 if {$l == $findstartline + 1} {
4031 set findcurline [expr {$l - 1}]
4035 proc findmorerev {} {
4036 global commitdata commitinfo numcommits findstring findpattern findloc
4037 global findstartline findcurline markingmatches displayorder
4039 set fldtypes {Headline Author Date Committer CDate Comments}
4045 if {$l >= $findstartline} {
4046 set lim [expr {$findstartline - 1}]
4050 if {$l - $lim > 500} {
4051 set lim [expr {$l - 500}]
4054 for {} {$l > $lim} {incr l -1} {
4055 set id [lindex $displayorder $l]
4056 if {![doesmatch $commitdata($id)]} continue
4057 if {![info exists commitinfo($id)]} {
4060 set info $commitinfo($id)
4061 foreach f $info ty $fldtypes {
4062 if {($findloc eq "All fields" || $findloc eq $ty) &&
4064 set markingmatches 1
4077 set findcurline [expr {$l + 1}]
4081 proc findselectline {l} {
4082 global findloc commentend ctext
4084 if {$findloc == "All fields" || $findloc == "Comments"} {
4085 # highlight the matches in the comments
4086 set f [$ctext get 1.0 $commentend]
4087 set matches [findmatches $f]
4088 foreach match $matches {
4089 set start [lindex $match 0]
4090 set end [expr {[lindex $match 1] + 1}]
4091 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4096 proc stopfindproc {{done 0}} {
4097 global findprocpid findprocfile findids
4098 global ctext findoldcursor phase maincursor textcursor
4099 global findinprogress
4101 catch {unset findids}
4102 if {[info exists findprocpid]} {
4104 catch {exec kill $findprocpid}
4106 catch {close $findprocfile}
4109 catch {unset findinprogress}
4113 # mark the bits of a headline or author that match a find string
4114 proc markmatches {canv l str tag matches font} {
4115 set bbox [$canv bbox $tag]
4116 set x0 [lindex $bbox 0]
4117 set y0 [lindex $bbox 1]
4118 set y1 [lindex $bbox 3]
4119 foreach match $matches {
4120 set start [lindex $match 0]
4121 set end [lindex $match 1]
4122 if {$start > $end} continue
4123 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4124 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4125 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4126 [expr {$x0+$xlen+2}] $y1 \
4127 -outline {} -tags [list match$l matches] -fill yellow]
4132 proc unmarkmatches {} {
4133 global findids markingmatches findcurline
4135 allcanvs delete matches
4136 catch {unset findids}
4137 set markingmatches 0
4138 catch {unset findcurline}
4141 proc selcanvline {w x y} {
4142 global canv canvy0 ctext linespc
4144 set ymax [lindex [$canv cget -scrollregion] 3]
4145 if {$ymax == {}} return
4146 set yfrac [lindex [$canv yview] 0]
4147 set y [expr {$y + $yfrac * $ymax}]
4148 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4153 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4159 proc commit_descriptor {p} {
4161 if {![info exists commitinfo($p)]} {
4165 if {[llength $commitinfo($p)] > 1} {
4166 set l [lindex $commitinfo($p) 0]
4171 # append some text to the ctext widget, and make any SHA1 ID
4172 # that we know about be a clickable link.
4173 proc appendwithlinks {text tags} {
4174 global ctext commitrow linknum curview
4176 set start [$ctext index "end - 1c"]
4177 $ctext insert end $text $tags
4178 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4182 set linkid [string range $text $s $e]
4183 if {![info exists commitrow($curview,$linkid)]} continue
4185 $ctext tag add link "$start + $s c" "$start + $e c"
4186 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4187 $ctext tag bind link$linknum <1> \
4188 [list selectline $commitrow($curview,$linkid) 1]
4191 $ctext tag conf link -foreground blue -underline 1
4192 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4193 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4196 proc viewnextline {dir} {
4200 set ymax [lindex [$canv cget -scrollregion] 3]
4201 set wnow [$canv yview]
4202 set wtop [expr {[lindex $wnow 0] * $ymax}]
4203 set newtop [expr {$wtop + $dir * $linespc}]
4206 } elseif {$newtop > $ymax} {
4209 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4212 # add a list of tag or branch names at position pos
4213 # returns the number of names inserted
4214 proc appendrefs {pos ids var} {
4215 global ctext commitrow linknum curview $var maxrefs
4217 if {[catch {$ctext index $pos}]} {
4220 $ctext conf -state normal
4221 $ctext delete $pos "$pos lineend"
4224 foreach tag [set $var\($id\)] {
4225 lappend tags [list $tag $id]
4228 if {[llength $tags] > $maxrefs} {
4229 $ctext insert $pos "many ([llength $tags])"
4231 set tags [lsort -index 0 -decreasing $tags]
4234 set id [lindex $ti 1]
4237 $ctext tag delete $lk
4238 $ctext insert $pos $sep
4239 $ctext insert $pos [lindex $ti 0] $lk
4240 if {[info exists commitrow($curview,$id)]} {
4241 $ctext tag conf $lk -foreground blue
4242 $ctext tag bind $lk <1> \
4243 [list selectline $commitrow($curview,$id) 1]
4244 $ctext tag conf $lk -underline 1
4245 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4246 $ctext tag bind $lk <Leave> \
4247 { %W configure -cursor $curtextcursor }
4252 $ctext conf -state disabled
4253 return [llength $tags]
4256 # called when we have finished computing the nearby tags
4257 proc dispneartags {delay} {
4258 global selectedline currentid showneartags tagphase
4260 if {![info exists selectedline] || !$showneartags} return
4261 after cancel dispnexttag
4263 after 200 dispnexttag
4266 after idle dispnexttag
4271 proc dispnexttag {} {
4272 global selectedline currentid showneartags tagphase ctext
4274 if {![info exists selectedline] || !$showneartags} return
4275 switch -- $tagphase {
4277 set dtags [desctags $currentid]
4279 appendrefs precedes $dtags idtags
4283 set atags [anctags $currentid]
4285 appendrefs follows $atags idtags
4289 set dheads [descheads $currentid]
4290 if {$dheads ne {}} {
4291 if {[appendrefs branch $dheads idheads] > 1
4292 && [$ctext get "branch -3c"] eq "h"} {
4293 # turn "Branch" into "Branches"
4294 $ctext conf -state normal
4295 $ctext insert "branch -2c" "es"
4296 $ctext conf -state disabled
4301 if {[incr tagphase] <= 2} {
4302 after idle dispnexttag
4306 proc selectline {l isnew} {
4307 global canv canv2 canv3 ctext commitinfo selectedline
4308 global displayorder linehtag linentag linedtag
4309 global canvy0 linespc parentlist children curview
4310 global currentid sha1entry
4311 global commentend idtags linknum
4312 global mergemax numcommits pending_select
4313 global cmitmode showneartags allcommits
4315 catch {unset pending_select}
4318 cancel_next_highlight
4319 if {$l < 0 || $l >= $numcommits} return
4320 set y [expr {$canvy0 + $l * $linespc}]
4321 set ymax [lindex [$canv cget -scrollregion] 3]
4322 set ytop [expr {$y - $linespc - 1}]
4323 set ybot [expr {$y + $linespc + 1}]
4324 set wnow [$canv yview]
4325 set wtop [expr {[lindex $wnow 0] * $ymax}]
4326 set wbot [expr {[lindex $wnow 1] * $ymax}]
4327 set wh [expr {$wbot - $wtop}]
4329 if {$ytop < $wtop} {
4330 if {$ybot < $wtop} {
4331 set newtop [expr {$y - $wh / 2.0}]
4334 if {$newtop > $wtop - $linespc} {
4335 set newtop [expr {$wtop - $linespc}]
4338 } elseif {$ybot > $wbot} {
4339 if {$ytop > $wbot} {
4340 set newtop [expr {$y - $wh / 2.0}]
4342 set newtop [expr {$ybot - $wh}]
4343 if {$newtop < $wtop + $linespc} {
4344 set newtop [expr {$wtop + $linespc}]
4348 if {$newtop != $wtop} {
4352 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4356 if {![info exists linehtag($l)]} return
4358 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4359 -tags secsel -fill [$canv cget -selectbackground]]
4361 $canv2 delete secsel
4362 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4363 -tags secsel -fill [$canv2 cget -selectbackground]]
4365 $canv3 delete secsel
4366 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4367 -tags secsel -fill [$canv3 cget -selectbackground]]
4371 addtohistory [list selectline $l 0]
4376 set id [lindex $displayorder $l]
4378 $sha1entry delete 0 end
4379 $sha1entry insert 0 $id
4380 $sha1entry selection from 0
4381 $sha1entry selection to end
4384 $ctext conf -state normal
4387 set info $commitinfo($id)
4388 set date [formatdate [lindex $info 2]]
4389 $ctext insert end "Author: [lindex $info 1] $date\n"
4390 set date [formatdate [lindex $info 4]]
4391 $ctext insert end "Committer: [lindex $info 3] $date\n"
4392 if {[info exists idtags($id)]} {
4393 $ctext insert end "Tags:"
4394 foreach tag $idtags($id) {
4395 $ctext insert end " $tag"
4397 $ctext insert end "\n"
4401 set olds [lindex $parentlist $l]
4402 if {[llength $olds] > 1} {
4405 if {$np >= $mergemax} {
4410 $ctext insert end "Parent: " $tag
4411 appendwithlinks [commit_descriptor $p] {}
4416 append headers "Parent: [commit_descriptor $p]"
4420 foreach c $children($curview,$id) {
4421 append headers "Child: [commit_descriptor $c]"
4424 # make anything that looks like a SHA1 ID be a clickable link
4425 appendwithlinks $headers {}
4426 if {$showneartags} {
4427 if {![info exists allcommits]} {
4430 $ctext insert end "Branch: "
4431 $ctext mark set branch "end -1c"
4432 $ctext mark gravity branch left
4433 $ctext insert end "\nFollows: "
4434 $ctext mark set follows "end -1c"
4435 $ctext mark gravity follows left
4436 $ctext insert end "\nPrecedes: "
4437 $ctext mark set precedes "end -1c"
4438 $ctext mark gravity precedes left
4439 $ctext insert end "\n"
4442 $ctext insert end "\n"
4443 set comment [lindex $info 5]
4444 if {[string first "\r" $comment] >= 0} {
4445 set comment [string map {"\r" "\n "} $comment]
4447 appendwithlinks $comment {comment}
4449 $ctext tag remove found 1.0 end
4450 $ctext conf -state disabled
4451 set commentend [$ctext index "end - 1c"]
4453 init_flist "Comments"
4454 if {$cmitmode eq "tree"} {
4456 } elseif {[llength $olds] <= 1} {
4463 proc selfirstline {} {
4468 proc sellastline {} {
4471 set l [expr {$numcommits - 1}]
4475 proc selnextline {dir} {
4477 if {![info exists selectedline]} return
4478 set l [expr {$selectedline + $dir}]
4483 proc selnextpage {dir} {
4484 global canv linespc selectedline numcommits
4486 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4490 allcanvs yview scroll [expr {$dir * $lpp}] units
4492 if {![info exists selectedline]} return
4493 set l [expr {$selectedline + $dir * $lpp}]
4496 } elseif {$l >= $numcommits} {
4497 set l [expr $numcommits - 1]
4503 proc unselectline {} {
4504 global selectedline currentid
4506 catch {unset selectedline}
4507 catch {unset currentid}
4508 allcanvs delete secsel
4510 cancel_next_highlight
4513 proc reselectline {} {
4516 if {[info exists selectedline]} {
4517 selectline $selectedline 0
4521 proc addtohistory {cmd} {
4522 global history historyindex curview
4524 set elt [list $curview $cmd]
4525 if {$historyindex > 0
4526 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4530 if {$historyindex < [llength $history]} {
4531 set history [lreplace $history $historyindex end $elt]
4533 lappend history $elt
4536 if {$historyindex > 1} {
4537 .tf.bar.leftbut conf -state normal
4539 .tf.bar.leftbut conf -state disabled
4541 .tf.bar.rightbut conf -state disabled
4547 set view [lindex $elt 0]
4548 set cmd [lindex $elt 1]
4549 if {$curview != $view} {
4556 global history historyindex
4558 if {$historyindex > 1} {
4559 incr historyindex -1
4560 godo [lindex $history [expr {$historyindex - 1}]]
4561 .tf.bar.rightbut conf -state normal
4563 if {$historyindex <= 1} {
4564 .tf.bar.leftbut conf -state disabled
4569 global history historyindex
4571 if {$historyindex < [llength $history]} {
4572 set cmd [lindex $history $historyindex]
4575 .tf.bar.leftbut conf -state normal
4577 if {$historyindex >= [llength $history]} {
4578 .tf.bar.rightbut conf -state disabled
4583 global treefilelist treeidlist diffids diffmergeid treepending nullid
4586 catch {unset diffmergeid}
4587 if {![info exists treefilelist($id)]} {
4588 if {![info exists treepending]} {
4589 if {$id ne $nullid} {
4590 set cmd [concat | git ls-tree -r $id]
4592 set cmd [concat | git ls-files]
4594 if {[catch {set gtf [open $cmd r]}]} {
4598 set treefilelist($id) {}
4599 set treeidlist($id) {}
4600 fconfigure $gtf -blocking 0
4601 filerun $gtf [list gettreeline $gtf $id]
4608 proc gettreeline {gtf id} {
4609 global treefilelist treeidlist treepending cmitmode diffids nullid
4612 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4613 if {$diffids ne $nullid} {
4614 if {[lindex $line 1] ne "blob"} continue
4615 set i [string first "\t" $line]
4616 if {$i < 0} continue
4617 set sha1 [lindex $line 2]
4618 set fname [string range $line [expr {$i+1}] end]
4619 if {[string index $fname 0] eq "\""} {
4620 set fname [lindex $fname 0]
4622 lappend treeidlist($id) $sha1
4626 lappend treefilelist($id) $fname
4629 return [expr {$nl >= 1000? 2: 1}]
4633 if {$cmitmode ne "tree"} {
4634 if {![info exists diffmergeid]} {
4635 gettreediffs $diffids
4637 } elseif {$id ne $diffids} {
4646 global treefilelist treeidlist diffids nullid
4647 global ctext commentend
4649 set i [lsearch -exact $treefilelist($diffids) $f]
4651 puts "oops, $f not in list for id $diffids"
4654 if {$diffids ne $nullid} {
4655 set blob [lindex $treeidlist($diffids) $i]
4656 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4657 puts "oops, error reading blob $blob: $err"
4661 if {[catch {set bf [open $f r]} err]} {
4662 puts "oops, can't read $f: $err"
4666 fconfigure $bf -blocking 0
4667 filerun $bf [list getblobline $bf $diffids]
4668 $ctext config -state normal
4669 clear_ctext $commentend
4670 $ctext insert end "\n"
4671 $ctext insert end "$f\n" filesep
4672 $ctext config -state disabled
4673 $ctext yview $commentend
4676 proc getblobline {bf id} {
4677 global diffids cmitmode ctext
4679 if {$id ne $diffids || $cmitmode ne "tree"} {
4683 $ctext config -state normal
4685 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4686 $ctext insert end "$line\n"
4689 # delete last newline
4690 $ctext delete "end - 2c" "end - 1c"
4694 $ctext config -state disabled
4695 return [expr {$nl >= 1000? 2: 1}]
4698 proc mergediff {id l} {
4699 global diffmergeid diffopts mdifffd
4705 # this doesn't seem to actually affect anything...
4706 set env(GIT_DIFF_OPTS) $diffopts
4707 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4708 if {[catch {set mdf [open $cmd r]} err]} {
4709 error_popup "Error getting merge diffs: $err"
4712 fconfigure $mdf -blocking 0
4713 set mdifffd($id) $mdf
4714 set np [llength [lindex $parentlist $l]]
4715 filerun $mdf [list getmergediffline $mdf $id $np]
4718 proc getmergediffline {mdf id np} {
4719 global diffmergeid ctext cflist mergemax
4720 global difffilestart mdifffd
4722 $ctext conf -state normal
4724 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4725 if {![info exists diffmergeid] || $id != $diffmergeid
4726 || $mdf != $mdifffd($id)} {
4730 if {[regexp {^diff --cc (.*)} $line match fname]} {
4731 # start of a new file
4732 $ctext insert end "\n"
4733 set here [$ctext index "end - 1c"]
4734 lappend difffilestart $here
4735 add_flist [list $fname]
4736 set l [expr {(78 - [string length $fname]) / 2}]
4737 set pad [string range "----------------------------------------" 1 $l]
4738 $ctext insert end "$pad $fname $pad\n" filesep
4739 } elseif {[regexp {^@@} $line]} {
4740 $ctext insert end "$line\n" hunksep
4741 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4744 # parse the prefix - one ' ', '-' or '+' for each parent
4749 for {set j 0} {$j < $np} {incr j} {
4750 set c [string range $line $j $j]
4753 } elseif {$c == "-"} {
4755 } elseif {$c == "+"} {
4764 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4765 # line doesn't appear in result, parents in $minuses have the line
4766 set num [lindex $minuses 0]
4767 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4768 # line appears in result, parents in $pluses don't have the line
4769 lappend tags mresult
4770 set num [lindex $spaces 0]
4773 if {$num >= $mergemax} {
4778 $ctext insert end "$line\n" $tags
4781 $ctext conf -state disabled
4786 return [expr {$nr >= 1000? 2: 1}]
4789 proc startdiff {ids} {
4790 global treediffs diffids treepending diffmergeid nullid
4793 catch {unset diffmergeid}
4794 if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4795 if {![info exists treepending]} {
4803 proc addtocflist {ids} {
4804 global treediffs cflist
4805 add_flist $treediffs($ids)
4809 proc diffcmd {ids flags} {
4812 set i [lsearch -exact $ids $nullid]
4814 set cmd [concat | git diff-index $flags]
4815 if {[llength $ids] > 1} {
4817 lappend cmd -R [lindex $ids 1]
4819 lappend cmd [lindex $ids 0]
4825 set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4830 proc gettreediffs {ids} {
4831 global treediff treepending
4833 set treepending $ids
4835 if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4836 fconfigure $gdtf -blocking 0
4837 filerun $gdtf [list gettreediffline $gdtf $ids]
4840 proc gettreediffline {gdtf ids} {
4841 global treediff treediffs treepending diffids diffmergeid
4845 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4846 set i [string first "\t" $line]
4848 set file [string range $line [expr {$i+1}] end]
4849 if {[string index $file 0] eq "\""} {
4850 set file [lindex $file 0]
4852 lappend treediff $file
4856 return [expr {$nr >= 1000? 2: 1}]
4859 set treediffs($ids) $treediff
4861 if {$cmitmode eq "tree"} {
4863 } elseif {$ids != $diffids} {
4864 if {![info exists diffmergeid]} {
4865 gettreediffs $diffids
4873 proc getblobdiffs {ids} {
4874 global diffopts blobdifffd diffids env
4875 global diffinhdr treediffs
4877 set env(GIT_DIFF_OPTS) $diffopts
4878 if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4879 puts "error getting diffs: $err"
4883 fconfigure $bdf -blocking 0
4884 set blobdifffd($ids) $bdf
4885 filerun $bdf [list getblobdiffline $bdf $diffids]
4888 proc setinlist {var i val} {
4891 while {[llength [set $var]] < $i} {
4894 if {[llength [set $var]] == $i} {
4901 proc makediffhdr {fname ids} {
4902 global ctext curdiffstart treediffs
4904 set i [lsearch -exact $treediffs($ids) $fname]
4906 setinlist difffilestart $i $curdiffstart
4908 set l [expr {(78 - [string length $fname]) / 2}]
4909 set pad [string range "----------------------------------------" 1 $l]
4910 $ctext insert $curdiffstart "$pad $fname $pad" filesep
4913 proc getblobdiffline {bdf ids} {
4914 global diffids blobdifffd ctext curdiffstart
4915 global diffnexthead diffnextnote difffilestart
4916 global diffinhdr treediffs
4919 $ctext conf -state normal
4920 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4921 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4925 if {![string compare -length 11 "diff --git " $line]} {
4926 # trim off "diff --git "
4927 set line [string range $line 11 end]
4929 # start of a new file
4930 $ctext insert end "\n"
4931 set curdiffstart [$ctext index "end - 1c"]
4932 $ctext insert end "\n" filesep
4933 # If the name hasn't changed the length will be odd,
4934 # the middle char will be a space, and the two bits either
4935 # side will be a/name and b/name, or "a/name" and "b/name".
4936 # If the name has changed we'll get "rename from" and
4937 # "rename to" lines following this, and we'll use them
4938 # to get the filenames.
4939 # This complexity is necessary because spaces in the filename(s)
4940 # don't get escaped.
4941 set l [string length $line]
4942 set i [expr {$l / 2}]
4943 if {!(($l & 1) && [string index $line $i] eq " " &&
4944 [string range $line 2 [expr {$i - 1}]] eq \
4945 [string range $line [expr {$i + 3}] end])} {
4948 # unescape if quoted and chop off the a/ from the front
4949 if {[string index $line 0] eq "\""} {
4950 set fname [string range [lindex $line 0] 2 end]
4952 set fname [string range $line 2 [expr {$i - 1}]]
4954 makediffhdr $fname $ids
4956 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
4957 $line match f1l f1c f2l f2c rest]} {
4958 $ctext insert end "$line\n" hunksep
4961 } elseif {$diffinhdr} {
4962 if {![string compare -length 12 "rename from " $line]} {
4963 set fname [string range $line 12 end]
4964 if {[string index $fname 0] eq "\""} {
4965 set fname [lindex $fname 0]
4967 set i [lsearch -exact $treediffs($ids) $fname]
4969 setinlist difffilestart $i $curdiffstart
4971 } elseif {![string compare -length 10 $line "rename to "]} {
4972 set fname [string range $line 10 end]
4973 if {[string index $fname 0] eq "\""} {
4974 set fname [lindex $fname 0]
4976 makediffhdr $fname $ids
4977 } elseif {[string compare -length 3 $line "---"] == 0} {
4980 } elseif {[string compare -length 3 $line "+++"] == 0} {
4984 $ctext insert end "$line\n" filesep
4987 set x [string range $line 0 0]
4988 if {$x == "-" || $x == "+"} {
4989 set tag [expr {$x == "+"}]
4990 $ctext insert end "$line\n" d$tag
4991 } elseif {$x == " "} {
4992 $ctext insert end "$line\n"
4994 # "\ No newline at end of file",
4995 # or something else we don't recognize
4996 $ctext insert end "$line\n" hunksep
5000 $ctext conf -state disabled
5005 return [expr {$nr >= 1000? 2: 1}]
5008 proc changediffdisp {} {
5009 global ctext diffelide
5011 $ctext tag conf d0 -elide [lindex $diffelide 0]
5012 $ctext tag conf d1 -elide [lindex $diffelide 1]
5016 global difffilestart ctext
5017 set prev [lindex $difffilestart 0]
5018 set here [$ctext index @0,0]
5019 foreach loc $difffilestart {
5020 if {[$ctext compare $loc >= $here]} {
5030 global difffilestart ctext
5031 set here [$ctext index @0,0]
5032 foreach loc $difffilestart {
5033 if {[$ctext compare $loc > $here]} {
5040 proc clear_ctext {{first 1.0}} {
5041 global ctext smarktop smarkbot
5043 set l [lindex [split $first .] 0]
5044 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5047 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5050 $ctext delete $first end
5053 proc incrsearch {name ix op} {
5054 global ctext searchstring searchdirn
5056 $ctext tag remove found 1.0 end
5057 if {[catch {$ctext index anchor}]} {
5058 # no anchor set, use start of selection, or of visible area
5059 set sel [$ctext tag ranges sel]
5061 $ctext mark set anchor [lindex $sel 0]
5062 } elseif {$searchdirn eq "-forwards"} {
5063 $ctext mark set anchor @0,0
5065 $ctext mark set anchor @0,[winfo height $ctext]
5068 if {$searchstring ne {}} {
5069 set here [$ctext search $searchdirn -- $searchstring anchor]
5078 global sstring ctext searchstring searchdirn
5081 $sstring icursor end
5082 set searchdirn -forwards
5083 if {$searchstring ne {}} {
5084 set sel [$ctext tag ranges sel]
5086 set start "[lindex $sel 0] + 1c"
5087 } elseif {[catch {set start [$ctext index anchor]}]} {
5090 set match [$ctext search -count mlen -- $searchstring $start]
5091 $ctext tag remove sel 1.0 end
5097 set mend "$match + $mlen c"
5098 $ctext tag add sel $match $mend
5099 $ctext mark unset anchor
5103 proc dosearchback {} {
5104 global sstring ctext searchstring searchdirn
5107 $sstring icursor end
5108 set searchdirn -backwards
5109 if {$searchstring ne {}} {
5110 set sel [$ctext tag ranges sel]
5112 set start [lindex $sel 0]
5113 } elseif {[catch {set start [$ctext index anchor]}]} {
5114 set start @0,[winfo height $ctext]
5116 set match [$ctext search -backwards -count ml -- $searchstring $start]
5117 $ctext tag remove sel 1.0 end
5123 set mend "$match + $ml c"
5124 $ctext tag add sel $match $mend
5125 $ctext mark unset anchor
5129 proc searchmark {first last} {
5130 global ctext searchstring
5134 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5135 if {$match eq {}} break
5136 set mend "$match + $mlen c"
5137 $ctext tag add found $match $mend
5141 proc searchmarkvisible {doall} {
5142 global ctext smarktop smarkbot
5144 set topline [lindex [split [$ctext index @0,0] .] 0]
5145 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5146 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5147 # no overlap with previous
5148 searchmark $topline $botline
5149 set smarktop $topline
5150 set smarkbot $botline
5152 if {$topline < $smarktop} {
5153 searchmark $topline [expr {$smarktop-1}]
5154 set smarktop $topline
5156 if {$botline > $smarkbot} {
5157 searchmark [expr {$smarkbot+1}] $botline
5158 set smarkbot $botline
5163 proc scrolltext {f0 f1} {
5166 .bleft.sb set $f0 $f1
5167 if {$searchstring ne {}} {
5173 global linespc charspc canvx0 canvy0 mainfont
5174 global xspc1 xspc2 lthickness
5176 set linespc [font metrics $mainfont -linespace]
5177 set charspc [font measure $mainfont "m"]
5178 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5179 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5180 set lthickness [expr {int($linespc / 9) + 1}]
5181 set xspc1(0) $linespc
5189 set ymax [lindex [$canv cget -scrollregion] 3]
5190 if {$ymax eq {} || $ymax == 0} return
5191 set span [$canv yview]
5194 allcanvs yview moveto [lindex $span 0]
5196 if {[info exists selectedline]} {
5197 selectline $selectedline 0
5198 allcanvs yview moveto [lindex $span 0]
5202 proc incrfont {inc} {
5203 global mainfont textfont ctext canv phase cflist
5204 global charspc tabstop
5205 global stopped entries
5207 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5208 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5210 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5211 $cflist conf -font $textfont
5212 $ctext tag conf filesep -font [concat $textfont bold]
5213 foreach e $entries {
5214 $e conf -font $mainfont
5216 if {$phase eq "getcommits"} {
5217 $canv itemconf textitems -font $mainfont
5223 global sha1entry sha1string
5224 if {[string length $sha1string] == 40} {
5225 $sha1entry delete 0 end
5229 proc sha1change {n1 n2 op} {
5230 global sha1string currentid sha1but
5231 if {$sha1string == {}
5232 || ([info exists currentid] && $sha1string == $currentid)} {
5237 if {[$sha1but cget -state] == $state} return
5238 if {$state == "normal"} {
5239 $sha1but conf -state normal -relief raised -text "Goto: "
5241 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5245 proc gotocommit {} {
5246 global sha1string currentid commitrow tagids headids
5247 global displayorder numcommits curview
5249 if {$sha1string == {}
5250 || ([info exists currentid] && $sha1string == $currentid)} return
5251 if {[info exists tagids($sha1string)]} {
5252 set id $tagids($sha1string)
5253 } elseif {[info exists headids($sha1string)]} {
5254 set id $headids($sha1string)
5256 set id [string tolower $sha1string]
5257 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5259 foreach i $displayorder {
5260 if {[string match $id* $i]} {
5264 if {$matches ne {}} {
5265 if {[llength $matches] > 1} {
5266 error_popup "Short SHA1 id $id is ambiguous"
5269 set id [lindex $matches 0]
5273 if {[info exists commitrow($curview,$id)]} {
5274 selectline $commitrow($curview,$id) 1
5277 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5282 error_popup "$type $sha1string is not known"
5285 proc lineenter {x y id} {
5286 global hoverx hovery hoverid hovertimer
5287 global commitinfo canv
5289 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5293 if {[info exists hovertimer]} {
5294 after cancel $hovertimer
5296 set hovertimer [after 500 linehover]
5300 proc linemotion {x y id} {
5301 global hoverx hovery hoverid hovertimer
5303 if {[info exists hoverid] && $id == $hoverid} {
5306 if {[info exists hovertimer]} {
5307 after cancel $hovertimer
5309 set hovertimer [after 500 linehover]
5313 proc lineleave {id} {
5314 global hoverid hovertimer canv
5316 if {[info exists hoverid] && $id == $hoverid} {
5318 if {[info exists hovertimer]} {
5319 after cancel $hovertimer
5327 global hoverx hovery hoverid hovertimer
5328 global canv linespc lthickness
5329 global commitinfo mainfont
5331 set text [lindex $commitinfo($hoverid) 0]
5332 set ymax [lindex [$canv cget -scrollregion] 3]
5333 if {$ymax == {}} return
5334 set yfrac [lindex [$canv yview] 0]
5335 set x [expr {$hoverx + 2 * $linespc}]
5336 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5337 set x0 [expr {$x - 2 * $lthickness}]
5338 set y0 [expr {$y - 2 * $lthickness}]
5339 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5340 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5341 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5342 -fill \#ffff80 -outline black -width 1 -tags hover]
5344 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5349 proc clickisonarrow {id y} {
5352 set ranges [rowranges $id]
5353 set thresh [expr {2 * $lthickness + 6}]
5354 set n [expr {[llength $ranges] - 1}]
5355 for {set i 1} {$i < $n} {incr i} {
5356 set row [lindex $ranges $i]
5357 if {abs([yc $row] - $y) < $thresh} {
5364 proc arrowjump {id n y} {
5367 # 1 <-> 2, 3 <-> 4, etc...
5368 set n [expr {(($n - 1) ^ 1) + 1}]
5369 set row [lindex [rowranges $id] $n]
5371 set ymax [lindex [$canv cget -scrollregion] 3]
5372 if {$ymax eq {} || $ymax <= 0} return
5373 set view [$canv yview]
5374 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5375 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5379 allcanvs yview moveto $yfrac
5382 proc lineclick {x y id isnew} {
5383 global ctext commitinfo children canv thickerline curview
5385 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5390 # draw this line thicker than normal
5394 set ymax [lindex [$canv cget -scrollregion] 3]
5395 if {$ymax eq {}} return
5396 set yfrac [lindex [$canv yview] 0]
5397 set y [expr {$y + $yfrac * $ymax}]
5399 set dirn [clickisonarrow $id $y]
5401 arrowjump $id $dirn $y
5406 addtohistory [list lineclick $x $y $id 0]
5408 # fill the details pane with info about this line
5409 $ctext conf -state normal
5411 $ctext tag conf link -foreground blue -underline 1
5412 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5413 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5414 $ctext insert end "Parent:\t"
5415 $ctext insert end $id [list link link0]
5416 $ctext tag bind link0 <1> [list selbyid $id]
5417 set info $commitinfo($id)
5418 $ctext insert end "\n\t[lindex $info 0]\n"
5419 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5420 set date [formatdate [lindex $info 2]]
5421 $ctext insert end "\tDate:\t$date\n"
5422 set kids $children($curview,$id)
5424 $ctext insert end "\nChildren:"
5426 foreach child $kids {
5428 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5429 set info $commitinfo($child)
5430 $ctext insert end "\n\t"
5431 $ctext insert end $child [list link link$i]
5432 $ctext tag bind link$i <1> [list selbyid $child]
5433 $ctext insert end "\n\t[lindex $info 0]"
5434 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5435 set date [formatdate [lindex $info 2]]
5436 $ctext insert end "\n\tDate:\t$date\n"
5439 $ctext conf -state disabled
5443 proc normalline {} {
5445 if {[info exists thickerline]} {
5453 global commitrow curview
5454 if {[info exists commitrow($curview,$id)]} {
5455 selectline $commitrow($curview,$id) 1
5461 if {![info exists startmstime]} {
5462 set startmstime [clock clicks -milliseconds]
5464 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5467 proc rowmenu {x y id} {
5468 global rowctxmenu commitrow selectedline rowmenuid curview
5469 global nullid fakerowmenu mainhead
5472 if {![info exists selectedline]
5473 || $commitrow($curview,$id) eq $selectedline} {
5478 if {$id ne $nullid} {
5479 set menu $rowctxmenu
5480 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5482 set menu $fakerowmenu
5484 $menu entryconfigure "Diff this*" -state $state
5485 $menu entryconfigure "Diff selected*" -state $state
5486 $menu entryconfigure "Make patch" -state $state
5487 tk_popup $menu $x $y
5490 proc diffvssel {dirn} {
5491 global rowmenuid selectedline displayorder
5493 if {![info exists selectedline]} return
5495 set oldid [lindex $displayorder $selectedline]
5496 set newid $rowmenuid
5498 set oldid $rowmenuid
5499 set newid [lindex $displayorder $selectedline]
5501 addtohistory [list doseldiff $oldid $newid]
5502 doseldiff $oldid $newid
5505 proc doseldiff {oldid newid} {
5509 $ctext conf -state normal
5512 $ctext insert end "From "
5513 $ctext tag conf link -foreground blue -underline 1
5514 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5515 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5516 $ctext tag bind link0 <1> [list selbyid $oldid]
5517 $ctext insert end $oldid [list link link0]
5518 $ctext insert end "\n "
5519 $ctext insert end [lindex $commitinfo($oldid) 0]
5520 $ctext insert end "\n\nTo "
5521 $ctext tag bind link1 <1> [list selbyid $newid]
5522 $ctext insert end $newid [list link link1]
5523 $ctext insert end "\n "
5524 $ctext insert end [lindex $commitinfo($newid) 0]
5525 $ctext insert end "\n"
5526 $ctext conf -state disabled
5527 $ctext tag remove found 1.0 end
5528 startdiff [list $oldid $newid]
5532 global rowmenuid currentid commitinfo patchtop patchnum
5534 if {![info exists currentid]} return
5535 set oldid $currentid
5536 set oldhead [lindex $commitinfo($oldid) 0]
5537 set newid $rowmenuid
5538 set newhead [lindex $commitinfo($newid) 0]
5541 catch {destroy $top}
5543 label $top.title -text "Generate patch"
5544 grid $top.title - -pady 10
5545 label $top.from -text "From:"
5546 entry $top.fromsha1 -width 40 -relief flat
5547 $top.fromsha1 insert 0 $oldid
5548 $top.fromsha1 conf -state readonly
5549 grid $top.from $top.fromsha1 -sticky w
5550 entry $top.fromhead -width 60 -relief flat
5551 $top.fromhead insert 0 $oldhead
5552 $top.fromhead conf -state readonly
5553 grid x $top.fromhead -sticky w
5554 label $top.to -text "To:"
5555 entry $top.tosha1 -width 40 -relief flat
5556 $top.tosha1 insert 0 $newid
5557 $top.tosha1 conf -state readonly
5558 grid $top.to $top.tosha1 -sticky w
5559 entry $top.tohead -width 60 -relief flat
5560 $top.tohead insert 0 $newhead
5561 $top.tohead conf -state readonly
5562 grid x $top.tohead -sticky w
5563 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5564 grid $top.rev x -pady 10
5565 label $top.flab -text "Output file:"
5566 entry $top.fname -width 60
5567 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5569 grid $top.flab $top.fname -sticky w
5571 button $top.buts.gen -text "Generate" -command mkpatchgo
5572 button $top.buts.can -text "Cancel" -command mkpatchcan
5573 grid $top.buts.gen $top.buts.can
5574 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5575 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5576 grid $top.buts - -pady 10 -sticky ew
5580 proc mkpatchrev {} {
5583 set oldid [$patchtop.fromsha1 get]
5584 set oldhead [$patchtop.fromhead get]
5585 set newid [$patchtop.tosha1 get]
5586 set newhead [$patchtop.tohead get]
5587 foreach e [list fromsha1 fromhead tosha1 tohead] \
5588 v [list $newid $newhead $oldid $oldhead] {
5589 $patchtop.$e conf -state normal
5590 $patchtop.$e delete 0 end
5591 $patchtop.$e insert 0 $v
5592 $patchtop.$e conf -state readonly
5597 global patchtop nullid
5599 set oldid [$patchtop.fromsha1 get]
5600 set newid [$patchtop.tosha1 get]
5601 set fname [$patchtop.fname get]
5602 if {$newid eq $nullid} {
5603 set cmd [list git diff-index -p $oldid]
5604 } elseif {$oldid eq $nullid} {
5605 set cmd [list git diff-index -p -R $newid]
5607 set cmd [list git diff-tree -p $oldid $newid]
5609 lappend cmd >$fname &
5610 if {[catch {eval exec $cmd} err]} {
5611 error_popup "Error creating patch: $err"
5613 catch {destroy $patchtop}
5617 proc mkpatchcan {} {
5620 catch {destroy $patchtop}
5625 global rowmenuid mktagtop commitinfo
5629 catch {destroy $top}
5631 label $top.title -text "Create tag"
5632 grid $top.title - -pady 10
5633 label $top.id -text "ID:"
5634 entry $top.sha1 -width 40 -relief flat
5635 $top.sha1 insert 0 $rowmenuid
5636 $top.sha1 conf -state readonly
5637 grid $top.id $top.sha1 -sticky w
5638 entry $top.head -width 60 -relief flat
5639 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5640 $top.head conf -state readonly
5641 grid x $top.head -sticky w
5642 label $top.tlab -text "Tag name:"
5643 entry $top.tag -width 60
5644 grid $top.tlab $top.tag -sticky w
5646 button $top.buts.gen -text "Create" -command mktaggo
5647 button $top.buts.can -text "Cancel" -command mktagcan
5648 grid $top.buts.gen $top.buts.can
5649 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5650 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5651 grid $top.buts - -pady 10 -sticky ew
5656 global mktagtop env tagids idtags
5658 set id [$mktagtop.sha1 get]
5659 set tag [$mktagtop.tag get]
5661 error_popup "No tag name specified"
5664 if {[info exists tagids($tag)]} {
5665 error_popup "Tag \"$tag\" already exists"
5670 set fname [file join $dir "refs/tags" $tag]
5671 set f [open $fname w]
5675 error_popup "Error creating tag: $err"
5679 set tagids($tag) $id
5680 lappend idtags($id) $tag
5685 proc redrawtags {id} {
5686 global canv linehtag commitrow idpos selectedline curview
5687 global mainfont canvxmax iddrawn
5689 if {![info exists commitrow($curview,$id)]} return
5690 if {![info exists iddrawn($id)]} return
5691 drawcommits $commitrow($curview,$id)
5692 $canv delete tag.$id
5693 set xt [eval drawtags $id $idpos($id)]
5694 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5695 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5696 set xr [expr {$xt + [font measure $mainfont $text]}]
5697 if {$xr > $canvxmax} {
5701 if {[info exists selectedline]
5702 && $selectedline == $commitrow($curview,$id)} {
5703 selectline $selectedline 0
5710 catch {destroy $mktagtop}
5719 proc writecommit {} {
5720 global rowmenuid wrcomtop commitinfo wrcomcmd
5722 set top .writecommit
5724 catch {destroy $top}
5726 label $top.title -text "Write commit to file"
5727 grid $top.title - -pady 10
5728 label $top.id -text "ID:"
5729 entry $top.sha1 -width 40 -relief flat
5730 $top.sha1 insert 0 $rowmenuid
5731 $top.sha1 conf -state readonly
5732 grid $top.id $top.sha1 -sticky w
5733 entry $top.head -width 60 -relief flat
5734 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5735 $top.head conf -state readonly
5736 grid x $top.head -sticky w
5737 label $top.clab -text "Command:"
5738 entry $top.cmd -width 60 -textvariable wrcomcmd
5739 grid $top.clab $top.cmd -sticky w -pady 10
5740 label $top.flab -text "Output file:"
5741 entry $top.fname -width 60
5742 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5743 grid $top.flab $top.fname -sticky w
5745 button $top.buts.gen -text "Write" -command wrcomgo
5746 button $top.buts.can -text "Cancel" -command wrcomcan
5747 grid $top.buts.gen $top.buts.can
5748 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5749 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5750 grid $top.buts - -pady 10 -sticky ew
5757 set id [$wrcomtop.sha1 get]
5758 set cmd "echo $id | [$wrcomtop.cmd get]"
5759 set fname [$wrcomtop.fname get]
5760 if {[catch {exec sh -c $cmd >$fname &} err]} {
5761 error_popup "Error writing commit: $err"
5763 catch {destroy $wrcomtop}
5770 catch {destroy $wrcomtop}
5775 global rowmenuid mkbrtop
5778 catch {destroy $top}
5780 label $top.title -text "Create new branch"
5781 grid $top.title - -pady 10
5782 label $top.id -text "ID:"
5783 entry $top.sha1 -width 40 -relief flat
5784 $top.sha1 insert 0 $rowmenuid
5785 $top.sha1 conf -state readonly
5786 grid $top.id $top.sha1 -sticky w
5787 label $top.nlab -text "Name:"
5788 entry $top.name -width 40
5789 grid $top.nlab $top.name -sticky w
5791 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5792 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5793 grid $top.buts.go $top.buts.can
5794 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5795 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5796 grid $top.buts - -pady 10 -sticky ew
5801 global headids idheads
5803 set name [$top.name get]
5804 set id [$top.sha1 get]
5806 error_popup "Please specify a name for the new branch"
5809 catch {destroy $top}
5813 exec git branch $name $id
5818 set headids($name) $id
5819 lappend idheads($id) $name
5827 proc cherrypick {} {
5828 global rowmenuid curview commitrow
5831 set oldhead [exec git rev-parse HEAD]
5832 set dheads [descheads $rowmenuid]
5833 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5834 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5835 included in branch $mainhead -- really re-apply it?"]
5840 # Unfortunately git-cherry-pick writes stuff to stderr even when
5841 # no error occurs, and exec takes that as an indication of error...
5842 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5847 set newhead [exec git rev-parse HEAD]
5848 if {$newhead eq $oldhead} {
5850 error_popup "No changes committed"
5853 addnewchild $newhead $oldhead
5854 if {[info exists commitrow($curview,$oldhead)]} {
5855 insertrow $commitrow($curview,$oldhead) $newhead
5856 if {$mainhead ne {}} {
5857 movehead $newhead $mainhead
5858 movedhead $newhead $mainhead
5867 global mainheadid mainhead rowmenuid confirm_ok resettype
5868 global showlocalchanges
5871 set w ".confirmreset"
5874 wm title $w "Confirm reset"
5875 message $w.m -text \
5876 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5877 -justify center -aspect 1000
5878 pack $w.m -side top -fill x -padx 20 -pady 20
5879 frame $w.f -relief sunken -border 2
5880 message $w.f.rt -text "Reset type:" -aspect 1000
5881 grid $w.f.rt -sticky w
5883 radiobutton $w.f.soft -value soft -variable resettype -justify left \
5884 -text "Soft: Leave working tree and index untouched"
5885 grid $w.f.soft -sticky w
5886 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5887 -text "Mixed: Leave working tree untouched, reset index"
5888 grid $w.f.mixed -sticky w
5889 radiobutton $w.f.hard -value hard -variable resettype -justify left \
5890 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5891 grid $w.f.hard -sticky w
5892 pack $w.f -side top -fill x
5893 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5894 pack $w.ok -side left -fill x -padx 20 -pady 20
5895 button $w.cancel -text Cancel -command "destroy $w"
5896 pack $w.cancel -side right -fill x -padx 20 -pady 20
5897 bind $w <Visibility> "grab $w; focus $w"
5899 if {!$confirm_ok} return
5900 if {[catch {set fd [open \
5901 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
5905 set w ".resetprogress"
5906 filerun $fd [list readresetstat $fd $w]
5909 wm title $w "Reset progress"
5910 message $w.m -text "Reset in progress, please wait..." \
5911 -justify center -aspect 1000
5912 pack $w.m -side top -fill x -padx 20 -pady 5
5913 canvas $w.c -width 150 -height 20 -bg white
5914 $w.c create rect 0 0 0 20 -fill green -tags rect
5915 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
5920 proc readresetstat {fd w} {
5921 global mainhead mainheadid showlocalchanges
5923 if {[gets $fd line] >= 0} {
5924 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
5925 set x [expr {($m * 150) / $n}]
5926 $w.c coords rect 0 0 $x 20
5932 if {[catch {close $fd} err]} {
5935 set oldhead $mainheadid
5936 set newhead [exec git rev-parse HEAD]
5937 if {$newhead ne $oldhead} {
5938 movehead $newhead $mainhead
5939 movedhead $newhead $mainhead
5940 set mainheadid $newhead
5944 if {$showlocalchanges} {
5950 # context menu for a head
5951 proc headmenu {x y id head} {
5952 global headmenuid headmenuhead headctxmenu mainhead
5955 set headmenuhead $head
5957 if {$head eq $mainhead} {
5960 $headctxmenu entryconfigure 0 -state $state
5961 $headctxmenu entryconfigure 1 -state $state
5962 tk_popup $headctxmenu $x $y
5966 global headmenuid headmenuhead mainhead headids
5967 global showlocalchanges mainheadid
5969 # check the tree is clean first??
5970 set oldmainhead $mainhead
5975 exec git checkout -q $headmenuhead
5981 set mainhead $headmenuhead
5982 set mainheadid $headmenuid
5983 if {[info exists headids($oldmainhead)]} {
5984 redrawtags $headids($oldmainhead)
5986 redrawtags $headmenuid
5988 if {$showlocalchanges} {
5994 global headmenuid headmenuhead mainhead
5995 global headids idheads
5997 set head $headmenuhead
5999 # this check shouldn't be needed any more...
6000 if {$head eq $mainhead} {
6001 error_popup "Cannot delete the currently checked-out branch"
6004 set dheads [descheads $id]
6005 if {$dheads eq $headids($head)} {
6006 # the stuff on this branch isn't on any other branch
6007 if {![confirm_popup "The commits on branch $head aren't on any other\
6008 branch.\nReally delete branch $head?"]} return
6012 if {[catch {exec git branch -D $head} err]} {
6017 removehead $id $head
6018 removedhead $id $head
6024 # Stuff for finding nearby tags
6025 proc getallcommits {} {
6026 global allcommits allids nbmp nextarc seeds
6036 # Called when the graph might have changed
6037 proc regetallcommits {} {
6038 global allcommits seeds
6040 set cmd [concat | git rev-list --all --parents]
6044 set fd [open $cmd r]
6045 fconfigure $fd -blocking 0
6048 filerun $fd [list getallclines $fd]
6051 # Since most commits have 1 parent and 1 child, we group strings of
6052 # such commits into "arcs" joining branch/merge points (BMPs), which
6053 # are commits that either don't have 1 parent or don't have 1 child.
6055 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6056 # arcout(id) - outgoing arcs for BMP
6057 # arcids(a) - list of IDs on arc including end but not start
6058 # arcstart(a) - BMP ID at start of arc
6059 # arcend(a) - BMP ID at end of arc
6060 # growing(a) - arc a is still growing
6061 # arctags(a) - IDs out of arcids (excluding end) that have tags
6062 # archeads(a) - IDs out of arcids (excluding end) that have heads
6063 # The start of an arc is at the descendent end, so "incoming" means
6064 # coming from descendents, and "outgoing" means going towards ancestors.
6066 proc getallclines {fd} {
6067 global allids allparents allchildren idtags idheads nextarc nbmp
6068 global arcnos arcids arctags arcout arcend arcstart archeads growing
6069 global seeds allcommits
6072 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6073 set id [lindex $line 0]
6074 if {[info exists allparents($id)]} {
6079 set olds [lrange $line 1 end]
6080 set allparents($id) $olds
6081 if {![info exists allchildren($id)]} {
6082 set allchildren($id) {}
6087 if {[llength $olds] == 1 && [llength $a] == 1} {
6088 lappend arcids($a) $id
6089 if {[info exists idtags($id)]} {
6090 lappend arctags($a) $id
6092 if {[info exists idheads($id)]} {
6093 lappend archeads($a) $id
6095 if {[info exists allparents($olds)]} {
6096 # seen parent already
6097 if {![info exists arcout($olds)]} {
6100 lappend arcids($a) $olds
6101 set arcend($a) $olds
6104 lappend allchildren($olds) $id
6105 lappend arcnos($olds) $a
6110 foreach a $arcnos($id) {
6111 lappend arcids($a) $id
6118 lappend allchildren($p) $id
6119 set a [incr nextarc]
6120 set arcstart($a) $id
6127 if {[info exists allparents($p)]} {
6128 # seen it already, may need to make a new branch
6129 if {![info exists arcout($p)]} {
6132 lappend arcids($a) $p
6136 lappend arcnos($p) $a
6141 global cached_dheads cached_dtags cached_atags
6142 catch {unset cached_dheads}
6143 catch {unset cached_dtags}
6144 catch {unset cached_atags}
6147 return [expr {$nid >= 1000? 2: 1}]
6150 if {[incr allcommits -1] == 0} {
6157 proc recalcarc {a} {
6158 global arctags archeads arcids idtags idheads
6162 foreach id [lrange $arcids($a) 0 end-1] {
6163 if {[info exists idtags($id)]} {
6166 if {[info exists idheads($id)]} {
6171 set archeads($a) $ah
6175 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6176 global arcstart arcend arcout allparents growing
6179 if {[llength $a] != 1} {
6180 puts "oops splitarc called but [llength $a] arcs already"
6184 set i [lsearch -exact $arcids($a) $p]
6186 puts "oops splitarc $p not in arc $a"
6189 set na [incr nextarc]
6190 if {[info exists arcend($a)]} {
6191 set arcend($na) $arcend($a)
6193 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6194 set j [lsearch -exact $arcnos($l) $a]
6195 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6197 set tail [lrange $arcids($a) [expr {$i+1}] end]
6198 set arcids($a) [lrange $arcids($a) 0 $i]
6200 set arcstart($na) $p
6202 set arcids($na) $tail
6203 if {[info exists growing($a)]} {
6210 if {[llength $arcnos($id)] == 1} {
6213 set j [lsearch -exact $arcnos($id) $a]
6214 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6218 # reconstruct tags and heads lists
6219 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6224 set archeads($na) {}
6228 # Update things for a new commit added that is a child of one
6229 # existing commit. Used when cherry-picking.
6230 proc addnewchild {id p} {
6231 global allids allparents allchildren idtags nextarc nbmp
6232 global arcnos arcids arctags arcout arcend arcstart archeads growing
6236 set allparents($id) [list $p]
6237 set allchildren($id) {}
6241 lappend allchildren($p) $id
6242 set a [incr nextarc]
6243 set arcstart($a) $id
6246 set arcids($a) [list $p]
6248 if {![info exists arcout($p)]} {
6251 lappend arcnos($p) $a
6252 set arcout($id) [list $a]
6255 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6256 # or 0 if neither is true.
6257 proc anc_or_desc {a b} {
6258 global arcout arcstart arcend arcnos cached_isanc
6260 if {$arcnos($a) eq $arcnos($b)} {
6261 # Both are on the same arc(s); either both are the same BMP,
6262 # or if one is not a BMP, the other is also not a BMP or is
6263 # the BMP at end of the arc (and it only has 1 incoming arc).
6264 # Or both can be BMPs with no incoming arcs.
6265 if {$a eq $b || $arcnos($a) eq {}} {
6268 # assert {[llength $arcnos($a)] == 1}
6269 set arc [lindex $arcnos($a) 0]
6270 set i [lsearch -exact $arcids($arc) $a]
6271 set j [lsearch -exact $arcids($arc) $b]
6272 if {$i < 0 || $i > $j} {
6279 if {![info exists arcout($a)]} {
6280 set arc [lindex $arcnos($a) 0]
6281 if {[info exists arcend($arc)]} {
6282 set aend $arcend($arc)
6286 set a $arcstart($arc)
6290 if {![info exists arcout($b)]} {
6291 set arc [lindex $arcnos($b) 0]
6292 if {[info exists arcend($arc)]} {
6293 set bend $arcend($arc)
6297 set b $arcstart($arc)
6307 if {[info exists cached_isanc($a,$bend)]} {
6308 if {$cached_isanc($a,$bend)} {
6312 if {[info exists cached_isanc($b,$aend)]} {
6313 if {$cached_isanc($b,$aend)} {
6316 if {[info exists cached_isanc($a,$bend)]} {
6321 set todo [list $a $b]
6324 for {set i 0} {$i < [llength $todo]} {incr i} {
6325 set x [lindex $todo $i]
6326 if {$anc($x) eq {}} {
6329 foreach arc $arcnos($x) {
6330 set xd $arcstart($arc)
6332 set cached_isanc($a,$bend) 1
6333 set cached_isanc($b,$aend) 0
6335 } elseif {$xd eq $aend} {
6336 set cached_isanc($b,$aend) 1
6337 set cached_isanc($a,$bend) 0
6340 if {![info exists anc($xd)]} {
6341 set anc($xd) $anc($x)
6343 } elseif {$anc($xd) ne $anc($x)} {
6348 set cached_isanc($a,$bend) 0
6349 set cached_isanc($b,$aend) 0
6353 # This identifies whether $desc has an ancestor that is
6354 # a growing tip of the graph and which is not an ancestor of $anc
6355 # and returns 0 if so and 1 if not.
6356 # If we subsequently discover a tag on such a growing tip, and that
6357 # turns out to be a descendent of $anc (which it could, since we
6358 # don't necessarily see children before parents), then $desc
6359 # isn't a good choice to display as a descendent tag of
6360 # $anc (since it is the descendent of another tag which is
6361 # a descendent of $anc). Similarly, $anc isn't a good choice to
6362 # display as a ancestor tag of $desc.
6364 proc is_certain {desc anc} {
6365 global arcnos arcout arcstart arcend growing problems
6368 if {[llength $arcnos($anc)] == 1} {
6369 # tags on the same arc are certain
6370 if {$arcnos($desc) eq $arcnos($anc)} {
6373 if {![info exists arcout($anc)]} {
6374 # if $anc is partway along an arc, use the start of the arc instead
6375 set a [lindex $arcnos($anc) 0]
6376 set anc $arcstart($a)
6379 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6382 set a [lindex $arcnos($desc) 0]
6388 set anclist [list $x]
6392 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6393 set x [lindex $anclist $i]
6398 foreach a $arcout($x) {
6399 if {[info exists growing($a)]} {
6400 if {![info exists growanc($x)] && $dl($x)} {
6406 if {[info exists dl($y)]} {
6410 if {![info exists done($y)]} {
6413 if {[info exists growanc($x)]} {
6417 for {set k 0} {$k < [llength $xl]} {incr k} {
6418 set z [lindex $xl $k]
6419 foreach c $arcout($z) {
6420 if {[info exists arcend($c)]} {
6422 if {[info exists dl($v)] && $dl($v)} {
6424 if {![info exists done($v)]} {
6427 if {[info exists growanc($v)]} {
6437 } elseif {$y eq $anc || !$dl($x)} {
6448 foreach x [array names growanc] {
6457 proc validate_arctags {a} {
6458 global arctags idtags
6462 foreach id $arctags($a) {
6464 if {![info exists idtags($id)]} {
6465 set na [lreplace $na $i $i]
6472 proc validate_archeads {a} {
6473 global archeads idheads
6476 set na $archeads($a)
6477 foreach id $archeads($a) {
6479 if {![info exists idheads($id)]} {
6480 set na [lreplace $na $i $i]
6484 set archeads($a) $na
6487 # Return the list of IDs that have tags that are descendents of id,
6488 # ignoring IDs that are descendents of IDs already reported.
6489 proc desctags {id} {
6490 global arcnos arcstart arcids arctags idtags allparents
6491 global growing cached_dtags
6493 if {![info exists allparents($id)]} {
6496 set t1 [clock clicks -milliseconds]
6498 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6499 # part-way along an arc; check that arc first
6500 set a [lindex $arcnos($id) 0]
6501 if {$arctags($a) ne {}} {
6503 set i [lsearch -exact $arcids($a) $id]
6505 foreach t $arctags($a) {
6506 set j [lsearch -exact $arcids($a) $t]
6514 set id $arcstart($a)
6515 if {[info exists idtags($id)]} {
6519 if {[info exists cached_dtags($id)]} {
6520 return $cached_dtags($id)
6527 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6528 set id [lindex $todo $i]
6530 set ta [info exists hastaggedancestor($id)]
6534 # ignore tags on starting node
6535 if {!$ta && $i > 0} {
6536 if {[info exists idtags($id)]} {
6539 } elseif {[info exists cached_dtags($id)]} {
6540 set tagloc($id) $cached_dtags($id)
6544 foreach a $arcnos($id) {
6546 if {!$ta && $arctags($a) ne {}} {
6548 if {$arctags($a) ne {}} {
6549 lappend tagloc($id) [lindex $arctags($a) end]
6552 if {$ta || $arctags($a) ne {}} {
6553 set tomark [list $d]
6554 for {set j 0} {$j < [llength $tomark]} {incr j} {
6555 set dd [lindex $tomark $j]
6556 if {![info exists hastaggedancestor($dd)]} {
6557 if {[info exists done($dd)]} {
6558 foreach b $arcnos($dd) {
6559 lappend tomark $arcstart($b)
6561 if {[info exists tagloc($dd)]} {
6564 } elseif {[info exists queued($dd)]} {
6567 set hastaggedancestor($dd) 1
6571 if {![info exists queued($d)]} {
6574 if {![info exists hastaggedancestor($d)]} {
6581 foreach id [array names tagloc] {
6582 if {![info exists hastaggedancestor($id)]} {
6583 foreach t $tagloc($id) {
6584 if {[lsearch -exact $tags $t] < 0} {
6590 set t2 [clock clicks -milliseconds]
6593 # remove tags that are descendents of other tags
6594 for {set i 0} {$i < [llength $tags]} {incr i} {
6595 set a [lindex $tags $i]
6596 for {set j 0} {$j < $i} {incr j} {
6597 set b [lindex $tags $j]
6598 set r [anc_or_desc $a $b]
6600 set tags [lreplace $tags $j $j]
6603 } elseif {$r == -1} {
6604 set tags [lreplace $tags $i $i]
6611 if {[array names growing] ne {}} {
6612 # graph isn't finished, need to check if any tag could get
6613 # eclipsed by another tag coming later. Simply ignore any
6614 # tags that could later get eclipsed.
6617 if {[is_certain $t $origid]} {
6621 if {$tags eq $ctags} {
6622 set cached_dtags($origid) $tags
6627 set cached_dtags($origid) $tags
6629 set t3 [clock clicks -milliseconds]
6630 if {0 && $t3 - $t1 >= 100} {
6631 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6632 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6638 global arcnos arcids arcout arcend arctags idtags allparents
6639 global growing cached_atags
6641 if {![info exists allparents($id)]} {
6644 set t1 [clock clicks -milliseconds]
6646 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6647 # part-way along an arc; check that arc first
6648 set a [lindex $arcnos($id) 0]
6649 if {$arctags($a) ne {}} {
6651 set i [lsearch -exact $arcids($a) $id]
6652 foreach t $arctags($a) {
6653 set j [lsearch -exact $arcids($a) $t]
6659 if {![info exists arcend($a)]} {
6663 if {[info exists idtags($id)]} {
6667 if {[info exists cached_atags($id)]} {
6668 return $cached_atags($id)
6676 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6677 set id [lindex $todo $i]
6679 set td [info exists hastaggeddescendent($id)]
6683 # ignore tags on starting node
6684 if {!$td && $i > 0} {
6685 if {[info exists idtags($id)]} {
6688 } elseif {[info exists cached_atags($id)]} {
6689 set tagloc($id) $cached_atags($id)
6693 foreach a $arcout($id) {
6694 if {!$td && $arctags($a) ne {}} {
6696 if {$arctags($a) ne {}} {
6697 lappend tagloc($id) [lindex $arctags($a) 0]
6700 if {![info exists arcend($a)]} continue
6702 if {$td || $arctags($a) ne {}} {
6703 set tomark [list $d]
6704 for {set j 0} {$j < [llength $tomark]} {incr j} {
6705 set dd [lindex $tomark $j]
6706 if {![info exists hastaggeddescendent($dd)]} {
6707 if {[info exists done($dd)]} {
6708 foreach b $arcout($dd) {
6709 if {[info exists arcend($b)]} {
6710 lappend tomark $arcend($b)
6713 if {[info exists tagloc($dd)]} {
6716 } elseif {[info exists queued($dd)]} {
6719 set hastaggeddescendent($dd) 1
6723 if {![info exists queued($d)]} {
6726 if {![info exists hastaggeddescendent($d)]} {
6732 set t2 [clock clicks -milliseconds]
6735 foreach id [array names tagloc] {
6736 if {![info exists hastaggeddescendent($id)]} {
6737 foreach t $tagloc($id) {
6738 if {[lsearch -exact $tags $t] < 0} {
6745 # remove tags that are ancestors of other tags
6746 for {set i 0} {$i < [llength $tags]} {incr i} {
6747 set a [lindex $tags $i]
6748 for {set j 0} {$j < $i} {incr j} {
6749 set b [lindex $tags $j]
6750 set r [anc_or_desc $a $b]
6752 set tags [lreplace $tags $j $j]
6755 } elseif {$r == 1} {
6756 set tags [lreplace $tags $i $i]
6763 if {[array names growing] ne {}} {
6764 # graph isn't finished, need to check if any tag could get
6765 # eclipsed by another tag coming later. Simply ignore any
6766 # tags that could later get eclipsed.
6769 if {[is_certain $origid $t]} {
6773 if {$tags eq $ctags} {
6774 set cached_atags($origid) $tags
6779 set cached_atags($origid) $tags
6781 set t3 [clock clicks -milliseconds]
6782 if {0 && $t3 - $t1 >= 100} {
6783 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6784 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6789 # Return the list of IDs that have heads that are descendents of id,
6790 # including id itself if it has a head.
6791 proc descheads {id} {
6792 global arcnos arcstart arcids archeads idheads cached_dheads
6795 if {![info exists allparents($id)]} {
6799 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6800 # part-way along an arc; check it first
6801 set a [lindex $arcnos($id) 0]
6802 if {$archeads($a) ne {}} {
6803 validate_archeads $a
6804 set i [lsearch -exact $arcids($a) $id]
6805 foreach t $archeads($a) {
6806 set j [lsearch -exact $arcids($a) $t]
6811 set id $arcstart($a)
6817 for {set i 0} {$i < [llength $todo]} {incr i} {
6818 set id [lindex $todo $i]
6819 if {[info exists cached_dheads($id)]} {
6820 set ret [concat $ret $cached_dheads($id)]
6822 if {[info exists idheads($id)]} {
6825 foreach a $arcnos($id) {
6826 if {$archeads($a) ne {}} {
6827 validate_archeads $a
6828 if {$archeads($a) ne {}} {
6829 set ret [concat $ret $archeads($a)]
6833 if {![info exists seen($d)]} {
6840 set ret [lsort -unique $ret]
6841 set cached_dheads($origid) $ret
6842 return [concat $ret $aret]
6845 proc addedtag {id} {
6846 global arcnos arcout cached_dtags cached_atags
6848 if {![info exists arcnos($id)]} return
6849 if {![info exists arcout($id)]} {
6850 recalcarc [lindex $arcnos($id) 0]
6852 catch {unset cached_dtags}
6853 catch {unset cached_atags}
6856 proc addedhead {hid head} {
6857 global arcnos arcout cached_dheads
6859 if {![info exists arcnos($hid)]} return
6860 if {![info exists arcout($hid)]} {
6861 recalcarc [lindex $arcnos($hid) 0]
6863 catch {unset cached_dheads}
6866 proc removedhead {hid head} {
6867 global cached_dheads
6869 catch {unset cached_dheads}
6872 proc movedhead {hid head} {
6873 global arcnos arcout cached_dheads
6875 if {![info exists arcnos($hid)]} return
6876 if {![info exists arcout($hid)]} {
6877 recalcarc [lindex $arcnos($hid) 0]
6879 catch {unset cached_dheads}
6882 proc changedrefs {} {
6883 global cached_dheads cached_dtags cached_atags
6884 global arctags archeads arcnos arcout idheads idtags
6886 foreach id [concat [array names idheads] [array names idtags]] {
6887 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6888 set a [lindex $arcnos($id) 0]
6889 if {![info exists donearc($a)]} {
6895 catch {unset cached_dtags}
6896 catch {unset cached_atags}
6897 catch {unset cached_dheads}
6900 proc rereadrefs {} {
6901 global idtags idheads idotherrefs mainhead
6903 set refids [concat [array names idtags] \
6904 [array names idheads] [array names idotherrefs]]
6905 foreach id $refids {
6906 if {![info exists ref($id)]} {
6907 set ref($id) [listrefs $id]
6910 set oldmainhead $mainhead
6913 set refids [lsort -unique [concat $refids [array names idtags] \
6914 [array names idheads] [array names idotherrefs]]]
6915 foreach id $refids {
6916 set v [listrefs $id]
6917 if {![info exists ref($id)] || $ref($id) != $v ||
6918 ($id eq $oldmainhead && $id ne $mainhead) ||
6919 ($id eq $mainhead && $id ne $oldmainhead)} {
6925 proc listrefs {id} {
6926 global idtags idheads idotherrefs
6929 if {[info exists idtags($id)]} {
6933 if {[info exists idheads($id)]} {
6937 if {[info exists idotherrefs($id)]} {
6938 set z $idotherrefs($id)
6940 return [list $x $y $z]
6943 proc showtag {tag isnew} {
6944 global ctext tagcontents tagids linknum tagobjid
6947 addtohistory [list showtag $tag 0]
6949 $ctext conf -state normal
6952 if {![info exists tagcontents($tag)]} {
6954 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6957 if {[info exists tagcontents($tag)]} {
6958 set text $tagcontents($tag)
6960 set text "Tag: $tag\nId: $tagids($tag)"
6962 appendwithlinks $text {}
6963 $ctext conf -state disabled
6975 global maxwidth maxgraphpct diffopts
6976 global oldprefs prefstop showneartags showlocalchanges
6977 global bgcolor fgcolor ctext diffcolors selectbgcolor
6978 global uifont tabstop
6982 if {[winfo exists $top]} {
6986 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6987 set oldprefs($v) [set $v]
6990 wm title $top "Gitk preferences"
6991 label $top.ldisp -text "Commit list display options"
6992 $top.ldisp configure -font $uifont
6993 grid $top.ldisp - -sticky w -pady 10
6994 label $top.spacer -text " "
6995 label $top.maxwidthl -text "Maximum graph width (lines)" \
6997 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6998 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6999 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7001 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7002 grid x $top.maxpctl $top.maxpct -sticky w
7003 frame $top.showlocal
7004 label $top.showlocal.l -text "Show local changes" -font optionfont
7005 checkbutton $top.showlocal.b -variable showlocalchanges
7006 pack $top.showlocal.b $top.showlocal.l -side left
7007 grid x $top.showlocal -sticky w
7009 label $top.ddisp -text "Diff display options"
7010 $top.ddisp configure -font $uifont
7011 grid $top.ddisp - -sticky w -pady 10
7012 label $top.diffoptl -text "Options for diff program" \
7014 entry $top.diffopt -width 20 -textvariable diffopts
7015 grid x $top.diffoptl $top.diffopt -sticky w
7017 label $top.ntag.l -text "Display nearby tags" -font optionfont
7018 checkbutton $top.ntag.b -variable showneartags
7019 pack $top.ntag.b $top.ntag.l -side left
7020 grid x $top.ntag -sticky w
7021 label $top.tabstopl -text "tabstop" -font optionfont
7022 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7023 grid x $top.tabstopl $top.tabstop -sticky w
7025 label $top.cdisp -text "Colors: press to choose"
7026 $top.cdisp configure -font $uifont
7027 grid $top.cdisp - -sticky w -pady 10
7028 label $top.bg -padx 40 -relief sunk -background $bgcolor
7029 button $top.bgbut -text "Background" -font optionfont \
7030 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7031 grid x $top.bgbut $top.bg -sticky w
7032 label $top.fg -padx 40 -relief sunk -background $fgcolor
7033 button $top.fgbut -text "Foreground" -font optionfont \
7034 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7035 grid x $top.fgbut $top.fg -sticky w
7036 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7037 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7038 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7039 [list $ctext tag conf d0 -foreground]]
7040 grid x $top.diffoldbut $top.diffold -sticky w
7041 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7042 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7043 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7044 [list $ctext tag conf d1 -foreground]]
7045 grid x $top.diffnewbut $top.diffnew -sticky w
7046 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7047 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7048 -command [list choosecolor diffcolors 2 $top.hunksep \
7049 "diff hunk header" \
7050 [list $ctext tag conf hunksep -foreground]]
7051 grid x $top.hunksepbut $top.hunksep -sticky w
7052 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7053 button $top.selbgbut -text "Select bg" -font optionfont \
7054 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7055 grid x $top.selbgbut $top.selbgsep -sticky w
7058 button $top.buts.ok -text "OK" -command prefsok -default active
7059 $top.buts.ok configure -font $uifont
7060 button $top.buts.can -text "Cancel" -command prefscan -default normal
7061 $top.buts.can configure -font $uifont
7062 grid $top.buts.ok $top.buts.can
7063 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7064 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7065 grid $top.buts - - -pady 10 -sticky ew
7066 bind $top <Visibility> "focus $top.buts.ok"
7069 proc choosecolor {v vi w x cmd} {
7072 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7073 -title "Gitk: choose color for $x"]
7074 if {$c eq {}} return
7075 $w conf -background $c
7081 global bglist cflist
7083 $w configure -selectbackground $c
7085 $cflist tag configure highlight \
7086 -background [$cflist cget -selectbackground]
7087 allcanvs itemconf secsel -fill $c
7094 $w conf -background $c
7102 $w conf -foreground $c
7104 allcanvs itemconf text -fill $c
7105 $canv itemconf circle -outline $c
7109 global maxwidth maxgraphpct diffopts
7110 global oldprefs prefstop showneartags showlocalchanges
7112 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7113 set $v $oldprefs($v)
7115 catch {destroy $prefstop}
7120 global maxwidth maxgraphpct
7121 global oldprefs prefstop showneartags showlocalchanges
7122 global charspc ctext tabstop
7124 catch {destroy $prefstop}
7126 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7127 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7128 if {$showlocalchanges} {
7134 if {$maxwidth != $oldprefs(maxwidth)
7135 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7137 } elseif {$showneartags != $oldprefs(showneartags)} {
7142 proc formatdate {d} {
7144 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7149 # This list of encoding names and aliases is distilled from
7150 # http://www.iana.org/assignments/character-sets.
7151 # Not all of them are supported by Tcl.
7152 set encoding_aliases {
7153 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7154 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7155 { ISO-10646-UTF-1 csISO10646UTF1 }
7156 { ISO_646.basic:1983 ref csISO646basic1983 }
7157 { INVARIANT csINVARIANT }
7158 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7159 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7160 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7161 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7162 { NATS-DANO iso-ir-9-1 csNATSDANO }
7163 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7164 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7165 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7166 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7167 { ISO-2022-KR csISO2022KR }
7169 { ISO-2022-JP csISO2022JP }
7170 { ISO-2022-JP-2 csISO2022JP2 }
7171 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7173 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7174 { IT iso-ir-15 ISO646-IT csISO15Italian }
7175 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7176 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7177 { greek7-old iso-ir-18 csISO18Greek7Old }
7178 { latin-greek iso-ir-19 csISO19LatinGreek }
7179 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7180 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7181 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7182 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7183 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7184 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7185 { INIS iso-ir-49 csISO49INIS }
7186 { INIS-8 iso-ir-50 csISO50INIS8 }
7187 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7188 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7189 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7190 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7191 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7192 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7194 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7195 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7196 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7197 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7198 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7199 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7200 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7201 { greek7 iso-ir-88 csISO88Greek7 }
7202 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7203 { iso-ir-90 csISO90 }
7204 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7205 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7206 csISO92JISC62991984b }
7207 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7208 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7209 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7210 csISO95JIS62291984handadd }
7211 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7212 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7213 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7214 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7216 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7217 { T.61-7bit iso-ir-102 csISO102T617bit }
7218 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7219 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7220 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7221 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7222 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7223 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7224 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7225 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7226 arabic csISOLatinArabic }
7227 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7228 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7229 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7230 greek greek8 csISOLatinGreek }
7231 { T.101-G2 iso-ir-128 csISO128T101G2 }
7232 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7234 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7235 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7236 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7237 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7238 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7239 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7240 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7241 csISOLatinCyrillic }
7242 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7243 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7244 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7245 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7246 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7247 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7248 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7249 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7250 { ISO_10367-box iso-ir-155 csISO10367Box }
7251 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7252 { latin-lap lap iso-ir-158 csISO158Lap }
7253 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7254 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7257 { JIS_X0201 X0201 csHalfWidthKatakana }
7258 { KSC5636 ISO646-KR csKSC5636 }
7259 { ISO-10646-UCS-2 csUnicode }
7260 { ISO-10646-UCS-4 csUCS4 }
7261 { DEC-MCS dec csDECMCS }
7262 { hp-roman8 roman8 r8 csHPRoman8 }
7263 { macintosh mac csMacintosh }
7264 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7266 { IBM038 EBCDIC-INT cp038 csIBM038 }
7267 { IBM273 CP273 csIBM273 }
7268 { IBM274 EBCDIC-BE CP274 csIBM274 }
7269 { IBM275 EBCDIC-BR cp275 csIBM275 }
7270 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7271 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7272 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7273 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7274 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7275 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7276 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7277 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7278 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7279 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7280 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7281 { IBM437 cp437 437 csPC8CodePage437 }
7282 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7283 { IBM775 cp775 csPC775Baltic }
7284 { IBM850 cp850 850 csPC850Multilingual }
7285 { IBM851 cp851 851 csIBM851 }
7286 { IBM852 cp852 852 csPCp852 }
7287 { IBM855 cp855 855 csIBM855 }
7288 { IBM857 cp857 857 csIBM857 }
7289 { IBM860 cp860 860 csIBM860 }
7290 { IBM861 cp861 861 cp-is csIBM861 }
7291 { IBM862 cp862 862 csPC862LatinHebrew }
7292 { IBM863 cp863 863 csIBM863 }
7293 { IBM864 cp864 csIBM864 }
7294 { IBM865 cp865 865 csIBM865 }
7295 { IBM866 cp866 866 csIBM866 }
7296 { IBM868 CP868 cp-ar csIBM868 }
7297 { IBM869 cp869 869 cp-gr csIBM869 }
7298 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7299 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7300 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7301 { IBM891 cp891 csIBM891 }
7302 { IBM903 cp903 csIBM903 }
7303 { IBM904 cp904 904 csIBBM904 }
7304 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7305 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7306 { IBM1026 CP1026 csIBM1026 }
7307 { EBCDIC-AT-DE csIBMEBCDICATDE }
7308 { EBCDIC-AT-DE-A csEBCDICATDEA }
7309 { EBCDIC-CA-FR csEBCDICCAFR }
7310 { EBCDIC-DK-NO csEBCDICDKNO }
7311 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7312 { EBCDIC-FI-SE csEBCDICFISE }
7313 { EBCDIC-FI-SE-A csEBCDICFISEA }
7314 { EBCDIC-FR csEBCDICFR }
7315 { EBCDIC-IT csEBCDICIT }
7316 { EBCDIC-PT csEBCDICPT }
7317 { EBCDIC-ES csEBCDICES }
7318 { EBCDIC-ES-A csEBCDICESA }
7319 { EBCDIC-ES-S csEBCDICESS }
7320 { EBCDIC-UK csEBCDICUK }
7321 { EBCDIC-US csEBCDICUS }
7322 { UNKNOWN-8BIT csUnknown8BiT }
7323 { MNEMONIC csMnemonic }
7328 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7329 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7330 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7331 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7332 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7333 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7334 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7335 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7336 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7337 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7338 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7339 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7340 { IBM1047 IBM-1047 }
7341 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7342 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7343 { UNICODE-1-1 csUnicode11 }
7346 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7347 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7349 { ISO-8859-15 ISO_8859-15 Latin-9 }
7350 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7351 { GBK CP936 MS936 windows-936 }
7352 { JIS_Encoding csJISEncoding }
7353 { Shift_JIS MS_Kanji csShiftJIS }
7354 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7356 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7357 { ISO-10646-UCS-Basic csUnicodeASCII }
7358 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7359 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7360 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7361 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7362 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7363 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7364 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7365 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7366 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7367 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7368 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7369 { Ventura-US csVenturaUS }
7370 { Ventura-International csVenturaInternational }
7371 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7372 { PC8-Turkish csPC8Turkish }
7373 { IBM-Symbols csIBMSymbols }
7374 { IBM-Thai csIBMThai }
7375 { HP-Legal csHPLegal }
7376 { HP-Pi-font csHPPiFont }
7377 { HP-Math8 csHPMath8 }
7378 { Adobe-Symbol-Encoding csHPPSMath }
7379 { HP-DeskTop csHPDesktop }
7380 { Ventura-Math csVenturaMath }
7381 { Microsoft-Publishing csMicrosoftPublishing }
7382 { Windows-31J csWindows31J }
7387 proc tcl_encoding {enc} {
7388 global encoding_aliases
7389 set names [encoding names]
7390 set lcnames [string tolower $names]
7391 set enc [string tolower $enc]
7392 set i [lsearch -exact $lcnames $enc]
7394 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7395 if {[regsub {^iso[-_]} $enc iso encx]} {
7396 set i [lsearch -exact $lcnames $encx]
7400 foreach l $encoding_aliases {
7401 set ll [string tolower $l]
7402 if {[lsearch -exact $ll $enc] < 0} continue
7403 # look through the aliases for one that tcl knows about
7405 set i [lsearch -exact $lcnames $e]
7407 if {[regsub {^iso[-_]} $e iso ex]} {
7408 set i [lsearch -exact $lcnames $ex]
7417 return [lindex $names $i]
7424 set diffopts "-U 5 -p"
7425 set wrcomcmd "git diff-tree --stdin -p --pretty"
7429 set gitencoding [exec git config --get i18n.commitencoding]
7431 if {$gitencoding == ""} {
7432 set gitencoding "utf-8"
7434 set tclencoding [tcl_encoding $gitencoding]
7435 if {$tclencoding == {}} {
7436 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7439 set mainfont {Helvetica 9}
7440 set textfont {Courier 9}
7441 set uifont {Helvetica 9 bold}
7443 set findmergefiles 0
7451 set cmitmode "patch"
7452 set wrapcomment "none"
7456 set showlocalchanges 1
7458 set colors {green red blue magenta darkgrey brown orange}
7461 set diffcolors {red "#00a000" blue}
7462 set selectbgcolor gray85
7464 catch {source ~/.gitk}
7466 font create optionfont -family sans-serif -size -12
7470 switch -regexp -- $arg {
7472 "^-d" { set datemode 1 }
7474 lappend revtreeargs $arg
7479 # check that we can find a .git directory somewhere...
7481 if {![file isdirectory $gitdir]} {
7482 show_error {} . "Cannot find the git directory \"$gitdir\"."
7486 set cmdline_files {}
7487 set i [lsearch -exact $revtreeargs "--"]
7489 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
7490 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
7491 } elseif {$revtreeargs ne {}} {
7493 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7494 set cmdline_files [split $f "\n"]
7495 set n [llength $cmdline_files]
7496 set revtreeargs [lrange $revtreeargs 0 end-$n]
7498 # unfortunately we get both stdout and stderr in $err,
7499 # so look for "fatal:".
7500 set i [string first "fatal:" $err]
7502 set err [string range $err [expr {$i + 6}] end]
7504 show_error {} . "Bad arguments to gitk:\n$err"
7509 set nullid "0000000000000000000000000000000000000000"
7516 set highlight_paths {}
7517 set searchdirn -forwards
7521 set markingmatches 0
7528 set selectedhlview None
7537 set lookingforhead 0
7542 wm title . "[file tail $argv0]: [file tail [pwd]]"
7545 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7546 # create a view for the files/dirs specified on the command line
7550 set viewname(1) "Command line"
7551 set viewfiles(1) $cmdline_files
7552 set viewargs(1) $revtreeargs
7555 .bar.view entryconf Edit* -state normal
7556 .bar.view entryconf Delete* -state normal
7559 if {[info exists permviews]} {
7560 foreach v $permviews {
7563 set viewname($n) [lindex $v 0]
7564 set viewfiles($n) [lindex $v 1]
7565 set viewargs($n) [lindex $v 2]