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 catch {file delete "~/.gitk"}
988 file rename -force "~/.gitk-new" "~/.gitk"
993 proc resizeclistpanes {win w} {
995 if {[info exists oldwidth($win)]} {
996 set s0 [$win sash coord 0]
997 set s1 [$win sash coord 1]
999 set sash0 [expr {int($w/2 - 2)}]
1000 set sash1 [expr {int($w*5/6 - 2)}]
1002 set factor [expr {1.0 * $w / $oldwidth($win)}]
1003 set sash0 [expr {int($factor * [lindex $s0 0])}]
1004 set sash1 [expr {int($factor * [lindex $s1 0])}]
1008 if {$sash1 < $sash0 + 20} {
1009 set sash1 [expr {$sash0 + 20}]
1011 if {$sash1 > $w - 10} {
1012 set sash1 [expr {$w - 10}]
1013 if {$sash0 > $sash1 - 20} {
1014 set sash0 [expr {$sash1 - 20}]
1018 $win sash place 0 $sash0 [lindex $s0 1]
1019 $win sash place 1 $sash1 [lindex $s1 1]
1021 set oldwidth($win) $w
1024 proc resizecdetpanes {win w} {
1026 if {[info exists oldwidth($win)]} {
1027 set s0 [$win sash coord 0]
1029 set sash0 [expr {int($w*3/4 - 2)}]
1031 set factor [expr {1.0 * $w / $oldwidth($win)}]
1032 set sash0 [expr {int($factor * [lindex $s0 0])}]
1036 if {$sash0 > $w - 15} {
1037 set sash0 [expr {$w - 15}]
1040 $win sash place 0 $sash0 [lindex $s0 1]
1042 set oldwidth($win) $w
1045 proc allcanvs args {
1046 global canv canv2 canv3
1052 proc bindall {event action} {
1053 global canv canv2 canv3
1054 bind $canv $event $action
1055 bind $canv2 $event $action
1056 bind $canv3 $event $action
1062 if {[winfo exists $w]} {
1067 wm title $w "About gitk"
1068 message $w.m -text {
1069 Gitk - a commit viewer for git
1071 Copyright © 2005-2006 Paul Mackerras
1073 Use and redistribute under the terms of the GNU General Public License} \
1074 -justify center -aspect 400 -border 2 -bg white -relief groove
1075 pack $w.m -side top -fill x -padx 2 -pady 2
1076 $w.m configure -font $uifont
1077 button $w.ok -text Close -command "destroy $w" -default active
1078 pack $w.ok -side bottom
1079 $w.ok configure -font $uifont
1080 bind $w <Visibility> "focus $w.ok"
1081 bind $w <Key-Escape> "destroy $w"
1082 bind $w <Key-Return> "destroy $w"
1088 if {[winfo exists $w]} {
1093 wm title $w "Gitk key bindings"
1094 message $w.m -text {
1098 <Home> Move to first commit
1099 <End> Move to last commit
1100 <Up>, p, i Move up one commit
1101 <Down>, n, k Move down one commit
1102 <Left>, z, j Go back in history list
1103 <Right>, x, l Go forward in history list
1104 <PageUp> Move up one page in commit list
1105 <PageDown> Move down one page in commit list
1106 <Ctrl-Home> Scroll to top of commit list
1107 <Ctrl-End> Scroll to bottom of commit list
1108 <Ctrl-Up> Scroll commit list up one line
1109 <Ctrl-Down> Scroll commit list down one line
1110 <Ctrl-PageUp> Scroll commit list up one page
1111 <Ctrl-PageDown> Scroll commit list down one page
1112 <Shift-Up> Move to previous highlighted line
1113 <Shift-Down> Move to next highlighted line
1114 <Delete>, b Scroll diff view up one page
1115 <Backspace> Scroll diff view up one page
1116 <Space> Scroll diff view down one page
1117 u Scroll diff view up 18 lines
1118 d Scroll diff view down 18 lines
1120 <Ctrl-G> Move to next find hit
1121 <Return> Move to next find hit
1122 / Move to next find hit, or redo find
1123 ? Move to previous find hit
1124 f Scroll diff view to next file
1125 <Ctrl-S> Search for next hit in diff view
1126 <Ctrl-R> Search for previous hit in diff view
1127 <Ctrl-KP+> Increase font size
1128 <Ctrl-plus> Increase font size
1129 <Ctrl-KP-> Decrease font size
1130 <Ctrl-minus> Decrease font size
1133 -justify left -bg white -border 2 -relief groove
1134 pack $w.m -side top -fill both -padx 2 -pady 2
1135 $w.m configure -font $uifont
1136 button $w.ok -text Close -command "destroy $w" -default active
1137 pack $w.ok -side bottom
1138 $w.ok configure -font $uifont
1139 bind $w <Visibility> "focus $w.ok"
1140 bind $w <Key-Escape> "destroy $w"
1141 bind $w <Key-Return> "destroy $w"
1144 # Procedures for manipulating the file list window at the
1145 # bottom right of the overall window.
1147 proc treeview {w l openlevs} {
1148 global treecontents treediropen treeheight treeparent treeindex
1158 set treecontents() {}
1159 $w conf -state normal
1161 while {[string range $f 0 $prefixend] ne $prefix} {
1162 if {$lev <= $openlevs} {
1163 $w mark set e:$treeindex($prefix) "end -1c"
1164 $w mark gravity e:$treeindex($prefix) left
1166 set treeheight($prefix) $ht
1167 incr ht [lindex $htstack end]
1168 set htstack [lreplace $htstack end end]
1169 set prefixend [lindex $prefendstack end]
1170 set prefendstack [lreplace $prefendstack end end]
1171 set prefix [string range $prefix 0 $prefixend]
1174 set tail [string range $f [expr {$prefixend+1}] end]
1175 while {[set slash [string first "/" $tail]] >= 0} {
1178 lappend prefendstack $prefixend
1179 incr prefixend [expr {$slash + 1}]
1180 set d [string range $tail 0 $slash]
1181 lappend treecontents($prefix) $d
1182 set oldprefix $prefix
1184 set treecontents($prefix) {}
1185 set treeindex($prefix) [incr ix]
1186 set treeparent($prefix) $oldprefix
1187 set tail [string range $tail [expr {$slash+1}] end]
1188 if {$lev <= $openlevs} {
1190 set treediropen($prefix) [expr {$lev < $openlevs}]
1191 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1192 $w mark set d:$ix "end -1c"
1193 $w mark gravity d:$ix left
1195 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1197 $w image create end -align center -image $bm -padx 1 \
1199 $w insert end $d [highlight_tag $prefix]
1200 $w mark set s:$ix "end -1c"
1201 $w mark gravity s:$ix left
1206 if {$lev <= $openlevs} {
1209 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1211 $w insert end $tail [highlight_tag $f]
1213 lappend treecontents($prefix) $tail
1216 while {$htstack ne {}} {
1217 set treeheight($prefix) $ht
1218 incr ht [lindex $htstack end]
1219 set htstack [lreplace $htstack end end]
1221 $w conf -state disabled
1224 proc linetoelt {l} {
1225 global treeheight treecontents
1230 foreach e $treecontents($prefix) {
1235 if {[string index $e end] eq "/"} {
1236 set n $treeheight($prefix$e)
1248 proc highlight_tree {y prefix} {
1249 global treeheight treecontents cflist
1251 foreach e $treecontents($prefix) {
1253 if {[highlight_tag $path] ne {}} {
1254 $cflist tag add bold $y.0 "$y.0 lineend"
1257 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1258 set y [highlight_tree $y $path]
1264 proc treeclosedir {w dir} {
1265 global treediropen treeheight treeparent treeindex
1267 set ix $treeindex($dir)
1268 $w conf -state normal
1269 $w delete s:$ix e:$ix
1270 set treediropen($dir) 0
1271 $w image configure a:$ix -image tri-rt
1272 $w conf -state disabled
1273 set n [expr {1 - $treeheight($dir)}]
1274 while {$dir ne {}} {
1275 incr treeheight($dir) $n
1276 set dir $treeparent($dir)
1280 proc treeopendir {w dir} {
1281 global treediropen treeheight treeparent treecontents treeindex
1283 set ix $treeindex($dir)
1284 $w conf -state normal
1285 $w image configure a:$ix -image tri-dn
1286 $w mark set e:$ix s:$ix
1287 $w mark gravity e:$ix right
1290 set n [llength $treecontents($dir)]
1291 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1294 incr treeheight($x) $n
1296 foreach e $treecontents($dir) {
1298 if {[string index $e end] eq "/"} {
1299 set iy $treeindex($de)
1300 $w mark set d:$iy e:$ix
1301 $w mark gravity d:$iy left
1302 $w insert e:$ix $str
1303 set treediropen($de) 0
1304 $w image create e:$ix -align center -image tri-rt -padx 1 \
1306 $w insert e:$ix $e [highlight_tag $de]
1307 $w mark set s:$iy e:$ix
1308 $w mark gravity s:$iy left
1309 set treeheight($de) 1
1311 $w insert e:$ix $str
1312 $w insert e:$ix $e [highlight_tag $de]
1315 $w mark gravity e:$ix left
1316 $w conf -state disabled
1317 set treediropen($dir) 1
1318 set top [lindex [split [$w index @0,0] .] 0]
1319 set ht [$w cget -height]
1320 set l [lindex [split [$w index s:$ix] .] 0]
1323 } elseif {$l + $n + 1 > $top + $ht} {
1324 set top [expr {$l + $n + 2 - $ht}]
1332 proc treeclick {w x y} {
1333 global treediropen cmitmode ctext cflist cflist_top
1335 if {$cmitmode ne "tree"} return
1336 if {![info exists cflist_top]} return
1337 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1338 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1339 $cflist tag add highlight $l.0 "$l.0 lineend"
1345 set e [linetoelt $l]
1346 if {[string index $e end] ne "/"} {
1348 } elseif {$treediropen($e)} {
1355 proc setfilelist {id} {
1356 global treefilelist cflist
1358 treeview $cflist $treefilelist($id) 0
1361 image create bitmap tri-rt -background black -foreground blue -data {
1362 #define tri-rt_width 13
1363 #define tri-rt_height 13
1364 static unsigned char tri-rt_bits[] = {
1365 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1366 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1369 #define tri-rt-mask_width 13
1370 #define tri-rt-mask_height 13
1371 static unsigned char tri-rt-mask_bits[] = {
1372 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1373 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1376 image create bitmap tri-dn -background black -foreground blue -data {
1377 #define tri-dn_width 13
1378 #define tri-dn_height 13
1379 static unsigned char tri-dn_bits[] = {
1380 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1381 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1384 #define tri-dn-mask_width 13
1385 #define tri-dn-mask_height 13
1386 static unsigned char tri-dn-mask_bits[] = {
1387 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1388 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1392 proc init_flist {first} {
1393 global cflist cflist_top selectedline difffilestart
1395 $cflist conf -state normal
1396 $cflist delete 0.0 end
1398 $cflist insert end $first
1400 $cflist tag add highlight 1.0 "1.0 lineend"
1402 catch {unset cflist_top}
1404 $cflist conf -state disabled
1405 set difffilestart {}
1408 proc highlight_tag {f} {
1409 global highlight_paths
1411 foreach p $highlight_paths {
1412 if {[string match $p $f]} {
1419 proc highlight_filelist {} {
1420 global cmitmode cflist
1422 $cflist conf -state normal
1423 if {$cmitmode ne "tree"} {
1424 set end [lindex [split [$cflist index end] .] 0]
1425 for {set l 2} {$l < $end} {incr l} {
1426 set line [$cflist get $l.0 "$l.0 lineend"]
1427 if {[highlight_tag $line] ne {}} {
1428 $cflist tag add bold $l.0 "$l.0 lineend"
1434 $cflist conf -state disabled
1437 proc unhighlight_filelist {} {
1440 $cflist conf -state normal
1441 $cflist tag remove bold 1.0 end
1442 $cflist conf -state disabled
1445 proc add_flist {fl} {
1448 $cflist conf -state normal
1450 $cflist insert end "\n"
1451 $cflist insert end $f [highlight_tag $f]
1453 $cflist conf -state disabled
1456 proc sel_flist {w x y} {
1457 global ctext difffilestart cflist cflist_top cmitmode
1459 if {$cmitmode eq "tree"} return
1460 if {![info exists cflist_top]} return
1461 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1462 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1463 $cflist tag add highlight $l.0 "$l.0 lineend"
1468 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1472 # Functions for adding and removing shell-type quoting
1474 proc shellquote {str} {
1475 if {![string match "*\['\"\\ \t]*" $str]} {
1478 if {![string match "*\['\"\\]*" $str]} {
1481 if {![string match "*'*" $str]} {
1484 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1487 proc shellarglist {l} {
1493 append str [shellquote $a]
1498 proc shelldequote {str} {
1503 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1504 append ret [string range $str $used end]
1505 set used [string length $str]
1508 set first [lindex $first 0]
1509 set ch [string index $str $first]
1510 if {$first > $used} {
1511 append ret [string range $str $used [expr {$first - 1}]]
1514 if {$ch eq " " || $ch eq "\t"} break
1517 set first [string first "'" $str $used]
1519 error "unmatched single-quote"
1521 append ret [string range $str $used [expr {$first - 1}]]
1526 if {$used >= [string length $str]} {
1527 error "trailing backslash"
1529 append ret [string index $str $used]
1534 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1535 error "unmatched double-quote"
1537 set first [lindex $first 0]
1538 set ch [string index $str $first]
1539 if {$first > $used} {
1540 append ret [string range $str $used [expr {$first - 1}]]
1543 if {$ch eq "\""} break
1545 append ret [string index $str $used]
1549 return [list $used $ret]
1552 proc shellsplit {str} {
1555 set str [string trimleft $str]
1556 if {$str eq {}} break
1557 set dq [shelldequote $str]
1558 set n [lindex $dq 0]
1559 set word [lindex $dq 1]
1560 set str [string range $str $n end]
1566 # Code to implement multiple views
1568 proc newview {ishighlight} {
1569 global nextviewnum newviewname newviewperm uifont newishighlight
1570 global newviewargs revtreeargs
1572 set newishighlight $ishighlight
1574 if {[winfo exists $top]} {
1578 set newviewname($nextviewnum) "View $nextviewnum"
1579 set newviewperm($nextviewnum) 0
1580 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1581 vieweditor $top $nextviewnum "Gitk view definition"
1586 global viewname viewperm newviewname newviewperm
1587 global viewargs newviewargs
1589 set top .gitkvedit-$curview
1590 if {[winfo exists $top]} {
1594 set newviewname($curview) $viewname($curview)
1595 set newviewperm($curview) $viewperm($curview)
1596 set newviewargs($curview) [shellarglist $viewargs($curview)]
1597 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1600 proc vieweditor {top n title} {
1601 global newviewname newviewperm viewfiles
1605 wm title $top $title
1606 label $top.nl -text "Name" -font $uifont
1607 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1608 grid $top.nl $top.name -sticky w -pady 5
1609 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1611 grid $top.perm - -pady 5 -sticky w
1612 message $top.al -aspect 1000 -font $uifont \
1613 -text "Commits to include (arguments to git rev-list):"
1614 grid $top.al - -sticky w -pady 5
1615 entry $top.args -width 50 -textvariable newviewargs($n) \
1616 -background white -font $uifont
1617 grid $top.args - -sticky ew -padx 5
1618 message $top.l -aspect 1000 -font $uifont \
1619 -text "Enter files and directories to include, one per line:"
1620 grid $top.l - -sticky w
1621 text $top.t -width 40 -height 10 -background white -font $uifont
1622 if {[info exists viewfiles($n)]} {
1623 foreach f $viewfiles($n) {
1624 $top.t insert end $f
1625 $top.t insert end "\n"
1627 $top.t delete {end - 1c} end
1628 $top.t mark set insert 0.0
1630 grid $top.t - -sticky ew -padx 5
1632 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1634 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1636 grid $top.buts.ok $top.buts.can
1637 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1638 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1639 grid $top.buts - -pady 10 -sticky ew
1643 proc doviewmenu {m first cmd op argv} {
1644 set nmenu [$m index end]
1645 for {set i $first} {$i <= $nmenu} {incr i} {
1646 if {[$m entrycget $i -command] eq $cmd} {
1647 eval $m $op $i $argv
1653 proc allviewmenus {n op args} {
1656 doviewmenu .bar.view 5 [list showview $n] $op $args
1657 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1660 proc newviewok {top n} {
1661 global nextviewnum newviewperm newviewname newishighlight
1662 global viewname viewfiles viewperm selectedview curview
1663 global viewargs newviewargs viewhlmenu
1666 set newargs [shellsplit $newviewargs($n)]
1668 error_popup "Error in commit selection arguments: $err"
1674 foreach f [split [$top.t get 0.0 end] "\n"] {
1675 set ft [string trim $f]
1680 if {![info exists viewfiles($n)]} {
1681 # creating a new view
1683 set viewname($n) $newviewname($n)
1684 set viewperm($n) $newviewperm($n)
1685 set viewfiles($n) $files
1686 set viewargs($n) $newargs
1688 if {!$newishighlight} {
1691 run addvhighlight $n
1694 # editing an existing view
1695 set viewperm($n) $newviewperm($n)
1696 if {$newviewname($n) ne $viewname($n)} {
1697 set viewname($n) $newviewname($n)
1698 doviewmenu .bar.view 5 [list showview $n] \
1699 entryconf [list -label $viewname($n)]
1700 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1701 entryconf [list -label $viewname($n) -value $viewname($n)]
1703 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1704 set viewfiles($n) $files
1705 set viewargs($n) $newargs
1706 if {$curview == $n} {
1711 catch {destroy $top}
1715 global curview viewdata viewperm hlview selectedhlview
1717 if {$curview == 0} return
1718 if {[info exists hlview] && $hlview == $curview} {
1719 set selectedhlview None
1722 allviewmenus $curview delete
1723 set viewdata($curview) {}
1724 set viewperm($curview) 0
1728 proc addviewmenu {n} {
1729 global viewname viewhlmenu
1731 .bar.view add radiobutton -label $viewname($n) \
1732 -command [list showview $n] -variable selectedview -value $n
1733 $viewhlmenu add radiobutton -label $viewname($n) \
1734 -command [list addvhighlight $n] -variable selectedhlview
1737 proc flatten {var} {
1741 foreach i [array names $var] {
1742 lappend ret $i [set $var\($i\)]
1747 proc unflatten {var l} {
1757 global curview viewdata viewfiles
1758 global displayorder parentlist rowidlist rowoffsets
1759 global colormap rowtextx commitrow nextcolor canvxmax
1760 global numcommits rowrangelist commitlisted idrowranges rowchk
1761 global selectedline currentid canv canvy0
1762 global matchinglines treediffs
1763 global pending_select phase
1764 global commitidx rowlaidout rowoptim
1766 global selectedview selectfirst
1767 global vparentlist vdisporder vcmitlisted
1768 global hlview selectedhlview
1770 if {$n == $curview} return
1772 if {[info exists selectedline]} {
1773 set selid $currentid
1774 set y [yc $selectedline]
1775 set ymax [lindex [$canv cget -scrollregion] 3]
1776 set span [$canv yview]
1777 set ytop [expr {[lindex $span 0] * $ymax}]
1778 set ybot [expr {[lindex $span 1] * $ymax}]
1779 if {$ytop < $y && $y < $ybot} {
1780 set yscreen [expr {$y - $ytop}]
1782 set yscreen [expr {($ybot - $ytop) / 2}]
1784 } elseif {[info exists pending_select]} {
1785 set selid $pending_select
1786 unset pending_select
1791 if {$curview >= 0} {
1792 set vparentlist($curview) $parentlist
1793 set vdisporder($curview) $displayorder
1794 set vcmitlisted($curview) $commitlisted
1796 set viewdata($curview) \
1797 [list $phase $rowidlist $rowoffsets $rowrangelist \
1798 [flatten idrowranges] [flatten idinlist] \
1799 $rowlaidout $rowoptim $numcommits]
1800 } elseif {![info exists viewdata($curview)]
1801 || [lindex $viewdata($curview) 0] ne {}} {
1802 set viewdata($curview) \
1803 [list {} $rowidlist $rowoffsets $rowrangelist]
1806 catch {unset matchinglines}
1807 catch {unset treediffs}
1809 if {[info exists hlview] && $hlview == $n} {
1811 set selectedhlview None
1816 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1817 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1819 if {![info exists viewdata($n)]} {
1821 set pending_select $selid
1828 set phase [lindex $v 0]
1829 set displayorder $vdisporder($n)
1830 set parentlist $vparentlist($n)
1831 set commitlisted $vcmitlisted($n)
1832 set rowidlist [lindex $v 1]
1833 set rowoffsets [lindex $v 2]
1834 set rowrangelist [lindex $v 3]
1836 set numcommits [llength $displayorder]
1837 catch {unset idrowranges}
1839 unflatten idrowranges [lindex $v 4]
1840 unflatten idinlist [lindex $v 5]
1841 set rowlaidout [lindex $v 6]
1842 set rowoptim [lindex $v 7]
1843 set numcommits [lindex $v 8]
1844 catch {unset rowchk}
1847 catch {unset colormap}
1848 catch {unset rowtextx}
1850 set canvxmax [$canv cget -width]
1857 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1858 set row $commitrow($n,$selid)
1859 # try to get the selected row in the same position on the screen
1860 set ymax [lindex [$canv cget -scrollregion] 3]
1861 set ytop [expr {[yc $row] - $yscreen}]
1865 set yf [expr {$ytop * 1.0 / $ymax}]
1867 allcanvs yview moveto $yf
1871 } elseif {$selid ne {}} {
1872 set pending_select $selid
1874 set row [expr {[lindex $displayorder 0] eq $nullid}]
1875 if {$row < $numcommits} {
1882 if {$phase eq "getcommits"} {
1883 show_status "Reading commits..."
1886 } elseif {$numcommits == 0} {
1887 show_status "No commits selected"
1891 # Stuff relating to the highlighting facility
1893 proc ishighlighted {row} {
1894 global vhighlights fhighlights nhighlights rhighlights
1896 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1897 return $nhighlights($row)
1899 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1900 return $vhighlights($row)
1902 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1903 return $fhighlights($row)
1905 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1906 return $rhighlights($row)
1911 proc bolden {row font} {
1912 global canv linehtag selectedline boldrows
1914 lappend boldrows $row
1915 $canv itemconf $linehtag($row) -font $font
1916 if {[info exists selectedline] && $row == $selectedline} {
1918 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1919 -outline {{}} -tags secsel \
1920 -fill [$canv cget -selectbackground]]
1925 proc bolden_name {row font} {
1926 global canv2 linentag selectedline boldnamerows
1928 lappend boldnamerows $row
1929 $canv2 itemconf $linentag($row) -font $font
1930 if {[info exists selectedline] && $row == $selectedline} {
1931 $canv2 delete secsel
1932 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1933 -outline {{}} -tags secsel \
1934 -fill [$canv2 cget -selectbackground]]
1940 global mainfont boldrows
1943 foreach row $boldrows {
1944 if {![ishighlighted $row]} {
1945 bolden $row $mainfont
1947 lappend stillbold $row
1950 set boldrows $stillbold
1953 proc addvhighlight {n} {
1954 global hlview curview viewdata vhl_done vhighlights commitidx
1956 if {[info exists hlview]} {
1960 if {$n != $curview && ![info exists viewdata($n)]} {
1961 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1962 set vparentlist($n) {}
1963 set vdisporder($n) {}
1964 set vcmitlisted($n) {}
1967 set vhl_done $commitidx($hlview)
1968 if {$vhl_done > 0} {
1973 proc delvhighlight {} {
1974 global hlview vhighlights
1976 if {![info exists hlview]} return
1978 catch {unset vhighlights}
1982 proc vhighlightmore {} {
1983 global hlview vhl_done commitidx vhighlights
1984 global displayorder vdisporder curview mainfont
1986 set font [concat $mainfont bold]
1987 set max $commitidx($hlview)
1988 if {$hlview == $curview} {
1989 set disp $displayorder
1991 set disp $vdisporder($hlview)
1993 set vr [visiblerows]
1994 set r0 [lindex $vr 0]
1995 set r1 [lindex $vr 1]
1996 for {set i $vhl_done} {$i < $max} {incr i} {
1997 set id [lindex $disp $i]
1998 if {[info exists commitrow($curview,$id)]} {
1999 set row $commitrow($curview,$id)
2000 if {$r0 <= $row && $row <= $r1} {
2001 if {![highlighted $row]} {
2004 set vhighlights($row) 1
2011 proc askvhighlight {row id} {
2012 global hlview vhighlights commitrow iddrawn mainfont
2014 if {[info exists commitrow($hlview,$id)]} {
2015 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2016 bolden $row [concat $mainfont bold]
2018 set vhighlights($row) 1
2020 set vhighlights($row) 0
2024 proc hfiles_change {name ix op} {
2025 global highlight_files filehighlight fhighlights fh_serial
2026 global mainfont highlight_paths
2028 if {[info exists filehighlight]} {
2029 # delete previous highlights
2030 catch {close $filehighlight}
2032 catch {unset fhighlights}
2034 unhighlight_filelist
2036 set highlight_paths {}
2037 after cancel do_file_hl $fh_serial
2039 if {$highlight_files ne {}} {
2040 after 300 do_file_hl $fh_serial
2044 proc makepatterns {l} {
2047 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2048 if {[string index $ee end] eq "/"} {
2058 proc do_file_hl {serial} {
2059 global highlight_files filehighlight highlight_paths gdttype fhl_list
2061 if {$gdttype eq "touching paths:"} {
2062 if {[catch {set paths [shellsplit $highlight_files]}]} return
2063 set highlight_paths [makepatterns $paths]
2065 set gdtargs [concat -- $paths]
2067 set gdtargs [list "-S$highlight_files"]
2069 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2070 set filehighlight [open $cmd r+]
2071 fconfigure $filehighlight -blocking 0
2072 filerun $filehighlight readfhighlight
2078 proc flushhighlights {} {
2079 global filehighlight fhl_list
2081 if {[info exists filehighlight]} {
2083 puts $filehighlight ""
2084 flush $filehighlight
2088 proc askfilehighlight {row id} {
2089 global filehighlight fhighlights fhl_list
2091 lappend fhl_list $id
2092 set fhighlights($row) -1
2093 puts $filehighlight $id
2096 proc readfhighlight {} {
2097 global filehighlight fhighlights commitrow curview mainfont iddrawn
2100 if {![info exists filehighlight]} {
2104 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2105 set line [string trim $line]
2106 set i [lsearch -exact $fhl_list $line]
2107 if {$i < 0} continue
2108 for {set j 0} {$j < $i} {incr j} {
2109 set id [lindex $fhl_list $j]
2110 if {[info exists commitrow($curview,$id)]} {
2111 set fhighlights($commitrow($curview,$id)) 0
2114 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2115 if {$line eq {}} continue
2116 if {![info exists commitrow($curview,$line)]} continue
2117 set row $commitrow($curview,$line)
2118 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2119 bolden $row [concat $mainfont bold]
2121 set fhighlights($row) 1
2123 if {[eof $filehighlight]} {
2125 puts "oops, git diff-tree died"
2126 catch {close $filehighlight}
2134 proc find_change {name ix op} {
2135 global nhighlights mainfont boldnamerows
2136 global findstring findpattern findtype
2138 # delete previous highlights, if any
2139 foreach row $boldnamerows {
2140 bolden_name $row $mainfont
2143 catch {unset nhighlights}
2145 if {$findtype ne "Regexp"} {
2146 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2148 set findpattern "*$e*"
2153 proc askfindhighlight {row id} {
2154 global nhighlights commitinfo iddrawn mainfont
2155 global findstring findtype findloc findpattern
2157 if {![info exists commitinfo($id)]} {
2160 set info $commitinfo($id)
2162 set fldtypes {Headline Author Date Committer CDate Comments}
2163 foreach f $info ty $fldtypes {
2164 if {$findloc ne "All fields" && $findloc ne $ty} {
2167 if {$findtype eq "Regexp"} {
2168 set doesmatch [regexp $findstring $f]
2169 } elseif {$findtype eq "IgnCase"} {
2170 set doesmatch [string match -nocase $findpattern $f]
2172 set doesmatch [string match $findpattern $f]
2175 if {$ty eq "Author"} {
2182 if {[info exists iddrawn($id)]} {
2183 if {$isbold && ![ishighlighted $row]} {
2184 bolden $row [concat $mainfont bold]
2187 bolden_name $row [concat $mainfont bold]
2190 set nhighlights($row) $isbold
2193 proc vrel_change {name ix op} {
2194 global highlight_related
2197 if {$highlight_related ne "None"} {
2202 # prepare for testing whether commits are descendents or ancestors of a
2203 proc rhighlight_sel {a} {
2204 global descendent desc_todo ancestor anc_todo
2205 global highlight_related rhighlights
2207 catch {unset descendent}
2208 set desc_todo [list $a]
2209 catch {unset ancestor}
2210 set anc_todo [list $a]
2211 if {$highlight_related ne "None"} {
2217 proc rhighlight_none {} {
2220 catch {unset rhighlights}
2224 proc is_descendent {a} {
2225 global curview children commitrow descendent desc_todo
2228 set la $commitrow($v,$a)
2232 for {set i 0} {$i < [llength $todo]} {incr i} {
2233 set do [lindex $todo $i]
2234 if {$commitrow($v,$do) < $la} {
2235 lappend leftover $do
2238 foreach nk $children($v,$do) {
2239 if {![info exists descendent($nk)]} {
2240 set descendent($nk) 1
2248 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2252 set descendent($a) 0
2253 set desc_todo $leftover
2256 proc is_ancestor {a} {
2257 global curview parentlist commitrow ancestor anc_todo
2260 set la $commitrow($v,$a)
2264 for {set i 0} {$i < [llength $todo]} {incr i} {
2265 set do [lindex $todo $i]
2266 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2267 lappend leftover $do
2270 foreach np [lindex $parentlist $commitrow($v,$do)] {
2271 if {![info exists ancestor($np)]} {
2280 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2285 set anc_todo $leftover
2288 proc askrelhighlight {row id} {
2289 global descendent highlight_related iddrawn mainfont rhighlights
2290 global selectedline ancestor
2292 if {![info exists selectedline]} return
2294 if {$highlight_related eq "Descendent" ||
2295 $highlight_related eq "Not descendent"} {
2296 if {![info exists descendent($id)]} {
2299 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2302 } elseif {$highlight_related eq "Ancestor" ||
2303 $highlight_related eq "Not ancestor"} {
2304 if {![info exists ancestor($id)]} {
2307 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2311 if {[info exists iddrawn($id)]} {
2312 if {$isbold && ![ishighlighted $row]} {
2313 bolden $row [concat $mainfont bold]
2316 set rhighlights($row) $isbold
2319 proc next_hlcont {} {
2320 global fhl_row fhl_dirn displayorder numcommits
2321 global vhighlights fhighlights nhighlights rhighlights
2322 global hlview filehighlight findstring highlight_related
2324 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2327 if {$row < 0 || $row >= $numcommits} {
2332 set id [lindex $displayorder $row]
2333 if {[info exists hlview]} {
2334 if {![info exists vhighlights($row)]} {
2335 askvhighlight $row $id
2337 if {$vhighlights($row) > 0} break
2339 if {$findstring ne {}} {
2340 if {![info exists nhighlights($row)]} {
2341 askfindhighlight $row $id
2343 if {$nhighlights($row) > 0} break
2345 if {$highlight_related ne "None"} {
2346 if {![info exists rhighlights($row)]} {
2347 askrelhighlight $row $id
2349 if {$rhighlights($row) > 0} break
2351 if {[info exists filehighlight]} {
2352 if {![info exists fhighlights($row)]} {
2353 # ask for a few more while we're at it...
2355 for {set n 0} {$n < 100} {incr n} {
2356 if {![info exists fhighlights($r)]} {
2357 askfilehighlight $r [lindex $displayorder $r]
2360 if {$r < 0 || $r >= $numcommits} break
2364 if {$fhighlights($row) < 0} {
2368 if {$fhighlights($row) > 0} break
2376 proc next_highlight {dirn} {
2377 global selectedline fhl_row fhl_dirn
2378 global hlview filehighlight findstring highlight_related
2380 if {![info exists selectedline]} return
2381 if {!([info exists hlview] || $findstring ne {} ||
2382 $highlight_related ne "None" || [info exists filehighlight])} return
2383 set fhl_row [expr {$selectedline + $dirn}]
2388 proc cancel_next_highlight {} {
2394 # Graph layout functions
2396 proc shortids {ids} {
2399 if {[llength $id] > 1} {
2400 lappend res [shortids $id]
2401 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2402 lappend res [string range $id 0 7]
2410 proc incrange {l x o} {
2413 set e [lindex $l $x]
2415 lset l $x [expr {$e + $o}]
2424 for {} {$n > 0} {incr n -1} {
2430 proc usedinrange {id l1 l2} {
2431 global children commitrow curview
2433 if {[info exists commitrow($curview,$id)]} {
2434 set r $commitrow($curview,$id)
2435 if {$l1 <= $r && $r <= $l2} {
2436 return [expr {$r - $l1 + 1}]
2439 set kids $children($curview,$id)
2441 set r $commitrow($curview,$c)
2442 if {$l1 <= $r && $r <= $l2} {
2443 return [expr {$r - $l1 + 1}]
2449 proc sanity {row {full 0}} {
2450 global rowidlist rowoffsets
2453 set ids [lindex $rowidlist $row]
2456 if {$id eq {}} continue
2457 if {$col < [llength $ids] - 1 &&
2458 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2459 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2461 set o [lindex $rowoffsets $row $col]
2467 if {[lindex $rowidlist $y $x] != $id} {
2468 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2469 puts " id=[shortids $id] check started at row $row"
2470 for {set i $row} {$i >= $y} {incr i -1} {
2471 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2476 set o [lindex $rowoffsets $y $x]
2481 proc makeuparrow {oid x y z} {
2482 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2484 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2487 set off0 [lindex $rowoffsets $y]
2488 for {set x0 $x} {1} {incr x0} {
2489 if {$x0 >= [llength $off0]} {
2490 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2493 set z [lindex $off0 $x0]
2499 set z [expr {$x0 - $x}]
2500 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2501 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2503 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2504 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2505 lappend idrowranges($oid) [lindex $displayorder $y]
2508 proc initlayout {} {
2509 global rowidlist rowoffsets displayorder commitlisted
2510 global rowlaidout rowoptim
2511 global idinlist rowchk rowrangelist idrowranges
2512 global numcommits canvxmax canv
2515 global colormap rowtextx
2526 catch {unset idinlist}
2527 catch {unset rowchk}
2530 set canvxmax [$canv cget -width]
2531 catch {unset colormap}
2532 catch {unset rowtextx}
2533 catch {unset idrowranges}
2537 proc setcanvscroll {} {
2538 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2540 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2541 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2542 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2543 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2546 proc visiblerows {} {
2547 global canv numcommits linespc
2549 set ymax [lindex [$canv cget -scrollregion] 3]
2550 if {$ymax eq {} || $ymax == 0} return
2552 set y0 [expr {int([lindex $f 0] * $ymax)}]
2553 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2557 set y1 [expr {int([lindex $f 1] * $ymax)}]
2558 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2559 if {$r1 >= $numcommits} {
2560 set r1 [expr {$numcommits - 1}]
2562 return [list $r0 $r1]
2565 proc layoutmore {tmax allread} {
2566 global rowlaidout rowoptim commitidx numcommits optim_delay
2567 global uparrowlen curview rowidlist idinlist
2570 set showdelay $optim_delay
2571 set optdelay [expr {$uparrowlen + 1}]
2573 if {$rowoptim - $showdelay > $numcommits} {
2574 showstuff [expr {$rowoptim - $showdelay}] $showlast
2575 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2576 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2580 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2582 } elseif {$commitidx($curview) > $rowlaidout} {
2583 set nr [expr {$commitidx($curview) - $rowlaidout}]
2584 # may need to increase this threshold if uparrowlen or
2585 # mingaplen are increased...
2590 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2591 if {$rowlaidout == $row} {
2594 } elseif {$allread} {
2596 set nrows $commitidx($curview)
2597 if {[lindex $rowidlist $nrows] ne {} ||
2598 [array names idinlist] ne {}} {
2600 set rowlaidout $commitidx($curview)
2601 } elseif {$rowoptim == $nrows} {
2604 if {$numcommits == $nrows} {
2611 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2617 proc showstuff {canshow last} {
2618 global numcommits commitrow pending_select selectedline curview
2619 global lookingforhead mainheadid displayorder nullid selectfirst
2620 global lastscrollset
2622 if {$numcommits == 0} {
2624 set phase "incrdraw"
2628 set prev $numcommits
2629 set numcommits $canshow
2630 set t [clock clicks -milliseconds]
2631 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2632 set lastscrollset $t
2635 set rows [visiblerows]
2636 set r1 [lindex $rows 1]
2637 if {$r1 >= $canshow} {
2638 set r1 [expr {$canshow - 1}]
2643 if {[info exists pending_select] &&
2644 [info exists commitrow($curview,$pending_select)] &&
2645 $commitrow($curview,$pending_select) < $numcommits} {
2646 selectline $commitrow($curview,$pending_select) 1
2649 if {[info exists selectedline] || [info exists pending_select]} {
2652 set l [expr {[lindex $displayorder 0] eq $nullid}]
2657 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2658 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2659 set lookingforhead 0
2664 proc doshowlocalchanges {} {
2665 global lookingforhead curview mainheadid phase commitrow
2667 if {[info exists commitrow($curview,$mainheadid)] &&
2668 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2670 } elseif {$phase ne {}} {
2671 set lookingforhead 1
2675 proc dohidelocalchanges {} {
2676 global lookingforhead localrow lserial
2678 set lookingforhead 0
2679 if {$localrow >= 0} {
2686 # spawn off a process to do git diff-index HEAD
2687 proc dodiffindex {} {
2688 global localrow lserial
2692 set fd [open "|git diff-index HEAD" r]
2693 fconfigure $fd -blocking 0
2694 filerun $fd [list readdiffindex $fd $lserial]
2697 proc readdiffindex {fd serial} {
2698 global localrow commitrow mainheadid nullid curview
2699 global commitinfo commitdata lserial
2701 if {[gets $fd line] < 0} {
2708 # we only need to see one line and we don't really care what it says...
2711 if {$serial == $lserial && $localrow == -1} {
2712 # add the line for the local diff to the graph
2713 set localrow $commitrow($curview,$mainheadid)
2714 set hl "Local uncommitted changes"
2715 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2716 set commitdata($nullid) "\n $hl\n"
2717 insertrow $localrow $nullid
2722 proc layoutrows {row endrow last} {
2723 global rowidlist rowoffsets displayorder
2724 global uparrowlen downarrowlen maxwidth mingaplen
2725 global children parentlist
2727 global commitidx curview
2728 global idinlist rowchk rowrangelist
2730 set idlist [lindex $rowidlist $row]
2731 set offs [lindex $rowoffsets $row]
2732 while {$row < $endrow} {
2733 set id [lindex $displayorder $row]
2736 foreach p [lindex $parentlist $row] {
2737 if {![info exists idinlist($p)]} {
2739 } elseif {!$idinlist($p)} {
2743 set nev [expr {[llength $idlist] + [llength $newolds]
2744 + [llength $oldolds] - $maxwidth + 1}]
2747 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2748 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2749 set i [lindex $idlist $x]
2750 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2751 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2752 [expr {$row + $uparrowlen + $mingaplen}]]
2754 set idlist [lreplace $idlist $x $x]
2755 set offs [lreplace $offs $x $x]
2756 set offs [incrange $offs $x 1]
2758 set rm1 [expr {$row - 1}]
2759 lappend idrowranges($i) [lindex $displayorder $rm1]
2760 if {[incr nev -1] <= 0} break
2763 set rowchk($id) [expr {$row + $r}]
2766 lset rowidlist $row $idlist
2767 lset rowoffsets $row $offs
2769 set col [lsearch -exact $idlist $id]
2771 set col [llength $idlist]
2773 lset rowidlist $row $idlist
2775 if {$children($curview,$id) ne {}} {
2776 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2780 lset rowoffsets $row $offs
2782 makeuparrow $id $col $row $z
2788 if {[info exists idrowranges($id)]} {
2789 set ranges $idrowranges($id)
2791 unset idrowranges($id)
2793 lappend rowrangelist $ranges
2795 set offs [ntimes [llength $idlist] 0]
2796 set l [llength $newolds]
2797 set idlist [eval lreplace \$idlist $col $col $newolds]
2800 set offs [lrange $offs 0 [expr {$col - 1}]]
2801 foreach x $newolds {
2806 set tmp [expr {[llength $idlist] - [llength $offs]}]
2808 set offs [concat $offs [ntimes $tmp $o]]
2813 foreach i $newolds {
2815 set idrowranges($i) $id
2818 foreach oid $oldolds {
2819 set idinlist($oid) 1
2820 set idlist [linsert $idlist $col $oid]
2821 set offs [linsert $offs $col $o]
2822 makeuparrow $oid $col $row $o
2825 lappend rowidlist $idlist
2826 lappend rowoffsets $offs
2831 proc addextraid {id row} {
2832 global displayorder commitrow commitinfo
2833 global commitidx commitlisted
2834 global parentlist children curview
2836 incr commitidx($curview)
2837 lappend displayorder $id
2838 lappend commitlisted 0
2839 lappend parentlist {}
2840 set commitrow($curview,$id) $row
2842 if {![info exists commitinfo($id)]} {
2843 set commitinfo($id) {"No commit information available"}
2845 if {![info exists children($curview,$id)]} {
2846 set children($curview,$id) {}
2850 proc layouttail {} {
2851 global rowidlist rowoffsets idinlist commitidx curview
2852 global idrowranges rowrangelist
2854 set row $commitidx($curview)
2855 set idlist [lindex $rowidlist $row]
2856 while {$idlist ne {}} {
2857 set col [expr {[llength $idlist] - 1}]
2858 set id [lindex $idlist $col]
2861 lappend idrowranges($id) $row
2862 lappend rowrangelist $idrowranges($id)
2863 unset idrowranges($id)
2865 set offs [ntimes $col 0]
2866 set idlist [lreplace $idlist $col $col]
2867 lappend rowidlist $idlist
2868 lappend rowoffsets $offs
2871 foreach id [array names idinlist] {
2874 lset rowidlist $row [list $id]
2875 lset rowoffsets $row 0
2876 makeuparrow $id 0 $row 0
2877 lappend idrowranges($id) $row
2878 lappend rowrangelist $idrowranges($id)
2879 unset idrowranges($id)
2881 lappend rowidlist {}
2882 lappend rowoffsets {}
2886 proc insert_pad {row col npad} {
2887 global rowidlist rowoffsets
2889 set pad [ntimes $npad {}]
2890 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2891 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2892 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2895 proc optimize_rows {row col endrow} {
2896 global rowidlist rowoffsets displayorder
2898 for {} {$row < $endrow} {incr row} {
2899 set idlist [lindex $rowidlist $row]
2900 set offs [lindex $rowoffsets $row]
2902 for {} {$col < [llength $offs]} {incr col} {
2903 if {[lindex $idlist $col] eq {}} {
2907 set z [lindex $offs $col]
2908 if {$z eq {}} continue
2910 set x0 [expr {$col + $z}]
2911 set y0 [expr {$row - 1}]
2912 set z0 [lindex $rowoffsets $y0 $x0]
2914 set id [lindex $idlist $col]
2915 set ranges [rowranges $id]
2916 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2920 # Looking at lines from this row to the previous row,
2921 # make them go straight up if they end in an arrow on
2922 # the previous row; otherwise make them go straight up
2924 if {$z < -1 || ($z < 0 && $isarrow)} {
2925 # Line currently goes left too much;
2926 # insert pads in the previous row, then optimize it
2927 set npad [expr {-1 - $z + $isarrow}]
2928 set offs [incrange $offs $col $npad]
2929 insert_pad $y0 $x0 $npad
2931 optimize_rows $y0 $x0 $row
2933 set z [lindex $offs $col]
2934 set x0 [expr {$col + $z}]
2935 set z0 [lindex $rowoffsets $y0 $x0]
2936 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2937 # Line currently goes right too much;
2938 # insert pads in this line and adjust the next's rowoffsets
2939 set npad [expr {$z - 1 + $isarrow}]
2940 set y1 [expr {$row + 1}]
2941 set offs2 [lindex $rowoffsets $y1]
2945 if {$z eq {} || $x1 + $z < $col} continue
2946 if {$x1 + $z > $col} {
2949 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2952 set pad [ntimes $npad {}]
2953 set idlist [eval linsert \$idlist $col $pad]
2954 set tmp [eval linsert \$offs $col $pad]
2956 set offs [incrange $tmp $col [expr {-$npad}]]
2957 set z [lindex $offs $col]
2960 if {$z0 eq {} && !$isarrow} {
2961 # this line links to its first child on row $row-2
2962 set rm2 [expr {$row - 2}]
2963 set id [lindex $displayorder $rm2]
2964 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2966 set z0 [expr {$xc - $x0}]
2969 # avoid lines jigging left then immediately right
2970 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2971 insert_pad $y0 $x0 1
2972 set offs [incrange $offs $col 1]
2973 optimize_rows $y0 [expr {$x0 + 1}] $row
2978 # Find the first column that doesn't have a line going right
2979 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2980 set o [lindex $offs $col]
2982 # check if this is the link to the first child
2983 set id [lindex $idlist $col]
2984 set ranges [rowranges $id]
2985 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2986 # it is, work out offset to child
2987 set y0 [expr {$row - 1}]
2988 set id [lindex $displayorder $y0]
2989 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2991 set o [expr {$x0 - $col}]
2995 if {$o eq {} || $o <= 0} break
2997 # Insert a pad at that column as long as it has a line and
2998 # isn't the last column, and adjust the next row' offsets
2999 if {$o ne {} && [incr col] < [llength $idlist]} {
3000 set y1 [expr {$row + 1}]
3001 set offs2 [lindex $rowoffsets $y1]
3005 if {$z eq {} || $x1 + $z < $col} continue
3006 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3009 set idlist [linsert $idlist $col {}]
3010 set tmp [linsert $offs $col {}]
3012 set offs [incrange $tmp $col -1]
3015 lset rowidlist $row $idlist
3016 lset rowoffsets $row $offs
3022 global canvx0 linespc
3023 return [expr {$canvx0 + $col * $linespc}]
3027 global canvy0 linespc
3028 return [expr {$canvy0 + $row * $linespc}]
3031 proc linewidth {id} {
3032 global thickerline lthickness
3035 if {[info exists thickerline] && $id eq $thickerline} {
3036 set wid [expr {2 * $lthickness}]
3041 proc rowranges {id} {
3042 global phase idrowranges commitrow rowlaidout rowrangelist curview
3046 ([info exists commitrow($curview,$id)]
3047 && $commitrow($curview,$id) < $rowlaidout)} {
3048 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3049 } elseif {[info exists idrowranges($id)]} {
3050 set ranges $idrowranges($id)
3053 foreach rid $ranges {
3054 lappend linenos $commitrow($curview,$rid)
3056 if {$linenos ne {}} {
3057 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3062 # work around tk8.4 refusal to draw arrows on diagonal segments
3063 proc adjarrowhigh {coords} {
3066 set x0 [lindex $coords 0]
3067 set x1 [lindex $coords 2]
3069 set y0 [lindex $coords 1]
3070 set y1 [lindex $coords 3]
3071 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3072 # we have a nearby vertical segment, just trim off the diag bit
3073 set coords [lrange $coords 2 end]
3075 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3076 set xi [expr {$x0 - $slope * $linespc / 2}]
3077 set yi [expr {$y0 - $linespc / 2}]
3078 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3084 proc drawlineseg {id row endrow arrowlow} {
3085 global rowidlist displayorder iddrawn linesegs
3086 global canv colormap linespc curview maxlinelen
3088 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3089 set le [expr {$row + 1}]
3092 set c [lsearch -exact [lindex $rowidlist $le] $id]
3098 set x [lindex $displayorder $le]
3103 if {[info exists iddrawn($x)] || $le == $endrow} {
3104 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3120 if {[info exists linesegs($id)]} {
3121 set lines $linesegs($id)
3123 set r0 [lindex $li 0]
3125 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3135 set li [lindex $lines [expr {$i-1}]]
3136 set r1 [lindex $li 1]
3137 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3142 set x [lindex $cols [expr {$le - $row}]]
3143 set xp [lindex $cols [expr {$le - 1 - $row}]]
3144 set dir [expr {$xp - $x}]
3146 set ith [lindex $lines $i 2]
3147 set coords [$canv coords $ith]
3148 set ah [$canv itemcget $ith -arrow]
3149 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3150 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3151 if {$x2 ne {} && $x - $x2 == $dir} {
3152 set coords [lrange $coords 0 end-2]
3155 set coords [list [xc $le $x] [yc $le]]
3158 set itl [lindex $lines [expr {$i-1}] 2]
3159 set al [$canv itemcget $itl -arrow]
3160 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3161 } elseif {$arrowlow &&
3162 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3165 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3166 for {set y $le} {[incr y -1] > $row} {} {
3168 set xp [lindex $cols [expr {$y - 1 - $row}]]
3169 set ndir [expr {$xp - $x}]
3170 if {$dir != $ndir || $xp < 0} {
3171 lappend coords [xc $y $x] [yc $y]
3177 # join parent line to first child
3178 set ch [lindex $displayorder $row]
3179 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3181 puts "oops: drawlineseg: child $ch not on row $row"
3184 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3185 } elseif {$xc > $x + 1} {
3186 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3190 lappend coords [xc $row $x] [yc $row]
3192 set xn [xc $row $xp]
3194 # work around tk8.4 refusal to draw arrows on diagonal segments
3195 if {$arrowlow && $xn != [lindex $coords end-1]} {
3196 if {[llength $coords] < 4 ||
3197 [lindex $coords end-3] != [lindex $coords end-1] ||
3198 [lindex $coords end] - $yn > 2 * $linespc} {
3199 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3200 set yo [yc [expr {$row + 0.5}]]
3201 lappend coords $xn $yo $xn $yn
3204 lappend coords $xn $yn
3209 set coords [adjarrowhigh $coords]
3212 set t [$canv create line $coords -width [linewidth $id] \
3213 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3216 set lines [linsert $lines $i [list $row $le $t]]
3218 $canv coords $ith $coords
3219 if {$arrow ne $ah} {
3220 $canv itemconf $ith -arrow $arrow
3222 lset lines $i 0 $row
3225 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3226 set ndir [expr {$xo - $xp}]
3227 set clow [$canv coords $itl]
3228 if {$dir == $ndir} {
3229 set clow [lrange $clow 2 end]
3231 set coords [concat $coords $clow]
3233 lset lines [expr {$i-1}] 1 $le
3235 set coords [adjarrowhigh $coords]
3238 # coalesce two pieces
3240 set b [lindex $lines [expr {$i-1}] 0]
3241 set e [lindex $lines $i 1]
3242 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3244 $canv coords $itl $coords
3245 if {$arrow ne $al} {
3246 $canv itemconf $itl -arrow $arrow
3250 set linesegs($id) $lines
3254 proc drawparentlinks {id row} {
3255 global rowidlist canv colormap curview parentlist
3258 set rowids [lindex $rowidlist $row]
3259 set col [lsearch -exact $rowids $id]
3260 if {$col < 0} return
3261 set olds [lindex $parentlist $row]
3262 set row2 [expr {$row + 1}]
3263 set x [xc $row $col]
3266 set ids [lindex $rowidlist $row2]
3267 # rmx = right-most X coord used
3270 set i [lsearch -exact $ids $p]
3272 puts "oops, parent $p of $id not in list"
3275 set x2 [xc $row2 $i]
3279 if {[lsearch -exact $rowids $p] < 0} {
3280 # drawlineseg will do this one for us
3284 # should handle duplicated parents here...
3285 set coords [list $x $y]
3286 if {$i < $col - 1} {
3287 lappend coords [xc $row [expr {$i + 1}]] $y
3288 } elseif {$i > $col + 1} {
3289 lappend coords [xc $row [expr {$i - 1}]] $y
3291 lappend coords $x2 $y2
3292 set t [$canv create line $coords -width [linewidth $p] \
3293 -fill $colormap($p) -tags lines.$p]
3297 if {$rmx > [lindex $idpos($id) 1]} {
3298 lset idpos($id) 1 $rmx
3303 proc drawlines {id} {
3306 $canv itemconf lines.$id -width [linewidth $id]
3309 proc drawcmittext {id row col} {
3310 global linespc canv canv2 canv3 canvy0 fgcolor
3311 global commitlisted commitinfo rowidlist parentlist
3312 global rowtextx idpos idtags idheads idotherrefs
3313 global linehtag linentag linedtag
3314 global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3316 if {$id eq $nullid} {
3319 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3321 set x [xc $row $col]
3323 set orad [expr {$linespc / 3}]
3324 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3325 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3326 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3328 $canv bind $t <1> {selcanvline {} %x %y}
3329 set rmx [llength [lindex $rowidlist $row]]
3330 set olds [lindex $parentlist $row]
3332 set nextids [lindex $rowidlist [expr {$row + 1}]]
3334 set i [lsearch -exact $nextids $p]
3340 set xt [xc $row $rmx]
3341 set rowtextx($row) $xt
3342 set idpos($id) [list $x $xt $y]
3343 if {[info exists idtags($id)] || [info exists idheads($id)]
3344 || [info exists idotherrefs($id)]} {
3345 set xt [drawtags $id $x $xt $y]
3347 set headline [lindex $commitinfo($id) 0]
3348 set name [lindex $commitinfo($id) 1]
3349 set date [lindex $commitinfo($id) 2]
3350 set date [formatdate $date]
3353 set isbold [ishighlighted $row]
3355 lappend boldrows $row
3358 lappend boldnamerows $row
3362 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3363 -text $headline -font $font -tags text]
3364 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3365 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3366 -text $name -font $nfont -tags text]
3367 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3368 -text $date -font $mainfont -tags text]
3369 set xr [expr {$xt + [font measure $mainfont $headline]}]
3370 if {$xr > $canvxmax} {
3376 proc drawcmitrow {row} {
3377 global displayorder rowidlist
3379 global commitinfo parentlist numcommits
3380 global filehighlight fhighlights findstring nhighlights
3381 global hlview vhighlights
3382 global highlight_related rhighlights
3384 if {$row >= $numcommits} return
3386 set id [lindex $displayorder $row]
3387 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3388 askvhighlight $row $id
3390 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3391 askfilehighlight $row $id
3393 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3394 askfindhighlight $row $id
3396 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3397 askrelhighlight $row $id
3399 if {[info exists iddrawn($id)]} return
3400 set col [lsearch -exact [lindex $rowidlist $row] $id]
3402 puts "oops, row $row id $id not in list"
3405 if {![info exists commitinfo($id)]} {
3409 drawcmittext $id $row $col
3413 proc drawcommits {row {endrow {}}} {
3414 global numcommits iddrawn displayorder curview
3415 global parentlist rowidlist
3420 if {$endrow eq {}} {
3423 if {$endrow >= $numcommits} {
3424 set endrow [expr {$numcommits - 1}]
3427 # make the lines join to already-drawn rows either side
3428 set r [expr {$row - 1}]
3429 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3432 set er [expr {$endrow + 1}]
3433 if {$er >= $numcommits ||
3434 ![info exists iddrawn([lindex $displayorder $er])]} {
3437 for {} {$r <= $er} {incr r} {
3438 set id [lindex $displayorder $r]
3439 set wasdrawn [info exists iddrawn($id)]
3443 if {$r == $er} break
3444 set nextid [lindex $displayorder [expr {$r + 1}]]
3445 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3446 catch {unset prevlines}
3449 drawparentlinks $id $r
3451 if {[info exists lineends($r)]} {
3452 foreach lid $lineends($r) {
3453 unset prevlines($lid)
3456 set rowids [lindex $rowidlist $r]
3457 foreach lid $rowids {
3458 if {$lid eq {}} continue
3460 # see if this is the first child of any of its parents
3461 foreach p [lindex $parentlist $r] {
3462 if {[lsearch -exact $rowids $p] < 0} {
3463 # make this line extend up to the child
3464 set le [drawlineseg $p $r $er 0]
3465 lappend lineends($le) $p
3469 } elseif {![info exists prevlines($lid)]} {
3470 set le [drawlineseg $lid $r $er 1]
3471 lappend lineends($le) $lid
3472 set prevlines($lid) 1
3478 proc drawfrac {f0 f1} {
3481 set ymax [lindex [$canv cget -scrollregion] 3]
3482 if {$ymax eq {} || $ymax == 0} return
3483 set y0 [expr {int($f0 * $ymax)}]
3484 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3485 set y1 [expr {int($f1 * $ymax)}]
3486 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3487 drawcommits $row $endrow
3490 proc drawvisible {} {
3492 eval drawfrac [$canv yview]
3495 proc clear_display {} {
3496 global iddrawn linesegs
3497 global vhighlights fhighlights nhighlights rhighlights
3500 catch {unset iddrawn}
3501 catch {unset linesegs}
3502 catch {unset vhighlights}
3503 catch {unset fhighlights}
3504 catch {unset nhighlights}
3505 catch {unset rhighlights}
3508 proc findcrossings {id} {
3509 global rowidlist parentlist numcommits rowoffsets displayorder
3513 foreach {s e} [rowranges $id] {
3514 if {$e >= $numcommits} {
3515 set e [expr {$numcommits - 1}]
3517 if {$e <= $s} continue
3518 set x [lsearch -exact [lindex $rowidlist $e] $id]
3520 puts "findcrossings: oops, no [shortids $id] in row $e"
3523 for {set row $e} {[incr row -1] >= $s} {} {
3524 set olds [lindex $parentlist $row]
3525 set kid [lindex $displayorder $row]
3526 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3527 if {$kidx < 0} continue
3528 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3530 set px [lsearch -exact $nextrow $p]
3531 if {$px < 0} continue
3532 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3533 if {[lsearch -exact $ccross $p] >= 0} continue
3534 if {$x == $px + ($kidx < $px? -1: 1)} {
3536 } elseif {[lsearch -exact $cross $p] < 0} {
3541 set inc [lindex $rowoffsets $row $x]
3542 if {$inc eq {}} break
3546 return [concat $ccross {{}} $cross]
3549 proc assigncolor {id} {
3550 global colormap colors nextcolor
3551 global commitrow parentlist children children curview
3553 if {[info exists colormap($id)]} return
3554 set ncolors [llength $colors]
3555 if {[info exists children($curview,$id)]} {
3556 set kids $children($curview,$id)
3560 if {[llength $kids] == 1} {
3561 set child [lindex $kids 0]
3562 if {[info exists colormap($child)]
3563 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3564 set colormap($id) $colormap($child)
3570 foreach x [findcrossings $id] {
3572 # delimiter between corner crossings and other crossings
3573 if {[llength $badcolors] >= $ncolors - 1} break
3574 set origbad $badcolors
3576 if {[info exists colormap($x)]
3577 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3578 lappend badcolors $colormap($x)
3581 if {[llength $badcolors] >= $ncolors} {
3582 set badcolors $origbad
3584 set origbad $badcolors
3585 if {[llength $badcolors] < $ncolors - 1} {
3586 foreach child $kids {
3587 if {[info exists colormap($child)]
3588 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3589 lappend badcolors $colormap($child)
3591 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3592 if {[info exists colormap($p)]
3593 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3594 lappend badcolors $colormap($p)
3598 if {[llength $badcolors] >= $ncolors} {
3599 set badcolors $origbad
3602 for {set i 0} {$i <= $ncolors} {incr i} {
3603 set c [lindex $colors $nextcolor]
3604 if {[incr nextcolor] >= $ncolors} {
3607 if {[lsearch -exact $badcolors $c]} break
3609 set colormap($id) $c
3612 proc bindline {t id} {
3615 $canv bind $t <Enter> "lineenter %x %y $id"
3616 $canv bind $t <Motion> "linemotion %x %y $id"
3617 $canv bind $t <Leave> "lineleave $id"
3618 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3621 proc drawtags {id x xt y1} {
3622 global idtags idheads idotherrefs mainhead
3623 global linespc lthickness
3624 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3629 if {[info exists idtags($id)]} {
3630 set marks $idtags($id)
3631 set ntags [llength $marks]
3633 if {[info exists idheads($id)]} {
3634 set marks [concat $marks $idheads($id)]
3635 set nheads [llength $idheads($id)]
3637 if {[info exists idotherrefs($id)]} {
3638 set marks [concat $marks $idotherrefs($id)]
3644 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3645 set yt [expr {$y1 - 0.5 * $linespc}]
3646 set yb [expr {$yt + $linespc - 1}]
3650 foreach tag $marks {
3652 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3653 set wid [font measure [concat $mainfont bold] $tag]
3655 set wid [font measure $mainfont $tag]
3659 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3661 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3662 -width $lthickness -fill black -tags tag.$id]
3664 foreach tag $marks x $xvals wid $wvals {
3665 set xl [expr {$x + $delta}]
3666 set xr [expr {$x + $delta + $wid + $lthickness}]
3668 if {[incr ntags -1] >= 0} {
3670 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3671 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3672 -width 1 -outline black -fill yellow -tags tag.$id]
3673 $canv bind $t <1> [list showtag $tag 1]
3674 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3676 # draw a head or other ref
3677 if {[incr nheads -1] >= 0} {
3679 if {$tag eq $mainhead} {
3685 set xl [expr {$xl - $delta/2}]
3686 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3687 -width 1 -outline black -fill $col -tags tag.$id
3688 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3689 set rwid [font measure $mainfont $remoteprefix]
3690 set xi [expr {$x + 1}]
3691 set yti [expr {$yt + 1}]
3692 set xri [expr {$x + $rwid}]
3693 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3694 -width 0 -fill "#ffddaa" -tags tag.$id
3697 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3698 -font $font -tags [list tag.$id text]]
3700 $canv bind $t <1> [list showtag $tag 1]
3701 } elseif {$nheads >= 0} {
3702 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3708 proc xcoord {i level ln} {
3709 global canvx0 xspc1 xspc2
3711 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3712 if {$i > 0 && $i == $level} {
3713 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3714 } elseif {$i > $level} {
3715 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3720 proc show_status {msg} {
3721 global canv mainfont fgcolor
3724 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3725 -tags text -fill $fgcolor
3728 # Insert a new commit as the child of the commit on row $row.
3729 # The new commit will be displayed on row $row and the commits
3730 # on that row and below will move down one row.
3731 proc insertrow {row newcmit} {
3732 global displayorder parentlist commitlisted children
3733 global commitrow curview rowidlist rowoffsets numcommits
3734 global rowrangelist rowlaidout rowoptim numcommits
3735 global selectedline rowchk commitidx
3737 if {$row >= $numcommits} {
3738 puts "oops, inserting new row $row but only have $numcommits rows"
3741 set p [lindex $displayorder $row]
3742 set displayorder [linsert $displayorder $row $newcmit]
3743 set parentlist [linsert $parentlist $row $p]
3744 set kids $children($curview,$p)
3745 lappend kids $newcmit
3746 set children($curview,$p) $kids
3747 set children($curview,$newcmit) {}
3748 set commitlisted [linsert $commitlisted $row 1]
3749 set l [llength $displayorder]
3750 for {set r $row} {$r < $l} {incr r} {
3751 set id [lindex $displayorder $r]
3752 set commitrow($curview,$id) $r
3754 incr commitidx($curview)
3756 set idlist [lindex $rowidlist $row]
3757 set offs [lindex $rowoffsets $row]
3760 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3766 if {[llength $kids] == 1} {
3767 set col [lsearch -exact $idlist $p]
3768 lset idlist $col $newcmit
3770 set col [llength $idlist]
3771 lappend idlist $newcmit
3773 lset rowoffsets $row $offs
3775 set rowidlist [linsert $rowidlist $row $idlist]
3776 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3778 set rowrangelist [linsert $rowrangelist $row {}]
3779 if {[llength $kids] > 1} {
3780 set rp1 [expr {$row + 1}]
3781 set ranges [lindex $rowrangelist $rp1]
3782 if {$ranges eq {}} {
3783 set ranges [list $newcmit $p]
3784 } elseif {[lindex $ranges end-1] eq $p} {
3785 lset ranges end-1 $newcmit
3787 lset rowrangelist $rp1 $ranges
3790 catch {unset rowchk}
3796 if {[info exists selectedline] && $selectedline >= $row} {
3802 # Remove a commit that was inserted with insertrow on row $row.
3803 proc removerow {row} {
3804 global displayorder parentlist commitlisted children
3805 global commitrow curview rowidlist rowoffsets numcommits
3806 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3807 global linesegends selectedline rowchk commitidx
3809 if {$row >= $numcommits} {
3810 puts "oops, removing row $row but only have $numcommits rows"
3813 set rp1 [expr {$row + 1}]
3814 set id [lindex $displayorder $row]
3815 set p [lindex $parentlist $row]
3816 set displayorder [lreplace $displayorder $row $row]
3817 set parentlist [lreplace $parentlist $row $row]
3818 set commitlisted [lreplace $commitlisted $row $row]
3819 set kids $children($curview,$p)
3820 set i [lsearch -exact $kids $id]
3822 set kids [lreplace $kids $i $i]
3823 set children($curview,$p) $kids
3825 set l [llength $displayorder]
3826 for {set r $row} {$r < $l} {incr r} {
3827 set id [lindex $displayorder $r]
3828 set commitrow($curview,$id) $r
3830 incr commitidx($curview) -1
3832 set rowidlist [lreplace $rowidlist $row $row]
3833 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3835 set offs [lindex $rowoffsets $row]
3836 set offs [lreplace $offs end end]
3837 lset rowoffsets $row $offs
3840 set rowrangelist [lreplace $rowrangelist $row $row]
3841 if {[llength $kids] > 0} {
3842 set ranges [lindex $rowrangelist $row]
3843 if {[lindex $ranges end-1] eq $id} {
3844 set ranges [lreplace $ranges end-1 end]
3845 lset rowrangelist $row $ranges
3849 catch {unset rowchk}
3855 if {[info exists selectedline] && $selectedline > $row} {
3856 incr selectedline -1
3861 # Don't change the text pane cursor if it is currently the hand cursor,
3862 # showing that we are over a sha1 ID link.
3863 proc settextcursor {c} {
3864 global ctext curtextcursor
3866 if {[$ctext cget -cursor] == $curtextcursor} {
3867 $ctext config -cursor $c
3869 set curtextcursor $c
3872 proc nowbusy {what} {
3875 if {[array names isbusy] eq {}} {
3876 . config -cursor watch
3882 proc notbusy {what} {
3883 global isbusy maincursor textcursor
3885 catch {unset isbusy($what)}
3886 if {[array names isbusy] eq {}} {
3887 . config -cursor $maincursor
3888 settextcursor $textcursor
3892 proc findmatches {f} {
3893 global findtype foundstring foundstrlen
3894 if {$findtype == "Regexp"} {
3895 set matches [regexp -indices -all -inline $foundstring $f]
3897 if {$findtype == "IgnCase"} {
3898 set str [string tolower $f]
3904 while {[set j [string first $foundstring $str $i]] >= 0} {
3905 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3906 set i [expr {$j + $foundstrlen}]
3913 global findtype findloc findstring markedmatches commitinfo
3914 global numcommits displayorder linehtag linentag linedtag
3915 global mainfont canv canv2 canv3 selectedline
3916 global matchinglines foundstring foundstrlen matchstring
3921 cancel_next_highlight
3923 set matchinglines {}
3924 if {$findtype == "IgnCase"} {
3925 set foundstring [string tolower $findstring]
3927 set foundstring $findstring
3929 set foundstrlen [string length $findstring]
3930 if {$foundstrlen == 0} return
3931 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3932 set matchstring "*$matchstring*"
3933 if {![info exists selectedline]} {
3936 set oldsel $selectedline
3939 set fldtypes {Headline Author Date Committer CDate Comments}
3941 foreach id $displayorder {
3942 set d $commitdata($id)
3944 if {$findtype == "Regexp"} {
3945 set doesmatch [regexp $foundstring $d]
3946 } elseif {$findtype == "IgnCase"} {
3947 set doesmatch [string match -nocase $matchstring $d]
3949 set doesmatch [string match $matchstring $d]
3951 if {!$doesmatch} continue
3952 if {![info exists commitinfo($id)]} {
3955 set info $commitinfo($id)
3957 foreach f $info ty $fldtypes {
3958 if {$findloc != "All fields" && $findloc != $ty} {
3961 set matches [findmatches $f]
3962 if {$matches == {}} continue
3964 if {$ty == "Headline"} {
3966 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3967 } elseif {$ty == "Author"} {
3969 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3970 } elseif {$ty == "Date"} {
3972 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3976 lappend matchinglines $l
3977 if {!$didsel && $l > $oldsel} {
3983 if {$matchinglines == {}} {
3985 } elseif {!$didsel} {
3986 findselectline [lindex $matchinglines 0]
3990 proc findselectline {l} {
3991 global findloc commentend ctext
3993 if {$findloc == "All fields" || $findloc == "Comments"} {
3994 # highlight the matches in the comments
3995 set f [$ctext get 1.0 $commentend]
3996 set matches [findmatches $f]
3997 foreach match $matches {
3998 set start [lindex $match 0]
3999 set end [expr {[lindex $match 1] + 1}]
4000 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4005 proc findnext {restart} {
4006 global matchinglines selectedline
4007 if {![info exists matchinglines]} {
4013 if {![info exists selectedline]} return
4014 foreach l $matchinglines {
4015 if {$l > $selectedline} {
4024 global matchinglines selectedline
4025 if {![info exists matchinglines]} {
4029 if {![info exists selectedline]} return
4031 foreach l $matchinglines {
4032 if {$l >= $selectedline} break
4036 findselectline $prev
4042 proc stopfindproc {{done 0}} {
4043 global findprocpid findprocfile findids
4044 global ctext findoldcursor phase maincursor textcursor
4045 global findinprogress
4047 catch {unset findids}
4048 if {[info exists findprocpid]} {
4050 catch {exec kill $findprocpid}
4052 catch {close $findprocfile}
4055 catch {unset findinprogress}
4059 # mark a commit as matching by putting a yellow background
4060 # behind the headline
4061 proc markheadline {l id} {
4062 global canv mainfont linehtag
4065 set bbox [$canv bbox $linehtag($l)]
4066 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
4070 # mark the bits of a headline, author or date that match a find string
4071 proc markmatches {canv l str tag matches font} {
4072 set bbox [$canv bbox $tag]
4073 set x0 [lindex $bbox 0]
4074 set y0 [lindex $bbox 1]
4075 set y1 [lindex $bbox 3]
4076 foreach match $matches {
4077 set start [lindex $match 0]
4078 set end [lindex $match 1]
4079 if {$start > $end} continue
4080 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4081 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4082 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4083 [expr {$x0+$xlen+2}] $y1 \
4084 -outline {} -tags matches -fill yellow]
4089 proc unmarkmatches {} {
4090 global matchinglines findids
4091 allcanvs delete matches
4092 catch {unset matchinglines}
4093 catch {unset findids}
4096 proc selcanvline {w x y} {
4097 global canv canvy0 ctext linespc
4099 set ymax [lindex [$canv cget -scrollregion] 3]
4100 if {$ymax == {}} return
4101 set yfrac [lindex [$canv yview] 0]
4102 set y [expr {$y + $yfrac * $ymax}]
4103 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4108 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4114 proc commit_descriptor {p} {
4116 if {![info exists commitinfo($p)]} {
4120 if {[llength $commitinfo($p)] > 1} {
4121 set l [lindex $commitinfo($p) 0]
4126 # append some text to the ctext widget, and make any SHA1 ID
4127 # that we know about be a clickable link.
4128 proc appendwithlinks {text tags} {
4129 global ctext commitrow linknum curview
4131 set start [$ctext index "end - 1c"]
4132 $ctext insert end $text $tags
4133 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4137 set linkid [string range $text $s $e]
4138 if {![info exists commitrow($curview,$linkid)]} continue
4140 $ctext tag add link "$start + $s c" "$start + $e c"
4141 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4142 $ctext tag bind link$linknum <1> \
4143 [list selectline $commitrow($curview,$linkid) 1]
4146 $ctext tag conf link -foreground blue -underline 1
4147 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4148 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4151 proc viewnextline {dir} {
4155 set ymax [lindex [$canv cget -scrollregion] 3]
4156 set wnow [$canv yview]
4157 set wtop [expr {[lindex $wnow 0] * $ymax}]
4158 set newtop [expr {$wtop + $dir * $linespc}]
4161 } elseif {$newtop > $ymax} {
4164 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4167 # add a list of tag or branch names at position pos
4168 # returns the number of names inserted
4169 proc appendrefs {pos ids var} {
4170 global ctext commitrow linknum curview $var maxrefs
4172 if {[catch {$ctext index $pos}]} {
4175 $ctext conf -state normal
4176 $ctext delete $pos "$pos lineend"
4179 foreach tag [set $var\($id\)] {
4180 lappend tags [list $tag $id]
4183 if {[llength $tags] > $maxrefs} {
4184 $ctext insert $pos "many ([llength $tags])"
4186 set tags [lsort -index 0 -decreasing $tags]
4189 set id [lindex $ti 1]
4192 $ctext tag delete $lk
4193 $ctext insert $pos $sep
4194 $ctext insert $pos [lindex $ti 0] $lk
4195 if {[info exists commitrow($curview,$id)]} {
4196 $ctext tag conf $lk -foreground blue
4197 $ctext tag bind $lk <1> \
4198 [list selectline $commitrow($curview,$id) 1]
4199 $ctext tag conf $lk -underline 1
4200 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4201 $ctext tag bind $lk <Leave> \
4202 { %W configure -cursor $curtextcursor }
4207 $ctext conf -state disabled
4208 return [llength $tags]
4211 # called when we have finished computing the nearby tags
4212 proc dispneartags {delay} {
4213 global selectedline currentid showneartags tagphase
4215 if {![info exists selectedline] || !$showneartags} return
4216 after cancel dispnexttag
4218 after 200 dispnexttag
4221 after idle dispnexttag
4226 proc dispnexttag {} {
4227 global selectedline currentid showneartags tagphase ctext
4229 if {![info exists selectedline] || !$showneartags} return
4230 switch -- $tagphase {
4232 set dtags [desctags $currentid]
4234 appendrefs precedes $dtags idtags
4238 set atags [anctags $currentid]
4240 appendrefs follows $atags idtags
4244 set dheads [descheads $currentid]
4245 if {$dheads ne {}} {
4246 if {[appendrefs branch $dheads idheads] > 1
4247 && [$ctext get "branch -3c"] eq "h"} {
4248 # turn "Branch" into "Branches"
4249 $ctext conf -state normal
4250 $ctext insert "branch -2c" "es"
4251 $ctext conf -state disabled
4256 if {[incr tagphase] <= 2} {
4257 after idle dispnexttag
4261 proc selectline {l isnew} {
4262 global canv canv2 canv3 ctext commitinfo selectedline
4263 global displayorder linehtag linentag linedtag
4264 global canvy0 linespc parentlist children curview
4265 global currentid sha1entry
4266 global commentend idtags linknum
4267 global mergemax numcommits pending_select
4268 global cmitmode showneartags allcommits
4270 catch {unset pending_select}
4273 cancel_next_highlight
4274 if {$l < 0 || $l >= $numcommits} return
4275 set y [expr {$canvy0 + $l * $linespc}]
4276 set ymax [lindex [$canv cget -scrollregion] 3]
4277 set ytop [expr {$y - $linespc - 1}]
4278 set ybot [expr {$y + $linespc + 1}]
4279 set wnow [$canv yview]
4280 set wtop [expr {[lindex $wnow 0] * $ymax}]
4281 set wbot [expr {[lindex $wnow 1] * $ymax}]
4282 set wh [expr {$wbot - $wtop}]
4284 if {$ytop < $wtop} {
4285 if {$ybot < $wtop} {
4286 set newtop [expr {$y - $wh / 2.0}]
4289 if {$newtop > $wtop - $linespc} {
4290 set newtop [expr {$wtop - $linespc}]
4293 } elseif {$ybot > $wbot} {
4294 if {$ytop > $wbot} {
4295 set newtop [expr {$y - $wh / 2.0}]
4297 set newtop [expr {$ybot - $wh}]
4298 if {$newtop < $wtop + $linespc} {
4299 set newtop [expr {$wtop + $linespc}]
4303 if {$newtop != $wtop} {
4307 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4311 if {![info exists linehtag($l)]} return
4313 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4314 -tags secsel -fill [$canv cget -selectbackground]]
4316 $canv2 delete secsel
4317 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4318 -tags secsel -fill [$canv2 cget -selectbackground]]
4320 $canv3 delete secsel
4321 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4322 -tags secsel -fill [$canv3 cget -selectbackground]]
4326 addtohistory [list selectline $l 0]
4331 set id [lindex $displayorder $l]
4333 $sha1entry delete 0 end
4334 $sha1entry insert 0 $id
4335 $sha1entry selection from 0
4336 $sha1entry selection to end
4339 $ctext conf -state normal
4342 set info $commitinfo($id)
4343 set date [formatdate [lindex $info 2]]
4344 $ctext insert end "Author: [lindex $info 1] $date\n"
4345 set date [formatdate [lindex $info 4]]
4346 $ctext insert end "Committer: [lindex $info 3] $date\n"
4347 if {[info exists idtags($id)]} {
4348 $ctext insert end "Tags:"
4349 foreach tag $idtags($id) {
4350 $ctext insert end " $tag"
4352 $ctext insert end "\n"
4356 set olds [lindex $parentlist $l]
4357 if {[llength $olds] > 1} {
4360 if {$np >= $mergemax} {
4365 $ctext insert end "Parent: " $tag
4366 appendwithlinks [commit_descriptor $p] {}
4371 append headers "Parent: [commit_descriptor $p]"
4375 foreach c $children($curview,$id) {
4376 append headers "Child: [commit_descriptor $c]"
4379 # make anything that looks like a SHA1 ID be a clickable link
4380 appendwithlinks $headers {}
4381 if {$showneartags} {
4382 if {![info exists allcommits]} {
4385 $ctext insert end "Branch: "
4386 $ctext mark set branch "end -1c"
4387 $ctext mark gravity branch left
4388 $ctext insert end "\nFollows: "
4389 $ctext mark set follows "end -1c"
4390 $ctext mark gravity follows left
4391 $ctext insert end "\nPrecedes: "
4392 $ctext mark set precedes "end -1c"
4393 $ctext mark gravity precedes left
4394 $ctext insert end "\n"
4397 $ctext insert end "\n"
4398 set comment [lindex $info 5]
4399 if {[string first "\r" $comment] >= 0} {
4400 set comment [string map {"\r" "\n "} $comment]
4402 appendwithlinks $comment {comment}
4404 $ctext tag remove found 1.0 end
4405 $ctext conf -state disabled
4406 set commentend [$ctext index "end - 1c"]
4408 init_flist "Comments"
4409 if {$cmitmode eq "tree"} {
4411 } elseif {[llength $olds] <= 1} {
4418 proc selfirstline {} {
4423 proc sellastline {} {
4426 set l [expr {$numcommits - 1}]
4430 proc selnextline {dir} {
4432 if {![info exists selectedline]} return
4433 set l [expr {$selectedline + $dir}]
4438 proc selnextpage {dir} {
4439 global canv linespc selectedline numcommits
4441 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4445 allcanvs yview scroll [expr {$dir * $lpp}] units
4447 if {![info exists selectedline]} return
4448 set l [expr {$selectedline + $dir * $lpp}]
4451 } elseif {$l >= $numcommits} {
4452 set l [expr $numcommits - 1]
4458 proc unselectline {} {
4459 global selectedline currentid
4461 catch {unset selectedline}
4462 catch {unset currentid}
4463 allcanvs delete secsel
4465 cancel_next_highlight
4468 proc reselectline {} {
4471 if {[info exists selectedline]} {
4472 selectline $selectedline 0
4476 proc addtohistory {cmd} {
4477 global history historyindex curview
4479 set elt [list $curview $cmd]
4480 if {$historyindex > 0
4481 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4485 if {$historyindex < [llength $history]} {
4486 set history [lreplace $history $historyindex end $elt]
4488 lappend history $elt
4491 if {$historyindex > 1} {
4492 .tf.bar.leftbut conf -state normal
4494 .tf.bar.leftbut conf -state disabled
4496 .tf.bar.rightbut conf -state disabled
4502 set view [lindex $elt 0]
4503 set cmd [lindex $elt 1]
4504 if {$curview != $view} {
4511 global history historyindex
4513 if {$historyindex > 1} {
4514 incr historyindex -1
4515 godo [lindex $history [expr {$historyindex - 1}]]
4516 .tf.bar.rightbut conf -state normal
4518 if {$historyindex <= 1} {
4519 .tf.bar.leftbut conf -state disabled
4524 global history historyindex
4526 if {$historyindex < [llength $history]} {
4527 set cmd [lindex $history $historyindex]
4530 .tf.bar.leftbut conf -state normal
4532 if {$historyindex >= [llength $history]} {
4533 .tf.bar.rightbut conf -state disabled
4538 global treefilelist treeidlist diffids diffmergeid treepending nullid
4541 catch {unset diffmergeid}
4542 if {![info exists treefilelist($id)]} {
4543 if {![info exists treepending]} {
4544 if {$id ne $nullid} {
4545 set cmd [concat | git ls-tree -r $id]
4547 set cmd [concat | git ls-files]
4549 if {[catch {set gtf [open $cmd r]}]} {
4553 set treefilelist($id) {}
4554 set treeidlist($id) {}
4555 fconfigure $gtf -blocking 0
4556 filerun $gtf [list gettreeline $gtf $id]
4563 proc gettreeline {gtf id} {
4564 global treefilelist treeidlist treepending cmitmode diffids nullid
4567 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4568 if {$diffids ne $nullid} {
4569 if {[lindex $line 1] ne "blob"} continue
4570 set i [string first "\t" $line]
4571 if {$i < 0} continue
4572 set sha1 [lindex $line 2]
4573 set fname [string range $line [expr {$i+1}] end]
4574 if {[string index $fname 0] eq "\""} {
4575 set fname [lindex $fname 0]
4577 lappend treeidlist($id) $sha1
4581 lappend treefilelist($id) $fname
4584 return [expr {$nl >= 1000? 2: 1}]
4588 if {$cmitmode ne "tree"} {
4589 if {![info exists diffmergeid]} {
4590 gettreediffs $diffids
4592 } elseif {$id ne $diffids} {
4601 global treefilelist treeidlist diffids nullid
4602 global ctext commentend
4604 set i [lsearch -exact $treefilelist($diffids) $f]
4606 puts "oops, $f not in list for id $diffids"
4609 if {$diffids ne $nullid} {
4610 set blob [lindex $treeidlist($diffids) $i]
4611 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4612 puts "oops, error reading blob $blob: $err"
4616 if {[catch {set bf [open $f r]} err]} {
4617 puts "oops, can't read $f: $err"
4621 fconfigure $bf -blocking 0
4622 filerun $bf [list getblobline $bf $diffids]
4623 $ctext config -state normal
4624 clear_ctext $commentend
4625 $ctext insert end "\n"
4626 $ctext insert end "$f\n" filesep
4627 $ctext config -state disabled
4628 $ctext yview $commentend
4631 proc getblobline {bf id} {
4632 global diffids cmitmode ctext
4634 if {$id ne $diffids || $cmitmode ne "tree"} {
4638 $ctext config -state normal
4640 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4641 $ctext insert end "$line\n"
4644 # delete last newline
4645 $ctext delete "end - 2c" "end - 1c"
4649 $ctext config -state disabled
4650 return [expr {$nl >= 1000? 2: 1}]
4653 proc mergediff {id l} {
4654 global diffmergeid diffopts mdifffd
4660 # this doesn't seem to actually affect anything...
4661 set env(GIT_DIFF_OPTS) $diffopts
4662 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4663 if {[catch {set mdf [open $cmd r]} err]} {
4664 error_popup "Error getting merge diffs: $err"
4667 fconfigure $mdf -blocking 0
4668 set mdifffd($id) $mdf
4669 set np [llength [lindex $parentlist $l]]
4670 filerun $mdf [list getmergediffline $mdf $id $np]
4673 proc getmergediffline {mdf id np} {
4674 global diffmergeid ctext cflist mergemax
4675 global difffilestart mdifffd
4677 $ctext conf -state normal
4679 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4680 if {![info exists diffmergeid] || $id != $diffmergeid
4681 || $mdf != $mdifffd($id)} {
4685 if {[regexp {^diff --cc (.*)} $line match fname]} {
4686 # start of a new file
4687 $ctext insert end "\n"
4688 set here [$ctext index "end - 1c"]
4689 lappend difffilestart $here
4690 add_flist [list $fname]
4691 set l [expr {(78 - [string length $fname]) / 2}]
4692 set pad [string range "----------------------------------------" 1 $l]
4693 $ctext insert end "$pad $fname $pad\n" filesep
4694 } elseif {[regexp {^@@} $line]} {
4695 $ctext insert end "$line\n" hunksep
4696 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4699 # parse the prefix - one ' ', '-' or '+' for each parent
4704 for {set j 0} {$j < $np} {incr j} {
4705 set c [string range $line $j $j]
4708 } elseif {$c == "-"} {
4710 } elseif {$c == "+"} {
4719 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4720 # line doesn't appear in result, parents in $minuses have the line
4721 set num [lindex $minuses 0]
4722 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4723 # line appears in result, parents in $pluses don't have the line
4724 lappend tags mresult
4725 set num [lindex $spaces 0]
4728 if {$num >= $mergemax} {
4733 $ctext insert end "$line\n" $tags
4736 $ctext conf -state disabled
4741 return [expr {$nr >= 1000? 2: 1}]
4744 proc startdiff {ids} {
4745 global treediffs diffids treepending diffmergeid nullid
4748 catch {unset diffmergeid}
4749 if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4750 if {![info exists treepending]} {
4758 proc addtocflist {ids} {
4759 global treediffs cflist
4760 add_flist $treediffs($ids)
4764 proc diffcmd {ids flags} {
4767 set i [lsearch -exact $ids $nullid]
4769 set cmd [concat | git diff-index $flags]
4770 if {[llength $ids] > 1} {
4772 lappend cmd -R [lindex $ids 1]
4774 lappend cmd [lindex $ids 0]
4780 set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4785 proc gettreediffs {ids} {
4786 global treediff treepending
4788 set treepending $ids
4790 if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4791 fconfigure $gdtf -blocking 0
4792 filerun $gdtf [list gettreediffline $gdtf $ids]
4795 proc gettreediffline {gdtf ids} {
4796 global treediff treediffs treepending diffids diffmergeid
4800 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4801 set i [string first "\t" $line]
4803 set file [string range $line [expr {$i+1}] end]
4804 if {[string index $file 0] eq "\""} {
4805 set file [lindex $file 0]
4807 lappend treediff $file
4811 return [expr {$nr >= 1000? 2: 1}]
4814 set treediffs($ids) $treediff
4816 if {$cmitmode eq "tree"} {
4818 } elseif {$ids != $diffids} {
4819 if {![info exists diffmergeid]} {
4820 gettreediffs $diffids
4828 proc getblobdiffs {ids} {
4829 global diffopts blobdifffd diffids env
4830 global diffinhdr treediffs
4832 set env(GIT_DIFF_OPTS) $diffopts
4833 if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4834 puts "error getting diffs: $err"
4838 fconfigure $bdf -blocking 0
4839 set blobdifffd($ids) $bdf
4840 filerun $bdf [list getblobdiffline $bdf $diffids]
4843 proc setinlist {var i val} {
4846 while {[llength [set $var]] < $i} {
4849 if {[llength [set $var]] == $i} {
4856 proc makediffhdr {fname ids} {
4857 global ctext curdiffstart treediffs
4859 set i [lsearch -exact $treediffs($ids) $fname]
4861 setinlist difffilestart $i $curdiffstart
4863 set l [expr {(78 - [string length $fname]) / 2}]
4864 set pad [string range "----------------------------------------" 1 $l]
4865 $ctext insert $curdiffstart "$pad $fname $pad" filesep
4868 proc getblobdiffline {bdf ids} {
4869 global diffids blobdifffd ctext curdiffstart
4870 global diffnexthead diffnextnote difffilestart
4871 global diffinhdr treediffs
4874 $ctext conf -state normal
4875 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4876 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4880 if {![string compare -length 11 "diff --git " $line]} {
4881 # trim off "diff --git "
4882 set line [string range $line 11 end]
4884 # start of a new file
4885 $ctext insert end "\n"
4886 set curdiffstart [$ctext index "end - 1c"]
4887 $ctext insert end "\n" filesep
4888 # If the name hasn't changed the length will be odd,
4889 # the middle char will be a space, and the two bits either
4890 # side will be a/name and b/name, or "a/name" and "b/name".
4891 # If the name has changed we'll get "rename from" and
4892 # "rename to" lines following this, and we'll use them
4893 # to get the filenames.
4894 # This complexity is necessary because spaces in the filename(s)
4895 # don't get escaped.
4896 set l [string length $line]
4897 set i [expr {$l / 2}]
4898 if {!(($l & 1) && [string index $line $i] eq " " &&
4899 [string range $line 2 [expr {$i - 1}]] eq \
4900 [string range $line [expr {$i + 3}] end])} {
4903 # unescape if quoted and chop off the a/ from the front
4904 if {[string index $line 0] eq "\""} {
4905 set fname [string range [lindex $line 0] 2 end]
4907 set fname [string range $line 2 [expr {$i - 1}]]
4909 makediffhdr $fname $ids
4911 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
4912 $line match f1l f1c f2l f2c rest]} {
4913 $ctext insert end "$line\n" hunksep
4916 } elseif {$diffinhdr} {
4917 if {![string compare -length 12 "rename from " $line]} {
4918 set fname [string range $line 12 end]
4919 if {[string index $fname 0] eq "\""} {
4920 set fname [lindex $fname 0]
4922 set i [lsearch -exact $treediffs($ids) $fname]
4924 setinlist difffilestart $i $curdiffstart
4926 } elseif {![string compare -length 10 $line "rename to "]} {
4927 set fname [string range $line 10 end]
4928 if {[string index $fname 0] eq "\""} {
4929 set fname [lindex $fname 0]
4931 makediffhdr $fname $ids
4932 } elseif {[string compare -length 3 $line "---"] == 0} {
4935 } elseif {[string compare -length 3 $line "+++"] == 0} {
4939 $ctext insert end "$line\n" filesep
4942 set x [string range $line 0 0]
4943 if {$x == "-" || $x == "+"} {
4944 set tag [expr {$x == "+"}]
4945 $ctext insert end "$line\n" d$tag
4946 } elseif {$x == " "} {
4947 $ctext insert end "$line\n"
4949 # "\ No newline at end of file",
4950 # or something else we don't recognize
4951 $ctext insert end "$line\n" hunksep
4955 $ctext conf -state disabled
4960 return [expr {$nr >= 1000? 2: 1}]
4963 proc changediffdisp {} {
4964 global ctext diffelide
4966 $ctext tag conf d0 -elide [lindex $diffelide 0]
4967 $ctext tag conf d1 -elide [lindex $diffelide 1]
4971 global difffilestart ctext
4972 set prev [lindex $difffilestart 0]
4973 set here [$ctext index @0,0]
4974 foreach loc $difffilestart {
4975 if {[$ctext compare $loc >= $here]} {
4985 global difffilestart ctext
4986 set here [$ctext index @0,0]
4987 foreach loc $difffilestart {
4988 if {[$ctext compare $loc > $here]} {
4995 proc clear_ctext {{first 1.0}} {
4996 global ctext smarktop smarkbot
4998 set l [lindex [split $first .] 0]
4999 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5002 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5005 $ctext delete $first end
5008 proc incrsearch {name ix op} {
5009 global ctext searchstring searchdirn
5011 $ctext tag remove found 1.0 end
5012 if {[catch {$ctext index anchor}]} {
5013 # no anchor set, use start of selection, or of visible area
5014 set sel [$ctext tag ranges sel]
5016 $ctext mark set anchor [lindex $sel 0]
5017 } elseif {$searchdirn eq "-forwards"} {
5018 $ctext mark set anchor @0,0
5020 $ctext mark set anchor @0,[winfo height $ctext]
5023 if {$searchstring ne {}} {
5024 set here [$ctext search $searchdirn -- $searchstring anchor]
5033 global sstring ctext searchstring searchdirn
5036 $sstring icursor end
5037 set searchdirn -forwards
5038 if {$searchstring ne {}} {
5039 set sel [$ctext tag ranges sel]
5041 set start "[lindex $sel 0] + 1c"
5042 } elseif {[catch {set start [$ctext index anchor]}]} {
5045 set match [$ctext search -count mlen -- $searchstring $start]
5046 $ctext tag remove sel 1.0 end
5052 set mend "$match + $mlen c"
5053 $ctext tag add sel $match $mend
5054 $ctext mark unset anchor
5058 proc dosearchback {} {
5059 global sstring ctext searchstring searchdirn
5062 $sstring icursor end
5063 set searchdirn -backwards
5064 if {$searchstring ne {}} {
5065 set sel [$ctext tag ranges sel]
5067 set start [lindex $sel 0]
5068 } elseif {[catch {set start [$ctext index anchor]}]} {
5069 set start @0,[winfo height $ctext]
5071 set match [$ctext search -backwards -count ml -- $searchstring $start]
5072 $ctext tag remove sel 1.0 end
5078 set mend "$match + $ml c"
5079 $ctext tag add sel $match $mend
5080 $ctext mark unset anchor
5084 proc searchmark {first last} {
5085 global ctext searchstring
5089 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5090 if {$match eq {}} break
5091 set mend "$match + $mlen c"
5092 $ctext tag add found $match $mend
5096 proc searchmarkvisible {doall} {
5097 global ctext smarktop smarkbot
5099 set topline [lindex [split [$ctext index @0,0] .] 0]
5100 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5101 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5102 # no overlap with previous
5103 searchmark $topline $botline
5104 set smarktop $topline
5105 set smarkbot $botline
5107 if {$topline < $smarktop} {
5108 searchmark $topline [expr {$smarktop-1}]
5109 set smarktop $topline
5111 if {$botline > $smarkbot} {
5112 searchmark [expr {$smarkbot+1}] $botline
5113 set smarkbot $botline
5118 proc scrolltext {f0 f1} {
5121 .bleft.sb set $f0 $f1
5122 if {$searchstring ne {}} {
5128 global linespc charspc canvx0 canvy0 mainfont
5129 global xspc1 xspc2 lthickness
5131 set linespc [font metrics $mainfont -linespace]
5132 set charspc [font measure $mainfont "m"]
5133 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5134 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5135 set lthickness [expr {int($linespc / 9) + 1}]
5136 set xspc1(0) $linespc
5144 set ymax [lindex [$canv cget -scrollregion] 3]
5145 if {$ymax eq {} || $ymax == 0} return
5146 set span [$canv yview]
5149 allcanvs yview moveto [lindex $span 0]
5151 if {[info exists selectedline]} {
5152 selectline $selectedline 0
5153 allcanvs yview moveto [lindex $span 0]
5157 proc incrfont {inc} {
5158 global mainfont textfont ctext canv phase cflist
5159 global charspc tabstop
5160 global stopped entries
5162 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5163 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5165 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5166 $cflist conf -font $textfont
5167 $ctext tag conf filesep -font [concat $textfont bold]
5168 foreach e $entries {
5169 $e conf -font $mainfont
5171 if {$phase eq "getcommits"} {
5172 $canv itemconf textitems -font $mainfont
5178 global sha1entry sha1string
5179 if {[string length $sha1string] == 40} {
5180 $sha1entry delete 0 end
5184 proc sha1change {n1 n2 op} {
5185 global sha1string currentid sha1but
5186 if {$sha1string == {}
5187 || ([info exists currentid] && $sha1string == $currentid)} {
5192 if {[$sha1but cget -state] == $state} return
5193 if {$state == "normal"} {
5194 $sha1but conf -state normal -relief raised -text "Goto: "
5196 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5200 proc gotocommit {} {
5201 global sha1string currentid commitrow tagids headids
5202 global displayorder numcommits curview
5204 if {$sha1string == {}
5205 || ([info exists currentid] && $sha1string == $currentid)} return
5206 if {[info exists tagids($sha1string)]} {
5207 set id $tagids($sha1string)
5208 } elseif {[info exists headids($sha1string)]} {
5209 set id $headids($sha1string)
5211 set id [string tolower $sha1string]
5212 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5214 foreach i $displayorder {
5215 if {[string match $id* $i]} {
5219 if {$matches ne {}} {
5220 if {[llength $matches] > 1} {
5221 error_popup "Short SHA1 id $id is ambiguous"
5224 set id [lindex $matches 0]
5228 if {[info exists commitrow($curview,$id)]} {
5229 selectline $commitrow($curview,$id) 1
5232 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5237 error_popup "$type $sha1string is not known"
5240 proc lineenter {x y id} {
5241 global hoverx hovery hoverid hovertimer
5242 global commitinfo canv
5244 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5248 if {[info exists hovertimer]} {
5249 after cancel $hovertimer
5251 set hovertimer [after 500 linehover]
5255 proc linemotion {x y id} {
5256 global hoverx hovery hoverid hovertimer
5258 if {[info exists hoverid] && $id == $hoverid} {
5261 if {[info exists hovertimer]} {
5262 after cancel $hovertimer
5264 set hovertimer [after 500 linehover]
5268 proc lineleave {id} {
5269 global hoverid hovertimer canv
5271 if {[info exists hoverid] && $id == $hoverid} {
5273 if {[info exists hovertimer]} {
5274 after cancel $hovertimer
5282 global hoverx hovery hoverid hovertimer
5283 global canv linespc lthickness
5284 global commitinfo mainfont
5286 set text [lindex $commitinfo($hoverid) 0]
5287 set ymax [lindex [$canv cget -scrollregion] 3]
5288 if {$ymax == {}} return
5289 set yfrac [lindex [$canv yview] 0]
5290 set x [expr {$hoverx + 2 * $linespc}]
5291 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5292 set x0 [expr {$x - 2 * $lthickness}]
5293 set y0 [expr {$y - 2 * $lthickness}]
5294 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5295 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5296 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5297 -fill \#ffff80 -outline black -width 1 -tags hover]
5299 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5304 proc clickisonarrow {id y} {
5307 set ranges [rowranges $id]
5308 set thresh [expr {2 * $lthickness + 6}]
5309 set n [expr {[llength $ranges] - 1}]
5310 for {set i 1} {$i < $n} {incr i} {
5311 set row [lindex $ranges $i]
5312 if {abs([yc $row] - $y) < $thresh} {
5319 proc arrowjump {id n y} {
5322 # 1 <-> 2, 3 <-> 4, etc...
5323 set n [expr {(($n - 1) ^ 1) + 1}]
5324 set row [lindex [rowranges $id] $n]
5326 set ymax [lindex [$canv cget -scrollregion] 3]
5327 if {$ymax eq {} || $ymax <= 0} return
5328 set view [$canv yview]
5329 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5330 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5334 allcanvs yview moveto $yfrac
5337 proc lineclick {x y id isnew} {
5338 global ctext commitinfo children canv thickerline curview
5340 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5345 # draw this line thicker than normal
5349 set ymax [lindex [$canv cget -scrollregion] 3]
5350 if {$ymax eq {}} return
5351 set yfrac [lindex [$canv yview] 0]
5352 set y [expr {$y + $yfrac * $ymax}]
5354 set dirn [clickisonarrow $id $y]
5356 arrowjump $id $dirn $y
5361 addtohistory [list lineclick $x $y $id 0]
5363 # fill the details pane with info about this line
5364 $ctext conf -state normal
5366 $ctext tag conf link -foreground blue -underline 1
5367 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5368 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5369 $ctext insert end "Parent:\t"
5370 $ctext insert end $id [list link link0]
5371 $ctext tag bind link0 <1> [list selbyid $id]
5372 set info $commitinfo($id)
5373 $ctext insert end "\n\t[lindex $info 0]\n"
5374 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5375 set date [formatdate [lindex $info 2]]
5376 $ctext insert end "\tDate:\t$date\n"
5377 set kids $children($curview,$id)
5379 $ctext insert end "\nChildren:"
5381 foreach child $kids {
5383 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5384 set info $commitinfo($child)
5385 $ctext insert end "\n\t"
5386 $ctext insert end $child [list link link$i]
5387 $ctext tag bind link$i <1> [list selbyid $child]
5388 $ctext insert end "\n\t[lindex $info 0]"
5389 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5390 set date [formatdate [lindex $info 2]]
5391 $ctext insert end "\n\tDate:\t$date\n"
5394 $ctext conf -state disabled
5398 proc normalline {} {
5400 if {[info exists thickerline]} {
5408 global commitrow curview
5409 if {[info exists commitrow($curview,$id)]} {
5410 selectline $commitrow($curview,$id) 1
5416 if {![info exists startmstime]} {
5417 set startmstime [clock clicks -milliseconds]
5419 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5422 proc rowmenu {x y id} {
5423 global rowctxmenu commitrow selectedline rowmenuid curview
5424 global nullid fakerowmenu mainhead
5427 if {![info exists selectedline]
5428 || $commitrow($curview,$id) eq $selectedline} {
5433 if {$id ne $nullid} {
5434 set menu $rowctxmenu
5435 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5437 set menu $fakerowmenu
5439 $menu entryconfigure "Diff this*" -state $state
5440 $menu entryconfigure "Diff selected*" -state $state
5441 $menu entryconfigure "Make patch" -state $state
5442 tk_popup $menu $x $y
5445 proc diffvssel {dirn} {
5446 global rowmenuid selectedline displayorder
5448 if {![info exists selectedline]} return
5450 set oldid [lindex $displayorder $selectedline]
5451 set newid $rowmenuid
5453 set oldid $rowmenuid
5454 set newid [lindex $displayorder $selectedline]
5456 addtohistory [list doseldiff $oldid $newid]
5457 doseldiff $oldid $newid
5460 proc doseldiff {oldid newid} {
5464 $ctext conf -state normal
5467 $ctext insert end "From "
5468 $ctext tag conf link -foreground blue -underline 1
5469 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5470 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5471 $ctext tag bind link0 <1> [list selbyid $oldid]
5472 $ctext insert end $oldid [list link link0]
5473 $ctext insert end "\n "
5474 $ctext insert end [lindex $commitinfo($oldid) 0]
5475 $ctext insert end "\n\nTo "
5476 $ctext tag bind link1 <1> [list selbyid $newid]
5477 $ctext insert end $newid [list link link1]
5478 $ctext insert end "\n "
5479 $ctext insert end [lindex $commitinfo($newid) 0]
5480 $ctext insert end "\n"
5481 $ctext conf -state disabled
5482 $ctext tag remove found 1.0 end
5483 startdiff [list $oldid $newid]
5487 global rowmenuid currentid commitinfo patchtop patchnum
5489 if {![info exists currentid]} return
5490 set oldid $currentid
5491 set oldhead [lindex $commitinfo($oldid) 0]
5492 set newid $rowmenuid
5493 set newhead [lindex $commitinfo($newid) 0]
5496 catch {destroy $top}
5498 label $top.title -text "Generate patch"
5499 grid $top.title - -pady 10
5500 label $top.from -text "From:"
5501 entry $top.fromsha1 -width 40 -relief flat
5502 $top.fromsha1 insert 0 $oldid
5503 $top.fromsha1 conf -state readonly
5504 grid $top.from $top.fromsha1 -sticky w
5505 entry $top.fromhead -width 60 -relief flat
5506 $top.fromhead insert 0 $oldhead
5507 $top.fromhead conf -state readonly
5508 grid x $top.fromhead -sticky w
5509 label $top.to -text "To:"
5510 entry $top.tosha1 -width 40 -relief flat
5511 $top.tosha1 insert 0 $newid
5512 $top.tosha1 conf -state readonly
5513 grid $top.to $top.tosha1 -sticky w
5514 entry $top.tohead -width 60 -relief flat
5515 $top.tohead insert 0 $newhead
5516 $top.tohead conf -state readonly
5517 grid x $top.tohead -sticky w
5518 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5519 grid $top.rev x -pady 10
5520 label $top.flab -text "Output file:"
5521 entry $top.fname -width 60
5522 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5524 grid $top.flab $top.fname -sticky w
5526 button $top.buts.gen -text "Generate" -command mkpatchgo
5527 button $top.buts.can -text "Cancel" -command mkpatchcan
5528 grid $top.buts.gen $top.buts.can
5529 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5530 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5531 grid $top.buts - -pady 10 -sticky ew
5535 proc mkpatchrev {} {
5538 set oldid [$patchtop.fromsha1 get]
5539 set oldhead [$patchtop.fromhead get]
5540 set newid [$patchtop.tosha1 get]
5541 set newhead [$patchtop.tohead get]
5542 foreach e [list fromsha1 fromhead tosha1 tohead] \
5543 v [list $newid $newhead $oldid $oldhead] {
5544 $patchtop.$e conf -state normal
5545 $patchtop.$e delete 0 end
5546 $patchtop.$e insert 0 $v
5547 $patchtop.$e conf -state readonly
5552 global patchtop nullid
5554 set oldid [$patchtop.fromsha1 get]
5555 set newid [$patchtop.tosha1 get]
5556 set fname [$patchtop.fname get]
5557 if {$newid eq $nullid} {
5558 set cmd [list git diff-index -p $oldid]
5559 } elseif {$oldid eq $nullid} {
5560 set cmd [list git diff-index -p -R $newid]
5562 set cmd [list git diff-tree -p $oldid $newid]
5564 lappend cmd >$fname &
5565 if {[catch {eval exec $cmd} err]} {
5566 error_popup "Error creating patch: $err"
5568 catch {destroy $patchtop}
5572 proc mkpatchcan {} {
5575 catch {destroy $patchtop}
5580 global rowmenuid mktagtop commitinfo
5584 catch {destroy $top}
5586 label $top.title -text "Create tag"
5587 grid $top.title - -pady 10
5588 label $top.id -text "ID:"
5589 entry $top.sha1 -width 40 -relief flat
5590 $top.sha1 insert 0 $rowmenuid
5591 $top.sha1 conf -state readonly
5592 grid $top.id $top.sha1 -sticky w
5593 entry $top.head -width 60 -relief flat
5594 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5595 $top.head conf -state readonly
5596 grid x $top.head -sticky w
5597 label $top.tlab -text "Tag name:"
5598 entry $top.tag -width 60
5599 grid $top.tlab $top.tag -sticky w
5601 button $top.buts.gen -text "Create" -command mktaggo
5602 button $top.buts.can -text "Cancel" -command mktagcan
5603 grid $top.buts.gen $top.buts.can
5604 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5605 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5606 grid $top.buts - -pady 10 -sticky ew
5611 global mktagtop env tagids idtags
5613 set id [$mktagtop.sha1 get]
5614 set tag [$mktagtop.tag get]
5616 error_popup "No tag name specified"
5619 if {[info exists tagids($tag)]} {
5620 error_popup "Tag \"$tag\" already exists"
5625 set fname [file join $dir "refs/tags" $tag]
5626 set f [open $fname w]
5630 error_popup "Error creating tag: $err"
5634 set tagids($tag) $id
5635 lappend idtags($id) $tag
5640 proc redrawtags {id} {
5641 global canv linehtag commitrow idpos selectedline curview
5642 global mainfont canvxmax iddrawn
5644 if {![info exists commitrow($curview,$id)]} return
5645 if {![info exists iddrawn($id)]} return
5646 drawcommits $commitrow($curview,$id)
5647 $canv delete tag.$id
5648 set xt [eval drawtags $id $idpos($id)]
5649 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5650 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5651 set xr [expr {$xt + [font measure $mainfont $text]}]
5652 if {$xr > $canvxmax} {
5656 if {[info exists selectedline]
5657 && $selectedline == $commitrow($curview,$id)} {
5658 selectline $selectedline 0
5665 catch {destroy $mktagtop}
5674 proc writecommit {} {
5675 global rowmenuid wrcomtop commitinfo wrcomcmd
5677 set top .writecommit
5679 catch {destroy $top}
5681 label $top.title -text "Write commit to file"
5682 grid $top.title - -pady 10
5683 label $top.id -text "ID:"
5684 entry $top.sha1 -width 40 -relief flat
5685 $top.sha1 insert 0 $rowmenuid
5686 $top.sha1 conf -state readonly
5687 grid $top.id $top.sha1 -sticky w
5688 entry $top.head -width 60 -relief flat
5689 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5690 $top.head conf -state readonly
5691 grid x $top.head -sticky w
5692 label $top.clab -text "Command:"
5693 entry $top.cmd -width 60 -textvariable wrcomcmd
5694 grid $top.clab $top.cmd -sticky w -pady 10
5695 label $top.flab -text "Output file:"
5696 entry $top.fname -width 60
5697 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5698 grid $top.flab $top.fname -sticky w
5700 button $top.buts.gen -text "Write" -command wrcomgo
5701 button $top.buts.can -text "Cancel" -command wrcomcan
5702 grid $top.buts.gen $top.buts.can
5703 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5704 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5705 grid $top.buts - -pady 10 -sticky ew
5712 set id [$wrcomtop.sha1 get]
5713 set cmd "echo $id | [$wrcomtop.cmd get]"
5714 set fname [$wrcomtop.fname get]
5715 if {[catch {exec sh -c $cmd >$fname &} err]} {
5716 error_popup "Error writing commit: $err"
5718 catch {destroy $wrcomtop}
5725 catch {destroy $wrcomtop}
5730 global rowmenuid mkbrtop
5733 catch {destroy $top}
5735 label $top.title -text "Create new branch"
5736 grid $top.title - -pady 10
5737 label $top.id -text "ID:"
5738 entry $top.sha1 -width 40 -relief flat
5739 $top.sha1 insert 0 $rowmenuid
5740 $top.sha1 conf -state readonly
5741 grid $top.id $top.sha1 -sticky w
5742 label $top.nlab -text "Name:"
5743 entry $top.name -width 40
5744 grid $top.nlab $top.name -sticky w
5746 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5747 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5748 grid $top.buts.go $top.buts.can
5749 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5750 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5751 grid $top.buts - -pady 10 -sticky ew
5756 global headids idheads
5758 set name [$top.name get]
5759 set id [$top.sha1 get]
5761 error_popup "Please specify a name for the new branch"
5764 catch {destroy $top}
5768 exec git branch $name $id
5773 set headids($name) $id
5774 lappend idheads($id) $name
5782 proc cherrypick {} {
5783 global rowmenuid curview commitrow
5786 set oldhead [exec git rev-parse HEAD]
5787 set dheads [descheads $rowmenuid]
5788 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5789 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5790 included in branch $mainhead -- really re-apply it?"]
5795 # Unfortunately git-cherry-pick writes stuff to stderr even when
5796 # no error occurs, and exec takes that as an indication of error...
5797 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5802 set newhead [exec git rev-parse HEAD]
5803 if {$newhead eq $oldhead} {
5805 error_popup "No changes committed"
5808 addnewchild $newhead $oldhead
5809 if {[info exists commitrow($curview,$oldhead)]} {
5810 insertrow $commitrow($curview,$oldhead) $newhead
5811 if {$mainhead ne {}} {
5812 movehead $newhead $mainhead
5813 movedhead $newhead $mainhead
5822 global mainheadid mainhead rowmenuid confirm_ok resettype
5823 global showlocalchanges
5826 set w ".confirmreset"
5829 wm title $w "Confirm reset"
5830 message $w.m -text \
5831 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5832 -justify center -aspect 1000
5833 pack $w.m -side top -fill x -padx 20 -pady 20
5834 frame $w.f -relief sunken -border 2
5835 message $w.f.rt -text "Reset type:" -aspect 1000
5836 grid $w.f.rt -sticky w
5838 radiobutton $w.f.soft -value soft -variable resettype -justify left \
5839 -text "Soft: Leave working tree and index untouched"
5840 grid $w.f.soft -sticky w
5841 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5842 -text "Mixed: Leave working tree untouched, reset index"
5843 grid $w.f.mixed -sticky w
5844 radiobutton $w.f.hard -value hard -variable resettype -justify left \
5845 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5846 grid $w.f.hard -sticky w
5847 pack $w.f -side top -fill x
5848 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5849 pack $w.ok -side left -fill x -padx 20 -pady 20
5850 button $w.cancel -text Cancel -command "destroy $w"
5851 pack $w.cancel -side right -fill x -padx 20 -pady 20
5852 bind $w <Visibility> "grab $w; focus $w"
5854 if {!$confirm_ok} return
5855 if {[catch {set fd [open \
5856 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
5860 set w ".resetprogress"
5861 filerun $fd [list readresetstat $fd $w]
5864 wm title $w "Reset progress"
5865 message $w.m -text "Reset in progress, please wait..." \
5866 -justify center -aspect 1000
5867 pack $w.m -side top -fill x -padx 20 -pady 5
5868 canvas $w.c -width 150 -height 20 -bg white
5869 $w.c create rect 0 0 0 20 -fill green -tags rect
5870 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
5875 proc readresetstat {fd w} {
5876 global mainhead mainheadid showlocalchanges
5878 if {[gets $fd line] >= 0} {
5879 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
5880 set x [expr {($m * 150) / $n}]
5881 $w.c coords rect 0 0 $x 20
5887 if {[catch {close $fd} err]} {
5890 set oldhead $mainheadid
5891 set newhead [exec git rev-parse HEAD]
5892 if {$newhead ne $oldhead} {
5893 movehead $newhead $mainhead
5894 movedhead $newhead $mainhead
5895 set mainheadid $newhead
5899 if {$showlocalchanges} {
5905 # context menu for a head
5906 proc headmenu {x y id head} {
5907 global headmenuid headmenuhead headctxmenu mainhead
5910 set headmenuhead $head
5912 if {$head eq $mainhead} {
5915 $headctxmenu entryconfigure 0 -state $state
5916 $headctxmenu entryconfigure 1 -state $state
5917 tk_popup $headctxmenu $x $y
5921 global headmenuid headmenuhead mainhead headids
5922 global showlocalchanges mainheadid
5924 # check the tree is clean first??
5925 set oldmainhead $mainhead
5930 exec git checkout -q $headmenuhead
5936 set mainhead $headmenuhead
5937 set mainheadid $headmenuid
5938 if {[info exists headids($oldmainhead)]} {
5939 redrawtags $headids($oldmainhead)
5941 redrawtags $headmenuid
5943 if {$showlocalchanges} {
5949 global headmenuid headmenuhead mainhead
5950 global headids idheads
5952 set head $headmenuhead
5954 # this check shouldn't be needed any more...
5955 if {$head eq $mainhead} {
5956 error_popup "Cannot delete the currently checked-out branch"
5959 set dheads [descheads $id]
5960 if {$dheads eq $headids($head)} {
5961 # the stuff on this branch isn't on any other branch
5962 if {![confirm_popup "The commits on branch $head aren't on any other\
5963 branch.\nReally delete branch $head?"]} return
5967 if {[catch {exec git branch -D $head} err]} {
5972 removehead $id $head
5973 removedhead $id $head
5979 # Stuff for finding nearby tags
5980 proc getallcommits {} {
5981 global allcommits allids nbmp nextarc seeds
5991 # Called when the graph might have changed
5992 proc regetallcommits {} {
5993 global allcommits seeds
5995 set cmd [concat | git rev-list --all --parents]
5999 set fd [open $cmd r]
6000 fconfigure $fd -blocking 0
6003 filerun $fd [list getallclines $fd]
6006 # Since most commits have 1 parent and 1 child, we group strings of
6007 # such commits into "arcs" joining branch/merge points (BMPs), which
6008 # are commits that either don't have 1 parent or don't have 1 child.
6010 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6011 # arcout(id) - outgoing arcs for BMP
6012 # arcids(a) - list of IDs on arc including end but not start
6013 # arcstart(a) - BMP ID at start of arc
6014 # arcend(a) - BMP ID at end of arc
6015 # growing(a) - arc a is still growing
6016 # arctags(a) - IDs out of arcids (excluding end) that have tags
6017 # archeads(a) - IDs out of arcids (excluding end) that have heads
6018 # The start of an arc is at the descendent end, so "incoming" means
6019 # coming from descendents, and "outgoing" means going towards ancestors.
6021 proc getallclines {fd} {
6022 global allids allparents allchildren idtags idheads nextarc nbmp
6023 global arcnos arcids arctags arcout arcend arcstart archeads growing
6024 global seeds allcommits
6027 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6028 set id [lindex $line 0]
6029 if {[info exists allparents($id)]} {
6034 set olds [lrange $line 1 end]
6035 set allparents($id) $olds
6036 if {![info exists allchildren($id)]} {
6037 set allchildren($id) {}
6042 if {[llength $olds] == 1 && [llength $a] == 1} {
6043 lappend arcids($a) $id
6044 if {[info exists idtags($id)]} {
6045 lappend arctags($a) $id
6047 if {[info exists idheads($id)]} {
6048 lappend archeads($a) $id
6050 if {[info exists allparents($olds)]} {
6051 # seen parent already
6052 if {![info exists arcout($olds)]} {
6055 lappend arcids($a) $olds
6056 set arcend($a) $olds
6059 lappend allchildren($olds) $id
6060 lappend arcnos($olds) $a
6065 foreach a $arcnos($id) {
6066 lappend arcids($a) $id
6073 lappend allchildren($p) $id
6074 set a [incr nextarc]
6075 set arcstart($a) $id
6082 if {[info exists allparents($p)]} {
6083 # seen it already, may need to make a new branch
6084 if {![info exists arcout($p)]} {
6087 lappend arcids($a) $p
6091 lappend arcnos($p) $a
6096 global cached_dheads cached_dtags cached_atags
6097 catch {unset cached_dheads}
6098 catch {unset cached_dtags}
6099 catch {unset cached_atags}
6102 return [expr {$nid >= 1000? 2: 1}]
6105 if {[incr allcommits -1] == 0} {
6112 proc recalcarc {a} {
6113 global arctags archeads arcids idtags idheads
6117 foreach id [lrange $arcids($a) 0 end-1] {
6118 if {[info exists idtags($id)]} {
6121 if {[info exists idheads($id)]} {
6126 set archeads($a) $ah
6130 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6131 global arcstart arcend arcout allparents growing
6134 if {[llength $a] != 1} {
6135 puts "oops splitarc called but [llength $a] arcs already"
6139 set i [lsearch -exact $arcids($a) $p]
6141 puts "oops splitarc $p not in arc $a"
6144 set na [incr nextarc]
6145 if {[info exists arcend($a)]} {
6146 set arcend($na) $arcend($a)
6148 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6149 set j [lsearch -exact $arcnos($l) $a]
6150 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6152 set tail [lrange $arcids($a) [expr {$i+1}] end]
6153 set arcids($a) [lrange $arcids($a) 0 $i]
6155 set arcstart($na) $p
6157 set arcids($na) $tail
6158 if {[info exists growing($a)]} {
6165 if {[llength $arcnos($id)] == 1} {
6168 set j [lsearch -exact $arcnos($id) $a]
6169 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6173 # reconstruct tags and heads lists
6174 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6179 set archeads($na) {}
6183 # Update things for a new commit added that is a child of one
6184 # existing commit. Used when cherry-picking.
6185 proc addnewchild {id p} {
6186 global allids allparents allchildren idtags nextarc nbmp
6187 global arcnos arcids arctags arcout arcend arcstart archeads growing
6191 set allparents($id) [list $p]
6192 set allchildren($id) {}
6196 lappend allchildren($p) $id
6197 set a [incr nextarc]
6198 set arcstart($a) $id
6201 set arcids($a) [list $p]
6203 if {![info exists arcout($p)]} {
6206 lappend arcnos($p) $a
6207 set arcout($id) [list $a]
6210 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6211 # or 0 if neither is true.
6212 proc anc_or_desc {a b} {
6213 global arcout arcstart arcend arcnos cached_isanc
6215 if {$arcnos($a) eq $arcnos($b)} {
6216 # Both are on the same arc(s); either both are the same BMP,
6217 # or if one is not a BMP, the other is also not a BMP or is
6218 # the BMP at end of the arc (and it only has 1 incoming arc).
6222 # assert {[llength $arcnos($a)] == 1}
6223 set arc [lindex $arcnos($a) 0]
6224 set i [lsearch -exact $arcids($arc) $a]
6225 set j [lsearch -exact $arcids($arc) $b]
6226 if {$i < 0 || $i > $j} {
6233 if {![info exists arcout($a)]} {
6234 set arc [lindex $arcnos($a) 0]
6235 if {[info exists arcend($arc)]} {
6236 set aend $arcend($arc)
6240 set a $arcstart($arc)
6244 if {![info exists arcout($b)]} {
6245 set arc [lindex $arcnos($b) 0]
6246 if {[info exists arcend($arc)]} {
6247 set bend $arcend($arc)
6251 set b $arcstart($arc)
6261 if {[info exists cached_isanc($a,$bend)]} {
6262 if {$cached_isanc($a,$bend)} {
6266 if {[info exists cached_isanc($b,$aend)]} {
6267 if {$cached_isanc($b,$aend)} {
6270 if {[info exists cached_isanc($a,$bend)]} {
6275 set todo [list $a $b]
6278 for {set i 0} {$i < [llength $todo]} {incr i} {
6279 set x [lindex $todo $i]
6280 if {$anc($x) eq {}} {
6283 foreach arc $arcnos($x) {
6284 set xd $arcstart($arc)
6286 set cached_isanc($a,$bend) 1
6287 set cached_isanc($b,$aend) 0
6289 } elseif {$xd eq $aend} {
6290 set cached_isanc($b,$aend) 1
6291 set cached_isanc($a,$bend) 0
6294 if {![info exists anc($xd)]} {
6295 set anc($xd) $anc($x)
6297 } elseif {$anc($xd) ne $anc($x)} {
6302 set cached_isanc($a,$bend) 0
6303 set cached_isanc($b,$aend) 0
6307 # This identifies whether $desc has an ancestor that is
6308 # a growing tip of the graph and which is not an ancestor of $anc
6309 # and returns 0 if so and 1 if not.
6310 # If we subsequently discover a tag on such a growing tip, and that
6311 # turns out to be a descendent of $anc (which it could, since we
6312 # don't necessarily see children before parents), then $desc
6313 # isn't a good choice to display as a descendent tag of
6314 # $anc (since it is the descendent of another tag which is
6315 # a descendent of $anc). Similarly, $anc isn't a good choice to
6316 # display as a ancestor tag of $desc.
6318 proc is_certain {desc anc} {
6319 global arcnos arcout arcstart arcend growing problems
6322 if {[llength $arcnos($anc)] == 1} {
6323 # tags on the same arc are certain
6324 if {$arcnos($desc) eq $arcnos($anc)} {
6327 if {![info exists arcout($anc)]} {
6328 # if $anc is partway along an arc, use the start of the arc instead
6329 set a [lindex $arcnos($anc) 0]
6330 set anc $arcstart($a)
6333 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6336 set a [lindex $arcnos($desc) 0]
6342 set anclist [list $x]
6346 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6347 set x [lindex $anclist $i]
6352 foreach a $arcout($x) {
6353 if {[info exists growing($a)]} {
6354 if {![info exists growanc($x)] && $dl($x)} {
6360 if {[info exists dl($y)]} {
6364 if {![info exists done($y)]} {
6367 if {[info exists growanc($x)]} {
6371 for {set k 0} {$k < [llength $xl]} {incr k} {
6372 set z [lindex $xl $k]
6373 foreach c $arcout($z) {
6374 if {[info exists arcend($c)]} {
6376 if {[info exists dl($v)] && $dl($v)} {
6378 if {![info exists done($v)]} {
6381 if {[info exists growanc($v)]} {
6391 } elseif {$y eq $anc || !$dl($x)} {
6402 foreach x [array names growanc] {
6411 proc validate_arctags {a} {
6412 global arctags idtags
6416 foreach id $arctags($a) {
6418 if {![info exists idtags($id)]} {
6419 set na [lreplace $na $i $i]
6426 proc validate_archeads {a} {
6427 global archeads idheads
6430 set na $archeads($a)
6431 foreach id $archeads($a) {
6433 if {![info exists idheads($id)]} {
6434 set na [lreplace $na $i $i]
6438 set archeads($a) $na
6441 # Return the list of IDs that have tags that are descendents of id,
6442 # ignoring IDs that are descendents of IDs already reported.
6443 proc desctags {id} {
6444 global arcnos arcstart arcids arctags idtags allparents
6445 global growing cached_dtags
6447 if {![info exists allparents($id)]} {
6450 set t1 [clock clicks -milliseconds]
6452 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6453 # part-way along an arc; check that arc first
6454 set a [lindex $arcnos($id) 0]
6455 if {$arctags($a) ne {}} {
6457 set i [lsearch -exact $arcids($a) $id]
6459 foreach t $arctags($a) {
6460 set j [lsearch -exact $arcids($a) $t]
6468 set id $arcstart($a)
6469 if {[info exists idtags($id)]} {
6473 if {[info exists cached_dtags($id)]} {
6474 return $cached_dtags($id)
6481 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6482 set id [lindex $todo $i]
6484 set ta [info exists hastaggedancestor($id)]
6488 # ignore tags on starting node
6489 if {!$ta && $i > 0} {
6490 if {[info exists idtags($id)]} {
6493 } elseif {[info exists cached_dtags($id)]} {
6494 set tagloc($id) $cached_dtags($id)
6498 foreach a $arcnos($id) {
6500 if {!$ta && $arctags($a) ne {}} {
6502 if {$arctags($a) ne {}} {
6503 lappend tagloc($id) [lindex $arctags($a) end]
6506 if {$ta || $arctags($a) ne {}} {
6507 set tomark [list $d]
6508 for {set j 0} {$j < [llength $tomark]} {incr j} {
6509 set dd [lindex $tomark $j]
6510 if {![info exists hastaggedancestor($dd)]} {
6511 if {[info exists done($dd)]} {
6512 foreach b $arcnos($dd) {
6513 lappend tomark $arcstart($b)
6515 if {[info exists tagloc($dd)]} {
6518 } elseif {[info exists queued($dd)]} {
6521 set hastaggedancestor($dd) 1
6525 if {![info exists queued($d)]} {
6528 if {![info exists hastaggedancestor($d)]} {
6535 foreach id [array names tagloc] {
6536 if {![info exists hastaggedancestor($id)]} {
6537 foreach t $tagloc($id) {
6538 if {[lsearch -exact $tags $t] < 0} {
6544 set t2 [clock clicks -milliseconds]
6547 # remove tags that are descendents of other tags
6548 for {set i 0} {$i < [llength $tags]} {incr i} {
6549 set a [lindex $tags $i]
6550 for {set j 0} {$j < $i} {incr j} {
6551 set b [lindex $tags $j]
6552 set r [anc_or_desc $a $b]
6554 set tags [lreplace $tags $j $j]
6557 } elseif {$r == -1} {
6558 set tags [lreplace $tags $i $i]
6565 if {[array names growing] ne {}} {
6566 # graph isn't finished, need to check if any tag could get
6567 # eclipsed by another tag coming later. Simply ignore any
6568 # tags that could later get eclipsed.
6571 if {[is_certain $t $origid]} {
6575 if {$tags eq $ctags} {
6576 set cached_dtags($origid) $tags
6581 set cached_dtags($origid) $tags
6583 set t3 [clock clicks -milliseconds]
6584 if {0 && $t3 - $t1 >= 100} {
6585 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6586 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6592 global arcnos arcids arcout arcend arctags idtags allparents
6593 global growing cached_atags
6595 if {![info exists allparents($id)]} {
6598 set t1 [clock clicks -milliseconds]
6600 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6601 # part-way along an arc; check that arc first
6602 set a [lindex $arcnos($id) 0]
6603 if {$arctags($a) ne {}} {
6605 set i [lsearch -exact $arcids($a) $id]
6606 foreach t $arctags($a) {
6607 set j [lsearch -exact $arcids($a) $t]
6613 if {![info exists arcend($a)]} {
6617 if {[info exists idtags($id)]} {
6621 if {[info exists cached_atags($id)]} {
6622 return $cached_atags($id)
6630 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6631 set id [lindex $todo $i]
6633 set td [info exists hastaggeddescendent($id)]
6637 # ignore tags on starting node
6638 if {!$td && $i > 0} {
6639 if {[info exists idtags($id)]} {
6642 } elseif {[info exists cached_atags($id)]} {
6643 set tagloc($id) $cached_atags($id)
6647 foreach a $arcout($id) {
6648 if {!$td && $arctags($a) ne {}} {
6650 if {$arctags($a) ne {}} {
6651 lappend tagloc($id) [lindex $arctags($a) 0]
6654 if {![info exists arcend($a)]} continue
6656 if {$td || $arctags($a) ne {}} {
6657 set tomark [list $d]
6658 for {set j 0} {$j < [llength $tomark]} {incr j} {
6659 set dd [lindex $tomark $j]
6660 if {![info exists hastaggeddescendent($dd)]} {
6661 if {[info exists done($dd)]} {
6662 foreach b $arcout($dd) {
6663 if {[info exists arcend($b)]} {
6664 lappend tomark $arcend($b)
6667 if {[info exists tagloc($dd)]} {
6670 } elseif {[info exists queued($dd)]} {
6673 set hastaggeddescendent($dd) 1
6677 if {![info exists queued($d)]} {
6680 if {![info exists hastaggeddescendent($d)]} {
6686 set t2 [clock clicks -milliseconds]
6689 foreach id [array names tagloc] {
6690 if {![info exists hastaggeddescendent($id)]} {
6691 foreach t $tagloc($id) {
6692 if {[lsearch -exact $tags $t] < 0} {
6699 # remove tags that are ancestors of other tags
6700 for {set i 0} {$i < [llength $tags]} {incr i} {
6701 set a [lindex $tags $i]
6702 for {set j 0} {$j < $i} {incr j} {
6703 set b [lindex $tags $j]
6704 set r [anc_or_desc $a $b]
6706 set tags [lreplace $tags $j $j]
6709 } elseif {$r == 1} {
6710 set tags [lreplace $tags $i $i]
6717 if {[array names growing] ne {}} {
6718 # graph isn't finished, need to check if any tag could get
6719 # eclipsed by another tag coming later. Simply ignore any
6720 # tags that could later get eclipsed.
6723 if {[is_certain $origid $t]} {
6727 if {$tags eq $ctags} {
6728 set cached_atags($origid) $tags
6733 set cached_atags($origid) $tags
6735 set t3 [clock clicks -milliseconds]
6736 if {0 && $t3 - $t1 >= 100} {
6737 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6738 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6743 # Return the list of IDs that have heads that are descendents of id,
6744 # including id itself if it has a head.
6745 proc descheads {id} {
6746 global arcnos arcstart arcids archeads idheads cached_dheads
6749 if {![info exists allparents($id)]} {
6753 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6754 # part-way along an arc; check it first
6755 set a [lindex $arcnos($id) 0]
6756 if {$archeads($a) ne {}} {
6757 validate_archeads $a
6758 set i [lsearch -exact $arcids($a) $id]
6759 foreach t $archeads($a) {
6760 set j [lsearch -exact $arcids($a) $t]
6765 set id $arcstart($a)
6771 for {set i 0} {$i < [llength $todo]} {incr i} {
6772 set id [lindex $todo $i]
6773 if {[info exists cached_dheads($id)]} {
6774 set ret [concat $ret $cached_dheads($id)]
6776 if {[info exists idheads($id)]} {
6779 foreach a $arcnos($id) {
6780 if {$archeads($a) ne {}} {
6781 validate_archeads $a
6782 if {$archeads($a) ne {}} {
6783 set ret [concat $ret $archeads($a)]
6787 if {![info exists seen($d)]} {
6794 set ret [lsort -unique $ret]
6795 set cached_dheads($origid) $ret
6796 return [concat $ret $aret]
6799 proc addedtag {id} {
6800 global arcnos arcout cached_dtags cached_atags
6802 if {![info exists arcnos($id)]} return
6803 if {![info exists arcout($id)]} {
6804 recalcarc [lindex $arcnos($id) 0]
6806 catch {unset cached_dtags}
6807 catch {unset cached_atags}
6810 proc addedhead {hid head} {
6811 global arcnos arcout cached_dheads
6813 if {![info exists arcnos($hid)]} return
6814 if {![info exists arcout($hid)]} {
6815 recalcarc [lindex $arcnos($hid) 0]
6817 catch {unset cached_dheads}
6820 proc removedhead {hid head} {
6821 global cached_dheads
6823 catch {unset cached_dheads}
6826 proc movedhead {hid head} {
6827 global arcnos arcout cached_dheads
6829 if {![info exists arcnos($hid)]} return
6830 if {![info exists arcout($hid)]} {
6831 recalcarc [lindex $arcnos($hid) 0]
6833 catch {unset cached_dheads}
6836 proc changedrefs {} {
6837 global cached_dheads cached_dtags cached_atags
6838 global arctags archeads arcnos arcout idheads idtags
6840 foreach id [concat [array names idheads] [array names idtags]] {
6841 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6842 set a [lindex $arcnos($id) 0]
6843 if {![info exists donearc($a)]} {
6849 catch {unset cached_dtags}
6850 catch {unset cached_atags}
6851 catch {unset cached_dheads}
6854 proc rereadrefs {} {
6855 global idtags idheads idotherrefs mainhead
6857 set refids [concat [array names idtags] \
6858 [array names idheads] [array names idotherrefs]]
6859 foreach id $refids {
6860 if {![info exists ref($id)]} {
6861 set ref($id) [listrefs $id]
6864 set oldmainhead $mainhead
6867 set refids [lsort -unique [concat $refids [array names idtags] \
6868 [array names idheads] [array names idotherrefs]]]
6869 foreach id $refids {
6870 set v [listrefs $id]
6871 if {![info exists ref($id)] || $ref($id) != $v ||
6872 ($id eq $oldmainhead && $id ne $mainhead) ||
6873 ($id eq $mainhead && $id ne $oldmainhead)} {
6879 proc listrefs {id} {
6880 global idtags idheads idotherrefs
6883 if {[info exists idtags($id)]} {
6887 if {[info exists idheads($id)]} {
6891 if {[info exists idotherrefs($id)]} {
6892 set z $idotherrefs($id)
6894 return [list $x $y $z]
6897 proc showtag {tag isnew} {
6898 global ctext tagcontents tagids linknum tagobjid
6901 addtohistory [list showtag $tag 0]
6903 $ctext conf -state normal
6906 if {![info exists tagcontents($tag)]} {
6908 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6911 if {[info exists tagcontents($tag)]} {
6912 set text $tagcontents($tag)
6914 set text "Tag: $tag\nId: $tagids($tag)"
6916 appendwithlinks $text {}
6917 $ctext conf -state disabled
6929 global maxwidth maxgraphpct diffopts
6930 global oldprefs prefstop showneartags showlocalchanges
6931 global bgcolor fgcolor ctext diffcolors selectbgcolor
6932 global uifont tabstop
6936 if {[winfo exists $top]} {
6940 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6941 set oldprefs($v) [set $v]
6944 wm title $top "Gitk preferences"
6945 label $top.ldisp -text "Commit list display options"
6946 $top.ldisp configure -font $uifont
6947 grid $top.ldisp - -sticky w -pady 10
6948 label $top.spacer -text " "
6949 label $top.maxwidthl -text "Maximum graph width (lines)" \
6951 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6952 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6953 label $top.maxpctl -text "Maximum graph width (% of pane)" \
6955 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6956 grid x $top.maxpctl $top.maxpct -sticky w
6957 frame $top.showlocal
6958 label $top.showlocal.l -text "Show local changes" -font optionfont
6959 checkbutton $top.showlocal.b -variable showlocalchanges
6960 pack $top.showlocal.b $top.showlocal.l -side left
6961 grid x $top.showlocal -sticky w
6963 label $top.ddisp -text "Diff display options"
6964 $top.ddisp configure -font $uifont
6965 grid $top.ddisp - -sticky w -pady 10
6966 label $top.diffoptl -text "Options for diff program" \
6968 entry $top.diffopt -width 20 -textvariable diffopts
6969 grid x $top.diffoptl $top.diffopt -sticky w
6971 label $top.ntag.l -text "Display nearby tags" -font optionfont
6972 checkbutton $top.ntag.b -variable showneartags
6973 pack $top.ntag.b $top.ntag.l -side left
6974 grid x $top.ntag -sticky w
6975 label $top.tabstopl -text "tabstop" -font optionfont
6976 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
6977 grid x $top.tabstopl $top.tabstop -sticky w
6979 label $top.cdisp -text "Colors: press to choose"
6980 $top.cdisp configure -font $uifont
6981 grid $top.cdisp - -sticky w -pady 10
6982 label $top.bg -padx 40 -relief sunk -background $bgcolor
6983 button $top.bgbut -text "Background" -font optionfont \
6984 -command [list choosecolor bgcolor 0 $top.bg background setbg]
6985 grid x $top.bgbut $top.bg -sticky w
6986 label $top.fg -padx 40 -relief sunk -background $fgcolor
6987 button $top.fgbut -text "Foreground" -font optionfont \
6988 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6989 grid x $top.fgbut $top.fg -sticky w
6990 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6991 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6992 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6993 [list $ctext tag conf d0 -foreground]]
6994 grid x $top.diffoldbut $top.diffold -sticky w
6995 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6996 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6997 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6998 [list $ctext tag conf d1 -foreground]]
6999 grid x $top.diffnewbut $top.diffnew -sticky w
7000 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7001 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7002 -command [list choosecolor diffcolors 2 $top.hunksep \
7003 "diff hunk header" \
7004 [list $ctext tag conf hunksep -foreground]]
7005 grid x $top.hunksepbut $top.hunksep -sticky w
7006 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7007 button $top.selbgbut -text "Select bg" -font optionfont \
7008 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7009 grid x $top.selbgbut $top.selbgsep -sticky w
7012 button $top.buts.ok -text "OK" -command prefsok -default active
7013 $top.buts.ok configure -font $uifont
7014 button $top.buts.can -text "Cancel" -command prefscan -default normal
7015 $top.buts.can configure -font $uifont
7016 grid $top.buts.ok $top.buts.can
7017 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7018 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7019 grid $top.buts - - -pady 10 -sticky ew
7020 bind $top <Visibility> "focus $top.buts.ok"
7023 proc choosecolor {v vi w x cmd} {
7026 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7027 -title "Gitk: choose color for $x"]
7028 if {$c eq {}} return
7029 $w conf -background $c
7035 global bglist cflist
7037 $w configure -selectbackground $c
7039 $cflist tag configure highlight \
7040 -background [$cflist cget -selectbackground]
7041 allcanvs itemconf secsel -fill $c
7048 $w conf -background $c
7056 $w conf -foreground $c
7058 allcanvs itemconf text -fill $c
7059 $canv itemconf circle -outline $c
7063 global maxwidth maxgraphpct diffopts
7064 global oldprefs prefstop showneartags showlocalchanges
7066 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7067 set $v $oldprefs($v)
7069 catch {destroy $prefstop}
7074 global maxwidth maxgraphpct
7075 global oldprefs prefstop showneartags showlocalchanges
7076 global charspc ctext tabstop
7078 catch {destroy $prefstop}
7080 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7081 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7082 if {$showlocalchanges} {
7088 if {$maxwidth != $oldprefs(maxwidth)
7089 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7091 } elseif {$showneartags != $oldprefs(showneartags)} {
7096 proc formatdate {d} {
7098 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7103 # This list of encoding names and aliases is distilled from
7104 # http://www.iana.org/assignments/character-sets.
7105 # Not all of them are supported by Tcl.
7106 set encoding_aliases {
7107 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7108 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7109 { ISO-10646-UTF-1 csISO10646UTF1 }
7110 { ISO_646.basic:1983 ref csISO646basic1983 }
7111 { INVARIANT csINVARIANT }
7112 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7113 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7114 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7115 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7116 { NATS-DANO iso-ir-9-1 csNATSDANO }
7117 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7118 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7119 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7120 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7121 { ISO-2022-KR csISO2022KR }
7123 { ISO-2022-JP csISO2022JP }
7124 { ISO-2022-JP-2 csISO2022JP2 }
7125 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7127 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7128 { IT iso-ir-15 ISO646-IT csISO15Italian }
7129 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7130 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7131 { greek7-old iso-ir-18 csISO18Greek7Old }
7132 { latin-greek iso-ir-19 csISO19LatinGreek }
7133 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7134 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7135 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7136 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7137 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7138 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7139 { INIS iso-ir-49 csISO49INIS }
7140 { INIS-8 iso-ir-50 csISO50INIS8 }
7141 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7142 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7143 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7144 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7145 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7146 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7148 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7149 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7150 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7151 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7152 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7153 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7154 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7155 { greek7 iso-ir-88 csISO88Greek7 }
7156 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7157 { iso-ir-90 csISO90 }
7158 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7159 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7160 csISO92JISC62991984b }
7161 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7162 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7163 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7164 csISO95JIS62291984handadd }
7165 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7166 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7167 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7168 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7170 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7171 { T.61-7bit iso-ir-102 csISO102T617bit }
7172 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7173 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7174 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7175 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7176 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7177 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7178 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7179 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7180 arabic csISOLatinArabic }
7181 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7182 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7183 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7184 greek greek8 csISOLatinGreek }
7185 { T.101-G2 iso-ir-128 csISO128T101G2 }
7186 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7188 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7189 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7190 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7191 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7192 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7193 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7194 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7195 csISOLatinCyrillic }
7196 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7197 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7198 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7199 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7200 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7201 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7202 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7203 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7204 { ISO_10367-box iso-ir-155 csISO10367Box }
7205 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7206 { latin-lap lap iso-ir-158 csISO158Lap }
7207 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7208 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7211 { JIS_X0201 X0201 csHalfWidthKatakana }
7212 { KSC5636 ISO646-KR csKSC5636 }
7213 { ISO-10646-UCS-2 csUnicode }
7214 { ISO-10646-UCS-4 csUCS4 }
7215 { DEC-MCS dec csDECMCS }
7216 { hp-roman8 roman8 r8 csHPRoman8 }
7217 { macintosh mac csMacintosh }
7218 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7220 { IBM038 EBCDIC-INT cp038 csIBM038 }
7221 { IBM273 CP273 csIBM273 }
7222 { IBM274 EBCDIC-BE CP274 csIBM274 }
7223 { IBM275 EBCDIC-BR cp275 csIBM275 }
7224 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7225 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7226 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7227 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7228 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7229 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7230 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7231 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7232 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7233 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7234 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7235 { IBM437 cp437 437 csPC8CodePage437 }
7236 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7237 { IBM775 cp775 csPC775Baltic }
7238 { IBM850 cp850 850 csPC850Multilingual }
7239 { IBM851 cp851 851 csIBM851 }
7240 { IBM852 cp852 852 csPCp852 }
7241 { IBM855 cp855 855 csIBM855 }
7242 { IBM857 cp857 857 csIBM857 }
7243 { IBM860 cp860 860 csIBM860 }
7244 { IBM861 cp861 861 cp-is csIBM861 }
7245 { IBM862 cp862 862 csPC862LatinHebrew }
7246 { IBM863 cp863 863 csIBM863 }
7247 { IBM864 cp864 csIBM864 }
7248 { IBM865 cp865 865 csIBM865 }
7249 { IBM866 cp866 866 csIBM866 }
7250 { IBM868 CP868 cp-ar csIBM868 }
7251 { IBM869 cp869 869 cp-gr csIBM869 }
7252 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7253 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7254 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7255 { IBM891 cp891 csIBM891 }
7256 { IBM903 cp903 csIBM903 }
7257 { IBM904 cp904 904 csIBBM904 }
7258 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7259 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7260 { IBM1026 CP1026 csIBM1026 }
7261 { EBCDIC-AT-DE csIBMEBCDICATDE }
7262 { EBCDIC-AT-DE-A csEBCDICATDEA }
7263 { EBCDIC-CA-FR csEBCDICCAFR }
7264 { EBCDIC-DK-NO csEBCDICDKNO }
7265 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7266 { EBCDIC-FI-SE csEBCDICFISE }
7267 { EBCDIC-FI-SE-A csEBCDICFISEA }
7268 { EBCDIC-FR csEBCDICFR }
7269 { EBCDIC-IT csEBCDICIT }
7270 { EBCDIC-PT csEBCDICPT }
7271 { EBCDIC-ES csEBCDICES }
7272 { EBCDIC-ES-A csEBCDICESA }
7273 { EBCDIC-ES-S csEBCDICESS }
7274 { EBCDIC-UK csEBCDICUK }
7275 { EBCDIC-US csEBCDICUS }
7276 { UNKNOWN-8BIT csUnknown8BiT }
7277 { MNEMONIC csMnemonic }
7282 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7283 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7284 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7285 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7286 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7287 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7288 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7289 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7290 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7291 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7292 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7293 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7294 { IBM1047 IBM-1047 }
7295 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7296 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7297 { UNICODE-1-1 csUnicode11 }
7300 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7301 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7303 { ISO-8859-15 ISO_8859-15 Latin-9 }
7304 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7305 { GBK CP936 MS936 windows-936 }
7306 { JIS_Encoding csJISEncoding }
7307 { Shift_JIS MS_Kanji csShiftJIS }
7308 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7310 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7311 { ISO-10646-UCS-Basic csUnicodeASCII }
7312 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7313 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7314 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7315 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7316 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7317 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7318 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7319 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7320 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7321 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7322 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7323 { Ventura-US csVenturaUS }
7324 { Ventura-International csVenturaInternational }
7325 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7326 { PC8-Turkish csPC8Turkish }
7327 { IBM-Symbols csIBMSymbols }
7328 { IBM-Thai csIBMThai }
7329 { HP-Legal csHPLegal }
7330 { HP-Pi-font csHPPiFont }
7331 { HP-Math8 csHPMath8 }
7332 { Adobe-Symbol-Encoding csHPPSMath }
7333 { HP-DeskTop csHPDesktop }
7334 { Ventura-Math csVenturaMath }
7335 { Microsoft-Publishing csMicrosoftPublishing }
7336 { Windows-31J csWindows31J }
7341 proc tcl_encoding {enc} {
7342 global encoding_aliases
7343 set names [encoding names]
7344 set lcnames [string tolower $names]
7345 set enc [string tolower $enc]
7346 set i [lsearch -exact $lcnames $enc]
7348 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7349 if {[regsub {^iso[-_]} $enc iso encx]} {
7350 set i [lsearch -exact $lcnames $encx]
7354 foreach l $encoding_aliases {
7355 set ll [string tolower $l]
7356 if {[lsearch -exact $ll $enc] < 0} continue
7357 # look through the aliases for one that tcl knows about
7359 set i [lsearch -exact $lcnames $e]
7361 if {[regsub {^iso[-_]} $e iso ex]} {
7362 set i [lsearch -exact $lcnames $ex]
7371 return [lindex $names $i]
7378 set diffopts "-U 5 -p"
7379 set wrcomcmd "git diff-tree --stdin -p --pretty"
7383 set gitencoding [exec git config --get i18n.commitencoding]
7385 if {$gitencoding == ""} {
7386 set gitencoding "utf-8"
7388 set tclencoding [tcl_encoding $gitencoding]
7389 if {$tclencoding == {}} {
7390 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7393 set mainfont {Helvetica 9}
7394 set textfont {Courier 9}
7395 set uifont {Helvetica 9 bold}
7397 set findmergefiles 0
7405 set cmitmode "patch"
7406 set wrapcomment "none"
7410 set showlocalchanges 1
7412 set colors {green red blue magenta darkgrey brown orange}
7415 set diffcolors {red "#00a000" blue}
7416 set selectbgcolor gray85
7418 catch {source ~/.gitk}
7420 font create optionfont -family sans-serif -size -12
7424 switch -regexp -- $arg {
7426 "^-d" { set datemode 1 }
7428 lappend revtreeargs $arg
7433 # check that we can find a .git directory somewhere...
7435 if {![file isdirectory $gitdir]} {
7436 show_error {} . "Cannot find the git directory \"$gitdir\"."
7440 set cmdline_files {}
7441 set i [lsearch -exact $revtreeargs "--"]
7443 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
7444 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
7445 } elseif {$revtreeargs ne {}} {
7447 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7448 set cmdline_files [split $f "\n"]
7449 set n [llength $cmdline_files]
7450 set revtreeargs [lrange $revtreeargs 0 end-$n]
7452 # unfortunately we get both stdout and stderr in $err,
7453 # so look for "fatal:".
7454 set i [string first "fatal:" $err]
7456 set err [string range $err [expr {$i + 6}] end]
7458 show_error {} . "Bad arguments to gitk:\n$err"
7463 set nullid "0000000000000000000000000000000000000000"
7470 set highlight_paths {}
7471 set searchdirn -forwards
7481 set selectedhlview None
7490 set lookingforhead 0
7495 wm title . "[file tail $argv0]: [file tail [pwd]]"
7498 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7499 # create a view for the files/dirs specified on the command line
7503 set viewname(1) "Command line"
7504 set viewfiles(1) $cmdline_files
7505 set viewargs(1) $revtreeargs
7508 .bar.view entryconf Edit* -state normal
7509 .bar.view entryconf Delete* -state normal
7512 if {[info exists permviews]} {
7513 foreach v $permviews {
7516 set viewname($n) [lindex $v 0]
7517 set viewfiles($n) [lindex $v 1]
7518 set viewargs($n) [lindex $v 2]