2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
56 set fd
[lindex
$runq 0 0]
57 set script [lindex
$runq 0 1]
58 set repeat
[eval $script]
59 set t1
[clock clicks
-milliseconds]
60 set t
[expr {$t1 - $t0}]
61 set runq
[lrange
$runq 1 end
]
62 if {$repeat ne
{} && $repeat} {
63 if {$fd eq
{} ||
$repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq
[list
$fd $script]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx
86 global lookingforhead showlocalchanges
88 set startmsecs
[clock clicks
-milliseconds]
89 set commitidx
($view) 0
90 set args
$viewargs($view)
91 if {$viewfiles($view) ne
{}} {
92 set args
[concat
$args "--" $viewfiles($view)]
94 set order
"--topo-order"
96 set order
"--date-order"
99 set fd
[open
[concat | git rev-list
--header $order \
100 --parents --boundary --default HEAD
$args] r
]
102 puts stderr
"Error executing git rev-list: $err"
105 set commfd
($view) $fd
106 set leftover
($view) {}
107 set lookingforhead
$showlocalchanges
108 fconfigure
$fd -blocking 0 -translation lf
109 if {$tclencoding != {}} {
110 fconfigure
$fd -encoding $tclencoding
112 filerun
$fd [list getcommitlines
$fd $view]
116 proc stop_rev_list
{} {
117 global commfd curview
119 if {![info exists commfd
($curview)]} return
120 set fd
$commfd($curview)
126 unset commfd
($curview)
130 global phase canv mainfont curview
134 start_rev_list
$curview
135 show_status
"Reading commits..."
138 proc getcommitlines
{fd view
} {
140 global leftover commfd
141 global displayorder commitidx commitrow commitdata
142 global parentlist children curview hlview
143 global vparentlist vdisporder vcmitlisted
145 set stuff
[read $fd 500000]
153 # set it blocking so we wait for the process to terminate
154 fconfigure
$fd -blocking 1
155 if {[catch
{close
$fd} err
]} {
157 if {$view != $curview} {
158 set fv
" for the \"$viewname($view)\" view"
160 if {[string range
$err 0 4] == "usage"} {
161 set err
"Gitk: error reading commits$fv:\
162 bad arguments to git rev-list."
163 if {$viewname($view) eq
"Command line"} {
165 " (Note: arguments to gitk are passed to git rev-list\
166 to allow selection of commits to be displayed.)"
169 set err
"Error reading commits$fv: $err"
173 if {$view == $curview} {
174 run chewcommits
$view
181 set i
[string first
"\0" $stuff $start]
183 append leftover
($view) [string range
$stuff $start end
]
187 set cmit
$leftover($view)
188 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
189 set leftover
($view) {}
191 set cmit
[string range
$stuff $start [expr {$i - 1}]]
193 set start
[expr {$i + 1}]
194 set j
[string first
"\n" $cmit]
198 set ids
[string range
$cmit 0 [expr {$j - 1}]]
199 if {[string range
$ids 0 0] == "-"} {
201 set ids
[string range
$ids 1 end
]
205 if {[string length
$id] != 40} {
213 if {[string length
$shortcmit] > 80} {
214 set shortcmit
"[string range $shortcmit 0 80]..."
216 error_popup
"Can't parse git rev-list output: {$shortcmit}"
219 set id
[lindex
$ids 0]
221 set olds
[lrange
$ids 1 end
]
224 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
225 lappend children
($view,$p) $id
232 if {![info exists children
($view,$id)]} {
233 set children
($view,$id) {}
235 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
236 set commitrow
($view,$id) $commitidx($view)
237 incr commitidx
($view)
238 if {$view == $curview} {
239 lappend parentlist
$olds
240 lappend displayorder
$id
241 lappend commitlisted
$listed
243 lappend vparentlist
($view) $olds
244 lappend vdisporder
($view) $id
245 lappend vcmitlisted
($view) $listed
250 run chewcommits
$view
255 proc chewcommits
{view
} {
256 global curview hlview commfd
257 global selectedline pending_select
260 if {$view == $curview} {
261 set allread
[expr {![info exists commfd
($view)]}]
262 set tlimit
[expr {[clock clicks
-milliseconds] + 50}]
263 set more [layoutmore
$tlimit $allread]
264 if {$allread && !$more} {
265 global displayorder nullid commitidx phase
266 global numcommits startmsecs
268 if {[info exists pending_select
]} {
269 set row
[expr {[lindex
$displayorder 0] eq
$nullid}]
272 if {$commitidx($curview) > 0} {
273 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
274 #puts "overall $ms ms for $numcommits commits"
276 show_status
"No commits selected"
282 if {[info exists hlview
] && $view == $hlview} {
288 proc readcommit
{id
} {
289 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
290 parsecommit
$id $contents 0
293 proc updatecommits
{} {
294 global viewdata curview phase displayorder
295 global children commitrow selectedline thickerline
302 foreach id
$displayorder {
303 catch
{unset children
($n,$id)}
304 catch
{unset commitrow
($n,$id)}
307 catch
{unset selectedline
}
308 catch
{unset thickerline
}
309 catch
{unset viewdata
($n)}
316 proc parsecommit
{id contents listed
} {
317 global commitinfo cdate
326 set hdrend
[string first
"\n\n" $contents]
328 # should never happen...
329 set hdrend
[string length
$contents]
331 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
332 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
333 foreach line
[split $header "\n"] {
334 set tag
[lindex
$line 0]
335 if {$tag == "author"} {
336 set audate
[lindex
$line end-1
]
337 set auname
[lrange
$line 1 end-2
]
338 } elseif
{$tag == "committer"} {
339 set comdate
[lindex
$line end-1
]
340 set comname
[lrange
$line 1 end-2
]
344 # take the first non-blank line of the comment as the headline
345 set headline
[string trimleft
$comment]
346 set i
[string first
"\n" $headline]
348 set headline
[string range
$headline 0 $i]
350 set headline
[string trimright
$headline]
351 set i
[string first
"\r" $headline]
353 set headline
[string trimright
[string range
$headline 0 $i]]
356 # git rev-list indents the comment by 4 spaces;
357 # if we got this via git cat-file, add the indentation
359 foreach line
[split $comment "\n"] {
360 append newcomment
" "
361 append newcomment
$line
362 append newcomment
"\n"
364 set comment
$newcomment
366 if {$comdate != {}} {
367 set cdate
($id) $comdate
369 set commitinfo
($id) [list
$headline $auname $audate \
370 $comname $comdate $comment]
373 proc getcommit
{id
} {
374 global commitdata commitinfo
376 if {[info exists commitdata
($id)]} {
377 parsecommit
$id $commitdata($id) 1
380 if {![info exists commitinfo
($id)]} {
381 set commitinfo
($id) {"No commit information available"}
388 global tagids idtags headids idheads tagobjid
389 global otherrefids idotherrefs mainhead mainheadid
391 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
394 set refd
[open
[list | git show-ref
-d] r
]
395 while {[gets
$refd line
] >= 0} {
396 if {[string index
$line 40] ne
" "} continue
397 set id
[string range
$line 0 39]
398 set ref
[string range
$line 41 end
]
399 if {![string match
"refs/*" $ref]} continue
400 set name
[string range
$ref 5 end
]
401 if {[string match
"remotes/*" $name]} {
402 if {![string match
"*/HEAD" $name]} {
403 set headids
($name) $id
404 lappend idheads
($id) $name
406 } elseif
{[string match
"heads/*" $name]} {
407 set name
[string range
$name 6 end
]
408 set headids
($name) $id
409 lappend idheads
($id) $name
410 } elseif
{[string match
"tags/*" $name]} {
411 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
412 # which is what we want since the former is the commit ID
413 set name
[string range
$name 5 end
]
414 if {[string match
"*^{}" $name]} {
415 set name
[string range
$name 0 end-3
]
417 set tagobjid
($name) $id
419 set tagids
($name) $id
420 lappend idtags
($id) $name
422 set otherrefids
($name) $id
423 lappend idotherrefs
($id) $name
430 set thehead
[exec git symbolic-ref HEAD
]
431 if {[string match
"refs/heads/*" $thehead]} {
432 set mainhead
[string range
$thehead 11 end
]
433 if {[info exists headids
($mainhead)]} {
434 set mainheadid
$headids($mainhead)
440 # update things for a head moved to a child of its previous location
441 proc movehead
{id name
} {
442 global headids idheads
444 removehead
$headids($name) $name
445 set headids
($name) $id
446 lappend idheads
($id) $name
449 # update things when a head has been removed
450 proc removehead
{id name
} {
451 global headids idheads
453 if {$idheads($id) eq
$name} {
456 set i
[lsearch
-exact $idheads($id) $name]
458 set idheads
($id) [lreplace
$idheads($id) $i $i]
464 proc show_error
{w top msg
} {
465 message
$w.m
-text $msg -justify center
-aspect 400
466 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
467 button
$w.ok
-text OK
-command "destroy $top"
468 pack
$w.ok
-side bottom
-fill x
469 bind $top <Visibility
> "grab $top; focus $top"
470 bind $top <Key-Return
> "destroy $top"
474 proc error_popup msg
{
478 show_error
$w $w $msg
481 proc confirm_popup msg
{
487 message
$w.m
-text $msg -justify center
-aspect 400
488 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
489 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
490 pack
$w.ok
-side left
-fill x
491 button
$w.cancel
-text Cancel
-command "destroy $w"
492 pack
$w.cancel
-side right
-fill x
493 bind $w <Visibility
> "grab $w; focus $w"
499 global canv canv2 canv3 linespc charspc ctext cflist
500 global textfont mainfont uifont tabstop
501 global findtype findtypemenu findloc findstring fstring geometry
502 global entries sha1entry sha1string sha1but
503 global maincursor textcursor curtextcursor
504 global rowctxmenu fakerowmenu mergemax wrapcomment
505 global highlight_files gdttype
506 global searchstring sstring
507 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
511 .bar add cascade
-label "File" -menu .bar.
file
512 .bar configure
-font $uifont
514 .bar.
file add
command -label "Update" -command updatecommits
515 .bar.
file add
command -label "Reread references" -command rereadrefs
516 .bar.
file add
command -label "Quit" -command doquit
517 .bar.
file configure
-font $uifont
519 .bar add cascade
-label "Edit" -menu .bar.edit
520 .bar.edit add
command -label "Preferences" -command doprefs
521 .bar.edit configure
-font $uifont
523 menu .bar.view
-font $uifont
524 .bar add cascade
-label "View" -menu .bar.view
525 .bar.view add
command -label "New view..." -command {newview
0}
526 .bar.view add
command -label "Edit view..." -command editview \
528 .bar.view add
command -label "Delete view" -command delview
-state disabled
529 .bar.view add separator
530 .bar.view add radiobutton
-label "All files" -command {showview
0} \
531 -variable selectedview
-value 0
534 .bar add cascade
-label "Help" -menu .bar.
help
535 .bar.
help add
command -label "About gitk" -command about
536 .bar.
help add
command -label "Key bindings" -command keys
537 .bar.
help configure
-font $uifont
538 . configure
-menu .bar
540 # the gui has upper and lower half, parts of a paned window.
541 panedwindow .ctop
-orient vertical
543 # possibly use assumed geometry
544 if {![info exists geometry
(pwsash0
)]} {
545 set geometry
(topheight
) [expr {15 * $linespc}]
546 set geometry
(topwidth
) [expr {80 * $charspc}]
547 set geometry
(botheight
) [expr {15 * $linespc}]
548 set geometry
(botwidth
) [expr {50 * $charspc}]
549 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
550 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
553 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
554 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
556 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
558 # create three canvases
559 set cscroll .tf.histframe.csb
560 set canv .tf.histframe.pwclist.canv
562 -selectbackground $selectbgcolor \
563 -background $bgcolor -bd 0 \
564 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
565 .tf.histframe.pwclist add
$canv
566 set canv2 .tf.histframe.pwclist.canv2
568 -selectbackground $selectbgcolor \
569 -background $bgcolor -bd 0 -yscrollincr $linespc
570 .tf.histframe.pwclist add
$canv2
571 set canv3 .tf.histframe.pwclist.canv3
573 -selectbackground $selectbgcolor \
574 -background $bgcolor -bd 0 -yscrollincr $linespc
575 .tf.histframe.pwclist add
$canv3
576 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
577 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
579 # a scroll bar to rule them
580 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
581 pack
$cscroll -side right
-fill y
582 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
583 lappend bglist
$canv $canv2 $canv3
584 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
586 # we have two button bars at bottom of top frame. Bar 1
588 frame .tf.lbar
-height 15
590 set sha1entry .tf.bar.sha1
591 set entries
$sha1entry
592 set sha1but .tf.bar.sha1label
593 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
594 -command gotocommit
-width 8 -font $uifont
595 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
596 pack .tf.bar.sha1label
-side left
597 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
598 trace add variable sha1string
write sha1change
599 pack
$sha1entry -side left
-pady 2
601 image create bitmap bm-left
-data {
602 #define left_width 16
603 #define left_height 16
604 static unsigned char left_bits
[] = {
605 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
606 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
607 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
609 image create bitmap bm-right
-data {
610 #define right_width 16
611 #define right_height 16
612 static unsigned char right_bits
[] = {
613 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
614 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
615 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
617 button .tf.bar.leftbut
-image bm-left
-command goback \
618 -state disabled
-width 26
619 pack .tf.bar.leftbut
-side left
-fill y
620 button .tf.bar.rightbut
-image bm-right
-command goforw \
621 -state disabled
-width 26
622 pack .tf.bar.rightbut
-side left
-fill y
624 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
625 pack .tf.bar.findbut
-side left
627 set fstring .tf.bar.findstring
628 lappend entries
$fstring
629 entry
$fstring -width 30 -font $textfont -textvariable findstring
630 trace add variable findstring
write find_change
631 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
633 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
634 findtype Exact IgnCase Regexp
]
635 trace add variable findtype
write find_change
636 .tf.bar.findtype configure
-font $uifont
637 .tf.bar.findtype.menu configure
-font $uifont
638 set findloc
"All fields"
639 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
640 Comments Author Committer
641 trace add variable findloc
write find_change
642 .tf.bar.findloc configure
-font $uifont
643 .tf.bar.findloc.menu configure
-font $uifont
644 pack .tf.bar.findloc
-side right
645 pack .tf.bar.findtype
-side right
647 # build up the bottom bar of upper window
648 label .tf.lbar.flabel
-text "Highlight: Commits " \
650 pack .tf.lbar.flabel
-side left
-fill y
651 set gdttype
"touching paths:"
652 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
653 "adding/removing string:"]
654 trace add variable gdttype
write hfiles_change
655 $gm conf
-font $uifont
656 .tf.lbar.gdttype conf
-font $uifont
657 pack .tf.lbar.gdttype
-side left
-fill y
658 entry .tf.lbar.fent
-width 25 -font $textfont \
659 -textvariable highlight_files
660 trace add variable highlight_files
write hfiles_change
661 lappend entries .tf.lbar.fent
662 pack .tf.lbar.fent
-side left
-fill x
-expand 1
663 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
664 pack .tf.lbar.vlabel
-side left
-fill y
665 global viewhlmenu selectedhlview
666 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
667 $viewhlmenu entryconf None
-command delvhighlight
668 $viewhlmenu conf
-font $uifont
669 .tf.lbar.vhl conf
-font $uifont
670 pack .tf.lbar.vhl
-side left
-fill y
671 label .tf.lbar.rlabel
-text " OR " -font $uifont
672 pack .tf.lbar.rlabel
-side left
-fill y
673 global highlight_related
674 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
675 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
676 $m conf
-font $uifont
677 .tf.lbar.relm conf
-font $uifont
678 trace add variable highlight_related
write vrel_change
679 pack .tf.lbar.relm
-side left
-fill y
681 # Finish putting the upper half of the viewer together
682 pack .tf.lbar
-in .tf
-side bottom
-fill x
683 pack .tf.bar
-in .tf
-side bottom
-fill x
684 pack .tf.histframe
-fill both
-side top
-expand 1
686 .ctop paneconfigure .tf
-height $geometry(topheight
)
687 .ctop paneconfigure .tf
-width $geometry(topwidth
)
689 # now build up the bottom
690 panedwindow .pwbottom
-orient horizontal
692 # lower left, a text box over search bar, scroll bar to the right
693 # if we know window height, then that will set the lower text height, otherwise
694 # we set lower text height which will drive window height
695 if {[info exists geometry
(main
)]} {
696 frame .bleft
-width $geometry(botwidth
)
698 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
703 button .bleft.top.search
-text "Search" -command dosearch \
705 pack .bleft.top.search
-side left
-padx 5
706 set sstring .bleft.top.sstring
707 entry
$sstring -width 20 -font $textfont -textvariable searchstring
708 lappend entries
$sstring
709 trace add variable searchstring
write incrsearch
710 pack
$sstring -side left
-expand 1 -fill x
711 radiobutton .bleft.mid.
diff -text "Diff" \
712 -command changediffdisp
-variable diffelide
-value {0 0}
713 radiobutton .bleft.mid.old
-text "Old version" \
714 -command changediffdisp
-variable diffelide
-value {0 1}
715 radiobutton .bleft.mid.new
-text "New version" \
716 -command changediffdisp
-variable diffelide
-value {1 0}
717 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
718 set ctext .bleft.ctext
719 text
$ctext -background $bgcolor -foreground $fgcolor \
720 -tabs "[expr {$tabstop * $charspc}]" \
721 -state disabled
-font $textfont \
722 -yscrollcommand scrolltext
-wrap none
723 scrollbar .bleft.sb
-command "$ctext yview"
724 pack .bleft.top
-side top
-fill x
725 pack .bleft.mid
-side top
-fill x
726 pack .bleft.sb
-side right
-fill y
727 pack
$ctext -side left
-fill both
-expand 1
728 lappend bglist
$ctext
729 lappend fglist
$ctext
731 $ctext tag conf comment
-wrap $wrapcomment
732 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
733 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
734 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
735 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
736 $ctext tag conf m0
-fore red
737 $ctext tag conf m1
-fore blue
738 $ctext tag conf m2
-fore green
739 $ctext tag conf m3
-fore purple
740 $ctext tag conf
m4 -fore brown
741 $ctext tag conf m5
-fore "#009090"
742 $ctext tag conf m6
-fore magenta
743 $ctext tag conf m7
-fore "#808000"
744 $ctext tag conf m8
-fore "#009000"
745 $ctext tag conf m9
-fore "#ff0080"
746 $ctext tag conf m10
-fore cyan
747 $ctext tag conf m11
-fore "#b07070"
748 $ctext tag conf m12
-fore "#70b0f0"
749 $ctext tag conf m13
-fore "#70f0b0"
750 $ctext tag conf m14
-fore "#f0b070"
751 $ctext tag conf m15
-fore "#ff70b0"
752 $ctext tag conf mmax
-fore darkgrey
754 $ctext tag conf mresult
-font [concat
$textfont bold
]
755 $ctext tag conf msep
-font [concat
$textfont bold
]
756 $ctext tag conf found
-back yellow
759 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
764 radiobutton .bright.mode.
patch -text "Patch" \
765 -command reselectline
-variable cmitmode
-value "patch"
766 .bright.mode.
patch configure
-font $uifont
767 radiobutton .bright.mode.tree
-text "Tree" \
768 -command reselectline
-variable cmitmode
-value "tree"
769 .bright.mode.tree configure
-font $uifont
770 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
771 pack .bright.mode
-side top
-fill x
772 set cflist .bright.cfiles
773 set indent
[font measure
$mainfont "nn"]
775 -selectbackground $selectbgcolor \
776 -background $bgcolor -foreground $fgcolor \
778 -tabs [list
$indent [expr {2 * $indent}]] \
779 -yscrollcommand ".bright.sb set" \
780 -cursor [. cget
-cursor] \
781 -spacing1 1 -spacing3 1
782 lappend bglist
$cflist
783 lappend fglist
$cflist
784 scrollbar .bright.sb
-command "$cflist yview"
785 pack .bright.sb
-side right
-fill y
786 pack
$cflist -side left
-fill both
-expand 1
787 $cflist tag configure highlight \
788 -background [$cflist cget
-selectbackground]
789 $cflist tag configure bold
-font [concat
$mainfont bold
]
791 .pwbottom add .bright
794 # restore window position if known
795 if {[info exists geometry
(main
)]} {
796 wm geometry .
"$geometry(main)"
799 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
800 pack .ctop
-fill both
-expand 1
801 bindall
<1> {selcanvline
%W
%x
%y
}
802 #bindall <B1-Motion> {selcanvline %W %x %y}
803 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
804 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
805 bindall
<2> "canvscan mark %W %x %y"
806 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
807 bindkey
<Home
> selfirstline
808 bindkey
<End
> sellastline
809 bind .
<Key-Up
> "selnextline -1"
810 bind .
<Key-Down
> "selnextline 1"
811 bind .
<Shift-Key-Up
> "next_highlight -1"
812 bind .
<Shift-Key-Down
> "next_highlight 1"
813 bindkey
<Key-Right
> "goforw"
814 bindkey
<Key-Left
> "goback"
815 bind .
<Key-Prior
> "selnextpage -1"
816 bind .
<Key-Next
> "selnextpage 1"
817 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
818 bind .
<Control-End
> "allcanvs yview moveto 1.0"
819 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
820 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
821 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
822 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
823 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
824 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
825 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
826 bindkey p
"selnextline -1"
827 bindkey n
"selnextline 1"
830 bindkey i
"selnextline -1"
831 bindkey k
"selnextline 1"
834 bindkey b
"$ctext yview scroll -1 pages"
835 bindkey d
"$ctext yview scroll 18 units"
836 bindkey u
"$ctext yview scroll -18 units"
837 bindkey
/ {findnext
1}
838 bindkey
<Key-Return
> {findnext
0}
841 bindkey
<F5
> updatecommits
842 bind .
<Control-q
> doquit
843 bind .
<Control-f
> dofind
844 bind .
<Control-g
> {findnext
0}
845 bind .
<Control-r
> dosearchback
846 bind .
<Control-s
> dosearch
847 bind .
<Control-equal
> {incrfont
1}
848 bind .
<Control-KP_Add
> {incrfont
1}
849 bind .
<Control-minus
> {incrfont
-1}
850 bind .
<Control-KP_Subtract
> {incrfont
-1}
851 wm protocol . WM_DELETE_WINDOW doquit
852 bind .
<Button-1
> "click %W"
853 bind $fstring <Key-Return
> dofind
854 bind $sha1entry <Key-Return
> gotocommit
855 bind $sha1entry <<PasteSelection>> clearsha1
856 bind $cflist <1> {sel_flist %W %x %y; break}
857 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
858 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
860 set maincursor [. cget -cursor]
861 set textcursor [$ctext cget -cursor]
862 set curtextcursor $textcursor
864 set rowctxmenu .rowctxmenu
865 menu $rowctxmenu -tearoff 0
866 $rowctxmenu add command -label "Diff this -> selected" \
867 -command {diffvssel 0}
868 $rowctxmenu add command -label "Diff selected -> this" \
869 -command {diffvssel 1}
870 $rowctxmenu add command -label "Make patch" -command mkpatch
871 $rowctxmenu add command -label "Create tag" -command mktag
872 $rowctxmenu add command -label "Write commit to file" -command writecommit
873 $rowctxmenu add command -label "Create new branch" -command mkbranch
874 $rowctxmenu add command -label "Cherry-pick this commit" \
876 $rowctxmenu add command -label "Reset HEAD branch to here" \
879 set fakerowmenu .fakerowmenu
880 menu $fakerowmenu -tearoff 0
881 $fakerowmenu add command -label "Diff this -> selected" \
882 -command {diffvssel 0}
883 $fakerowmenu add command -label "Diff selected -> this" \
884 -command {diffvssel 1}
885 $fakerowmenu add command -label "Make patch" -command mkpatch
886 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
887 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
888 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
890 set headctxmenu .headctxmenu
891 menu $headctxmenu -tearoff 0
892 $headctxmenu add command -label "Check out this branch" \
894 $headctxmenu add command -label "Remove this branch" \
898 # mouse-2 makes all windows scan vertically, but only the one
899 # the cursor is in scans horizontally
900 proc canvscan {op w x y} {
901 global canv canv2 canv3
902 foreach c [list $canv $canv2 $canv3] {
911 proc scrollcanv {cscroll f0 f1} {
917 # when we make a key binding for the toplevel, make sure
918 # it doesn't get triggered when that key is pressed in the
919 # find string entry widget.
920 proc bindkey {ev script} {
923 set escript [bind Entry $ev]
924 if {$escript == {}} {
925 set escript [bind Entry <Key>]
928 bind $e $ev "$escript; break"
932 # set the focus back to the toplevel for any click outside
943 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
944 global stuffsaved findmergefiles maxgraphpct
945 global maxwidth showneartags showlocalchanges
946 global viewname viewfiles viewargs viewperm nextviewnum
947 global cmitmode wrapcomment
948 global colors bgcolor fgcolor diffcolors selectbgcolor
950 if {$stuffsaved} return
951 if {![winfo viewable .]} return
953 set f [open "~/.gitk-new" w]
954 puts $f [list set mainfont $mainfont]
955 puts $f [list set textfont $textfont]
956 puts $f [list set uifont $uifont]
957 puts $f [list set tabstop $tabstop]
958 puts $f [list set findmergefiles $findmergefiles]
959 puts $f [list set maxgraphpct $maxgraphpct]
960 puts $f [list set maxwidth $maxwidth]
961 puts $f [list set cmitmode $cmitmode]
962 puts $f [list set wrapcomment $wrapcomment]
963 puts $f [list set showneartags $showneartags]
964 puts $f [list set showlocalchanges $showlocalchanges]
965 puts $f [list set bgcolor $bgcolor]
966 puts $f [list set fgcolor $fgcolor]
967 puts $f [list set colors $colors]
968 puts $f [list set diffcolors $diffcolors]
969 puts $f [list set selectbgcolor $selectbgcolor]
971 puts $f "set geometry(main) [wm geometry .]"
972 puts $f "set geometry(topwidth) [winfo width .tf]"
973 puts $f "set geometry(topheight) [winfo height .tf]"
974 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
975 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
976 puts $f "set geometry(botwidth) [winfo width .bleft]"
977 puts $f "set geometry(botheight) [winfo height .bleft]"
979 puts -nonewline $f "set permviews {"
980 for {set v 0} {$v < $nextviewnum} {incr v} {
982 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
987 file rename -force "~/.gitk-new" "~/.gitk"
992 proc resizeclistpanes {win w} {
994 if {[info exists oldwidth($win)]} {
995 set s0 [$win sash coord 0]
996 set s1 [$win sash coord 1]
998 set sash0 [expr {int($w/2 - 2)}]
999 set sash1 [expr {int($w*5/6 - 2)}]
1001 set factor [expr {1.0 * $w / $oldwidth($win)}]
1002 set sash0 [expr {int($factor * [lindex $s0 0])}]
1003 set sash1 [expr {int($factor * [lindex $s1 0])}]
1007 if {$sash1 < $sash0 + 20} {
1008 set sash1 [expr {$sash0 + 20}]
1010 if {$sash1 > $w - 10} {
1011 set sash1 [expr {$w - 10}]
1012 if {$sash0 > $sash1 - 20} {
1013 set sash0 [expr {$sash1 - 20}]
1017 $win sash place 0 $sash0 [lindex $s0 1]
1018 $win sash place 1 $sash1 [lindex $s1 1]
1020 set oldwidth($win) $w
1023 proc resizecdetpanes {win w} {
1025 if {[info exists oldwidth($win)]} {
1026 set s0 [$win sash coord 0]
1028 set sash0 [expr {int($w*3/4 - 2)}]
1030 set factor [expr {1.0 * $w / $oldwidth($win)}]
1031 set sash0 [expr {int($factor * [lindex $s0 0])}]
1035 if {$sash0 > $w - 15} {
1036 set sash0 [expr {$w - 15}]
1039 $win sash place 0 $sash0 [lindex $s0 1]
1041 set oldwidth($win) $w
1044 proc allcanvs args {
1045 global canv canv2 canv3
1051 proc bindall {event action} {
1052 global canv canv2 canv3
1053 bind $canv $event $action
1054 bind $canv2 $event $action
1055 bind $canv3 $event $action
1061 if {[winfo exists $w]} {
1066 wm title $w "About gitk"
1067 message $w.m -text {
1068 Gitk - a commit viewer for git
1070 Copyright © 2005-2006 Paul Mackerras
1072 Use and redistribute under the terms of the GNU General Public License} \
1073 -justify center -aspect 400 -border 2 -bg white -relief groove
1074 pack $w.m -side top -fill x -padx 2 -pady 2
1075 $w.m configure -font $uifont
1076 button $w.ok -text Close -command "destroy $w" -default active
1077 pack $w.ok -side bottom
1078 $w.ok configure -font $uifont
1079 bind $w <Visibility> "focus $w.ok"
1080 bind $w <Key-Escape> "destroy $w"
1081 bind $w <Key-Return> "destroy $w"
1087 if {[winfo exists $w]} {
1092 wm title $w "Gitk key bindings"
1093 message $w.m -text {
1097 <Home> Move to first commit
1098 <End> Move to last commit
1099 <Up>, p, i Move up one commit
1100 <Down>, n, k Move down one commit
1101 <Left>, z, j Go back in history list
1102 <Right>, x, l Go forward in history list
1103 <PageUp> Move up one page in commit list
1104 <PageDown> Move down one page in commit list
1105 <Ctrl-Home> Scroll to top of commit list
1106 <Ctrl-End> Scroll to bottom of commit list
1107 <Ctrl-Up> Scroll commit list up one line
1108 <Ctrl-Down> Scroll commit list down one line
1109 <Ctrl-PageUp> Scroll commit list up one page
1110 <Ctrl-PageDown> Scroll commit list down one page
1111 <Shift-Up> Move to previous highlighted line
1112 <Shift-Down> Move to next highlighted line
1113 <Delete>, b Scroll diff view up one page
1114 <Backspace> Scroll diff view up one page
1115 <Space> Scroll diff view down one page
1116 u Scroll diff view up 18 lines
1117 d Scroll diff view down 18 lines
1119 <Ctrl-G> Move to next find hit
1120 <Return> Move to next find hit
1121 / Move to next find hit, or redo find
1122 ? Move to previous find hit
1123 f Scroll diff view to next file
1124 <Ctrl-S> Search for next hit in diff view
1125 <Ctrl-R> Search for previous hit in diff view
1126 <Ctrl-KP+> Increase font size
1127 <Ctrl-plus> Increase font size
1128 <Ctrl-KP-> Decrease font size
1129 <Ctrl-minus> Decrease font size
1132 -justify left -bg white -border 2 -relief groove
1133 pack $w.m -side top -fill both -padx 2 -pady 2
1134 $w.m configure -font $uifont
1135 button $w.ok -text Close -command "destroy $w" -default active
1136 pack $w.ok -side bottom
1137 $w.ok configure -font $uifont
1138 bind $w <Visibility> "focus $w.ok"
1139 bind $w <Key-Escape> "destroy $w"
1140 bind $w <Key-Return> "destroy $w"
1143 # Procedures for manipulating the file list window at the
1144 # bottom right of the overall window.
1146 proc treeview {w l openlevs} {
1147 global treecontents treediropen treeheight treeparent treeindex
1157 set treecontents() {}
1158 $w conf -state normal
1160 while {[string range $f 0 $prefixend] ne $prefix} {
1161 if {$lev <= $openlevs} {
1162 $w mark set e:$treeindex($prefix) "end -1c"
1163 $w mark gravity e:$treeindex($prefix) left
1165 set treeheight($prefix) $ht
1166 incr ht [lindex $htstack end]
1167 set htstack [lreplace $htstack end end]
1168 set prefixend [lindex $prefendstack end]
1169 set prefendstack [lreplace $prefendstack end end]
1170 set prefix [string range $prefix 0 $prefixend]
1173 set tail [string range $f [expr {$prefixend+1}] end]
1174 while {[set slash [string first "/" $tail]] >= 0} {
1177 lappend prefendstack $prefixend
1178 incr prefixend [expr {$slash + 1}]
1179 set d [string range $tail 0 $slash]
1180 lappend treecontents($prefix) $d
1181 set oldprefix $prefix
1183 set treecontents($prefix) {}
1184 set treeindex($prefix) [incr ix]
1185 set treeparent($prefix) $oldprefix
1186 set tail [string range $tail [expr {$slash+1}] end]
1187 if {$lev <= $openlevs} {
1189 set treediropen($prefix) [expr {$lev < $openlevs}]
1190 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1191 $w mark set d:$ix "end -1c"
1192 $w mark gravity d:$ix left
1194 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1196 $w image create end -align center -image $bm -padx 1 \
1198 $w insert end $d [highlight_tag $prefix]
1199 $w mark set s:$ix "end -1c"
1200 $w mark gravity s:$ix left
1205 if {$lev <= $openlevs} {
1208 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1210 $w insert end $tail [highlight_tag $f]
1212 lappend treecontents($prefix) $tail
1215 while {$htstack ne {}} {
1216 set treeheight($prefix) $ht
1217 incr ht [lindex $htstack end]
1218 set htstack [lreplace $htstack end end]
1220 $w conf -state disabled
1223 proc linetoelt {l} {
1224 global treeheight treecontents
1229 foreach e $treecontents($prefix) {
1234 if {[string index $e end] eq "/"} {
1235 set n $treeheight($prefix$e)
1247 proc highlight_tree {y prefix} {
1248 global treeheight treecontents cflist
1250 foreach e $treecontents($prefix) {
1252 if {[highlight_tag $path] ne {}} {
1253 $cflist tag add bold $y.0 "$y.0 lineend"
1256 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1257 set y [highlight_tree $y $path]
1263 proc treeclosedir {w dir} {
1264 global treediropen treeheight treeparent treeindex
1266 set ix $treeindex($dir)
1267 $w conf -state normal
1268 $w delete s:$ix e:$ix
1269 set treediropen($dir) 0
1270 $w image configure a:$ix -image tri-rt
1271 $w conf -state disabled
1272 set n [expr {1 - $treeheight($dir)}]
1273 while {$dir ne {}} {
1274 incr treeheight($dir) $n
1275 set dir $treeparent($dir)
1279 proc treeopendir {w dir} {
1280 global treediropen treeheight treeparent treecontents treeindex
1282 set ix $treeindex($dir)
1283 $w conf -state normal
1284 $w image configure a:$ix -image tri-dn
1285 $w mark set e:$ix s:$ix
1286 $w mark gravity e:$ix right
1289 set n [llength $treecontents($dir)]
1290 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1293 incr treeheight($x) $n
1295 foreach e $treecontents($dir) {
1297 if {[string index $e end] eq "/"} {
1298 set iy $treeindex($de)
1299 $w mark set d:$iy e:$ix
1300 $w mark gravity d:$iy left
1301 $w insert e:$ix $str
1302 set treediropen($de) 0
1303 $w image create e:$ix -align center -image tri-rt -padx 1 \
1305 $w insert e:$ix $e [highlight_tag $de]
1306 $w mark set s:$iy e:$ix
1307 $w mark gravity s:$iy left
1308 set treeheight($de) 1
1310 $w insert e:$ix $str
1311 $w insert e:$ix $e [highlight_tag $de]
1314 $w mark gravity e:$ix left
1315 $w conf -state disabled
1316 set treediropen($dir) 1
1317 set top [lindex [split [$w index @0,0] .] 0]
1318 set ht [$w cget -height]
1319 set l [lindex [split [$w index s:$ix] .] 0]
1322 } elseif {$l + $n + 1 > $top + $ht} {
1323 set top [expr {$l + $n + 2 - $ht}]
1331 proc treeclick {w x y} {
1332 global treediropen cmitmode ctext cflist cflist_top
1334 if {$cmitmode ne "tree"} return
1335 if {![info exists cflist_top]} return
1336 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1337 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1338 $cflist tag add highlight $l.0 "$l.0 lineend"
1344 set e [linetoelt $l]
1345 if {[string index $e end] ne "/"} {
1347 } elseif {$treediropen($e)} {
1354 proc setfilelist {id} {
1355 global treefilelist cflist
1357 treeview $cflist $treefilelist($id) 0
1360 image create bitmap tri-rt -background black -foreground blue -data {
1361 #define tri-rt_width 13
1362 #define tri-rt_height 13
1363 static unsigned char tri-rt_bits[] = {
1364 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1365 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1368 #define tri-rt-mask_width 13
1369 #define tri-rt-mask_height 13
1370 static unsigned char tri-rt-mask_bits[] = {
1371 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1372 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1375 image create bitmap tri-dn -background black -foreground blue -data {
1376 #define tri-dn_width 13
1377 #define tri-dn_height 13
1378 static unsigned char tri-dn_bits[] = {
1379 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1380 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1383 #define tri-dn-mask_width 13
1384 #define tri-dn-mask_height 13
1385 static unsigned char tri-dn-mask_bits[] = {
1386 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1387 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1391 proc init_flist {first} {
1392 global cflist cflist_top selectedline difffilestart
1394 $cflist conf -state normal
1395 $cflist delete 0.0 end
1397 $cflist insert end $first
1399 $cflist tag add highlight 1.0 "1.0 lineend"
1401 catch {unset cflist_top}
1403 $cflist conf -state disabled
1404 set difffilestart {}
1407 proc highlight_tag {f} {
1408 global highlight_paths
1410 foreach p $highlight_paths {
1411 if {[string match $p $f]} {
1418 proc highlight_filelist {} {
1419 global cmitmode cflist
1421 $cflist conf -state normal
1422 if {$cmitmode ne "tree"} {
1423 set end [lindex [split [$cflist index end] .] 0]
1424 for {set l 2} {$l < $end} {incr l} {
1425 set line [$cflist get $l.0 "$l.0 lineend"]
1426 if {[highlight_tag $line] ne {}} {
1427 $cflist tag add bold $l.0 "$l.0 lineend"
1433 $cflist conf -state disabled
1436 proc unhighlight_filelist {} {
1439 $cflist conf -state normal
1440 $cflist tag remove bold 1.0 end
1441 $cflist conf -state disabled
1444 proc add_flist {fl} {
1447 $cflist conf -state normal
1449 $cflist insert end "\n"
1450 $cflist insert end $f [highlight_tag $f]
1452 $cflist conf -state disabled
1455 proc sel_flist {w x y} {
1456 global ctext difffilestart cflist cflist_top cmitmode
1458 if {$cmitmode eq "tree"} return
1459 if {![info exists cflist_top]} return
1460 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1461 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1462 $cflist tag add highlight $l.0 "$l.0 lineend"
1467 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1471 # Functions for adding and removing shell-type quoting
1473 proc shellquote {str} {
1474 if {![string match "*\['\"\\ \t]*" $str]} {
1477 if {![string match "*\['\"\\]*" $str]} {
1480 if {![string match "*'*" $str]} {
1483 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1486 proc shellarglist {l} {
1492 append str [shellquote $a]
1497 proc shelldequote {str} {
1502 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1503 append ret [string range $str $used end]
1504 set used [string length $str]
1507 set first [lindex $first 0]
1508 set ch [string index $str $first]
1509 if {$first > $used} {
1510 append ret [string range $str $used [expr {$first - 1}]]
1513 if {$ch eq " " || $ch eq "\t"} break
1516 set first [string first "'" $str $used]
1518 error "unmatched single-quote"
1520 append ret [string range $str $used [expr {$first - 1}]]
1525 if {$used >= [string length $str]} {
1526 error "trailing backslash"
1528 append ret [string index $str $used]
1533 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1534 error "unmatched double-quote"
1536 set first [lindex $first 0]
1537 set ch [string index $str $first]
1538 if {$first > $used} {
1539 append ret [string range $str $used [expr {$first - 1}]]
1542 if {$ch eq "\""} break
1544 append ret [string index $str $used]
1548 return [list $used $ret]
1551 proc shellsplit {str} {
1554 set str [string trimleft $str]
1555 if {$str eq {}} break
1556 set dq [shelldequote $str]
1557 set n [lindex $dq 0]
1558 set word [lindex $dq 1]
1559 set str [string range $str $n end]
1565 # Code to implement multiple views
1567 proc newview {ishighlight} {
1568 global nextviewnum newviewname newviewperm uifont newishighlight
1569 global newviewargs revtreeargs
1571 set newishighlight $ishighlight
1573 if {[winfo exists $top]} {
1577 set newviewname($nextviewnum) "View $nextviewnum"
1578 set newviewperm($nextviewnum) 0
1579 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1580 vieweditor $top $nextviewnum "Gitk view definition"
1585 global viewname viewperm newviewname newviewperm
1586 global viewargs newviewargs
1588 set top .gitkvedit-$curview
1589 if {[winfo exists $top]} {
1593 set newviewname($curview) $viewname($curview)
1594 set newviewperm($curview) $viewperm($curview)
1595 set newviewargs($curview) [shellarglist $viewargs($curview)]
1596 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1599 proc vieweditor {top n title} {
1600 global newviewname newviewperm viewfiles
1604 wm title $top $title
1605 label $top.nl -text "Name" -font $uifont
1606 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1607 grid $top.nl $top.name -sticky w -pady 5
1608 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1610 grid $top.perm - -pady 5 -sticky w
1611 message $top.al -aspect 1000 -font $uifont \
1612 -text "Commits to include (arguments to git rev-list):"
1613 grid $top.al - -sticky w -pady 5
1614 entry $top.args -width 50 -textvariable newviewargs($n) \
1615 -background white -font $uifont
1616 grid $top.args - -sticky ew -padx 5
1617 message $top.l -aspect 1000 -font $uifont \
1618 -text "Enter files and directories to include, one per line:"
1619 grid $top.l - -sticky w
1620 text $top.t -width 40 -height 10 -background white -font $uifont
1621 if {[info exists viewfiles($n)]} {
1622 foreach f $viewfiles($n) {
1623 $top.t insert end $f
1624 $top.t insert end "\n"
1626 $top.t delete {end - 1c} end
1627 $top.t mark set insert 0.0
1629 grid $top.t - -sticky ew -padx 5
1631 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1633 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1635 grid $top.buts.ok $top.buts.can
1636 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1637 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1638 grid $top.buts - -pady 10 -sticky ew
1642 proc doviewmenu {m first cmd op argv} {
1643 set nmenu [$m index end]
1644 for {set i $first} {$i <= $nmenu} {incr i} {
1645 if {[$m entrycget $i -command] eq $cmd} {
1646 eval $m $op $i $argv
1652 proc allviewmenus {n op args} {
1655 doviewmenu .bar.view 5 [list showview $n] $op $args
1656 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1659 proc newviewok {top n} {
1660 global nextviewnum newviewperm newviewname newishighlight
1661 global viewname viewfiles viewperm selectedview curview
1662 global viewargs newviewargs viewhlmenu
1665 set newargs [shellsplit $newviewargs($n)]
1667 error_popup "Error in commit selection arguments: $err"
1673 foreach f [split [$top.t get 0.0 end] "\n"] {
1674 set ft [string trim $f]
1679 if {![info exists viewfiles($n)]} {
1680 # creating a new view
1682 set viewname($n) $newviewname($n)
1683 set viewperm($n) $newviewperm($n)
1684 set viewfiles($n) $files
1685 set viewargs($n) $newargs
1687 if {!$newishighlight} {
1690 run addvhighlight $n
1693 # editing an existing view
1694 set viewperm($n) $newviewperm($n)
1695 if {$newviewname($n) ne $viewname($n)} {
1696 set viewname($n) $newviewname($n)
1697 doviewmenu .bar.view 5 [list showview $n] \
1698 entryconf [list -label $viewname($n)]
1699 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1700 entryconf [list -label $viewname($n) -value $viewname($n)]
1702 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1703 set viewfiles($n) $files
1704 set viewargs($n) $newargs
1705 if {$curview == $n} {
1710 catch {destroy $top}
1714 global curview viewdata viewperm hlview selectedhlview
1716 if {$curview == 0} return
1717 if {[info exists hlview] && $hlview == $curview} {
1718 set selectedhlview None
1721 allviewmenus $curview delete
1722 set viewdata($curview) {}
1723 set viewperm($curview) 0
1727 proc addviewmenu {n} {
1728 global viewname viewhlmenu
1730 .bar.view add radiobutton -label $viewname($n) \
1731 -command [list showview $n] -variable selectedview -value $n
1732 $viewhlmenu add radiobutton -label $viewname($n) \
1733 -command [list addvhighlight $n] -variable selectedhlview
1736 proc flatten {var} {
1740 foreach i [array names $var] {
1741 lappend ret $i [set $var\($i\)]
1746 proc unflatten {var l} {
1756 global curview viewdata viewfiles
1757 global displayorder parentlist rowidlist rowoffsets
1758 global colormap rowtextx commitrow nextcolor canvxmax
1759 global numcommits rowrangelist commitlisted idrowranges rowchk
1760 global selectedline currentid canv canvy0
1761 global matchinglines treediffs
1762 global pending_select phase
1763 global commitidx rowlaidout rowoptim
1765 global selectedview selectfirst
1766 global vparentlist vdisporder vcmitlisted
1767 global hlview selectedhlview
1769 if {$n == $curview} return
1771 if {[info exists selectedline]} {
1772 set selid $currentid
1773 set y [yc $selectedline]
1774 set ymax [lindex [$canv cget -scrollregion] 3]
1775 set span [$canv yview]
1776 set ytop [expr {[lindex $span 0] * $ymax}]
1777 set ybot [expr {[lindex $span 1] * $ymax}]
1778 if {$ytop < $y && $y < $ybot} {
1779 set yscreen [expr {$y - $ytop}]
1781 set yscreen [expr {($ybot - $ytop) / 2}]
1783 } elseif {[info exists pending_select]} {
1784 set selid $pending_select
1785 unset pending_select
1790 if {$curview >= 0} {
1791 set vparentlist($curview) $parentlist
1792 set vdisporder($curview) $displayorder
1793 set vcmitlisted($curview) $commitlisted
1795 set viewdata($curview) \
1796 [list $phase $rowidlist $rowoffsets $rowrangelist \
1797 [flatten idrowranges] [flatten idinlist] \
1798 $rowlaidout $rowoptim $numcommits]
1799 } elseif {![info exists viewdata($curview)]
1800 || [lindex $viewdata($curview) 0] ne {}} {
1801 set viewdata($curview) \
1802 [list {} $rowidlist $rowoffsets $rowrangelist]
1805 catch {unset matchinglines}
1806 catch {unset treediffs}
1808 if {[info exists hlview] && $hlview == $n} {
1810 set selectedhlview None
1815 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1816 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1818 if {![info exists viewdata($n)]} {
1820 set pending_select $selid
1827 set phase [lindex $v 0]
1828 set displayorder $vdisporder($n)
1829 set parentlist $vparentlist($n)
1830 set commitlisted $vcmitlisted($n)
1831 set rowidlist [lindex $v 1]
1832 set rowoffsets [lindex $v 2]
1833 set rowrangelist [lindex $v 3]
1835 set numcommits [llength $displayorder]
1836 catch {unset idrowranges}
1838 unflatten idrowranges [lindex $v 4]
1839 unflatten idinlist [lindex $v 5]
1840 set rowlaidout [lindex $v 6]
1841 set rowoptim [lindex $v 7]
1842 set numcommits [lindex $v 8]
1843 catch {unset rowchk}
1846 catch {unset colormap}
1847 catch {unset rowtextx}
1849 set canvxmax [$canv cget -width]
1856 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1857 set row $commitrow($n,$selid)
1858 # try to get the selected row in the same position on the screen
1859 set ymax [lindex [$canv cget -scrollregion] 3]
1860 set ytop [expr {[yc $row] - $yscreen}]
1864 set yf [expr {$ytop * 1.0 / $ymax}]
1866 allcanvs yview moveto $yf
1870 } elseif {$selid ne {}} {
1871 set pending_select $selid
1873 set row [expr {[lindex $displayorder 0] eq $nullid}]
1874 if {$row < $numcommits} {
1881 if {$phase eq "getcommits"} {
1882 show_status "Reading commits..."
1885 } elseif {$numcommits == 0} {
1886 show_status "No commits selected"
1890 # Stuff relating to the highlighting facility
1892 proc ishighlighted {row} {
1893 global vhighlights fhighlights nhighlights rhighlights
1895 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1896 return $nhighlights($row)
1898 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1899 return $vhighlights($row)
1901 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1902 return $fhighlights($row)
1904 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1905 return $rhighlights($row)
1910 proc bolden {row font} {
1911 global canv linehtag selectedline boldrows
1913 lappend boldrows $row
1914 $canv itemconf $linehtag($row) -font $font
1915 if {[info exists selectedline] && $row == $selectedline} {
1917 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1918 -outline {{}} -tags secsel \
1919 -fill [$canv cget -selectbackground]]
1924 proc bolden_name {row font} {
1925 global canv2 linentag selectedline boldnamerows
1927 lappend boldnamerows $row
1928 $canv2 itemconf $linentag($row) -font $font
1929 if {[info exists selectedline] && $row == $selectedline} {
1930 $canv2 delete secsel
1931 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1932 -outline {{}} -tags secsel \
1933 -fill [$canv2 cget -selectbackground]]
1939 global mainfont boldrows
1942 foreach row $boldrows {
1943 if {![ishighlighted $row]} {
1944 bolden $row $mainfont
1946 lappend stillbold $row
1949 set boldrows $stillbold
1952 proc addvhighlight {n} {
1953 global hlview curview viewdata vhl_done vhighlights commitidx
1955 if {[info exists hlview]} {
1959 if {$n != $curview && ![info exists viewdata($n)]} {
1960 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1961 set vparentlist($n) {}
1962 set vdisporder($n) {}
1963 set vcmitlisted($n) {}
1966 set vhl_done $commitidx($hlview)
1967 if {$vhl_done > 0} {
1972 proc delvhighlight {} {
1973 global hlview vhighlights
1975 if {![info exists hlview]} return
1977 catch {unset vhighlights}
1981 proc vhighlightmore {} {
1982 global hlview vhl_done commitidx vhighlights
1983 global displayorder vdisporder curview mainfont
1985 set font [concat $mainfont bold]
1986 set max $commitidx($hlview)
1987 if {$hlview == $curview} {
1988 set disp $displayorder
1990 set disp $vdisporder($hlview)
1992 set vr [visiblerows]
1993 set r0 [lindex $vr 0]
1994 set r1 [lindex $vr 1]
1995 for {set i $vhl_done} {$i < $max} {incr i} {
1996 set id [lindex $disp $i]
1997 if {[info exists commitrow($curview,$id)]} {
1998 set row $commitrow($curview,$id)
1999 if {$r0 <= $row && $row <= $r1} {
2000 if {![highlighted $row]} {
2003 set vhighlights($row) 1
2010 proc askvhighlight {row id} {
2011 global hlview vhighlights commitrow iddrawn mainfont
2013 if {[info exists commitrow($hlview,$id)]} {
2014 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2015 bolden $row [concat $mainfont bold]
2017 set vhighlights($row) 1
2019 set vhighlights($row) 0
2023 proc hfiles_change {name ix op} {
2024 global highlight_files filehighlight fhighlights fh_serial
2025 global mainfont highlight_paths
2027 if {[info exists filehighlight]} {
2028 # delete previous highlights
2029 catch {close $filehighlight}
2031 catch {unset fhighlights}
2033 unhighlight_filelist
2035 set highlight_paths {}
2036 after cancel do_file_hl $fh_serial
2038 if {$highlight_files ne {}} {
2039 after 300 do_file_hl $fh_serial
2043 proc makepatterns {l} {
2046 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2047 if {[string index $ee end] eq "/"} {
2057 proc do_file_hl {serial} {
2058 global highlight_files filehighlight highlight_paths gdttype fhl_list
2060 if {$gdttype eq "touching paths:"} {
2061 if {[catch {set paths [shellsplit $highlight_files]}]} return
2062 set highlight_paths [makepatterns $paths]
2064 set gdtargs [concat -- $paths]
2066 set gdtargs [list "-S$highlight_files"]
2068 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2069 set filehighlight [open $cmd r+]
2070 fconfigure $filehighlight -blocking 0
2071 filerun $filehighlight readfhighlight
2077 proc flushhighlights {} {
2078 global filehighlight fhl_list
2080 if {[info exists filehighlight]} {
2082 puts $filehighlight ""
2083 flush $filehighlight
2087 proc askfilehighlight {row id} {
2088 global filehighlight fhighlights fhl_list
2090 lappend fhl_list $id
2091 set fhighlights($row) -1
2092 puts $filehighlight $id
2095 proc readfhighlight {} {
2096 global filehighlight fhighlights commitrow curview mainfont iddrawn
2099 if {![info exists filehighlight]} {
2103 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2104 set line [string trim $line]
2105 set i [lsearch -exact $fhl_list $line]
2106 if {$i < 0} continue
2107 for {set j 0} {$j < $i} {incr j} {
2108 set id [lindex $fhl_list $j]
2109 if {[info exists commitrow($curview,$id)]} {
2110 set fhighlights($commitrow($curview,$id)) 0
2113 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2114 if {$line eq {}} continue
2115 if {![info exists commitrow($curview,$line)]} continue
2116 set row $commitrow($curview,$line)
2117 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2118 bolden $row [concat $mainfont bold]
2120 set fhighlights($row) 1
2122 if {[eof $filehighlight]} {
2124 puts "oops, git diff-tree died"
2125 catch {close $filehighlight}
2133 proc find_change {name ix op} {
2134 global nhighlights mainfont boldnamerows
2135 global findstring findpattern findtype
2137 # delete previous highlights, if any
2138 foreach row $boldnamerows {
2139 bolden_name $row $mainfont
2142 catch {unset nhighlights}
2144 if {$findtype ne "Regexp"} {
2145 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2147 set findpattern "*$e*"
2152 proc askfindhighlight {row id} {
2153 global nhighlights commitinfo iddrawn mainfont
2154 global findstring findtype findloc findpattern
2156 if {![info exists commitinfo($id)]} {
2159 set info $commitinfo($id)
2161 set fldtypes {Headline Author Date Committer CDate Comments}
2162 foreach f $info ty $fldtypes {
2163 if {$findloc ne "All fields" && $findloc ne $ty} {
2166 if {$findtype eq "Regexp"} {
2167 set doesmatch [regexp $findstring $f]
2168 } elseif {$findtype eq "IgnCase"} {
2169 set doesmatch [string match -nocase $findpattern $f]
2171 set doesmatch [string match $findpattern $f]
2174 if {$ty eq "Author"} {
2181 if {[info exists iddrawn($id)]} {
2182 if {$isbold && ![ishighlighted $row]} {
2183 bolden $row [concat $mainfont bold]
2186 bolden_name $row [concat $mainfont bold]
2189 set nhighlights($row) $isbold
2192 proc vrel_change {name ix op} {
2193 global highlight_related
2196 if {$highlight_related ne "None"} {
2201 # prepare for testing whether commits are descendents or ancestors of a
2202 proc rhighlight_sel {a} {
2203 global descendent desc_todo ancestor anc_todo
2204 global highlight_related rhighlights
2206 catch {unset descendent}
2207 set desc_todo [list $a]
2208 catch {unset ancestor}
2209 set anc_todo [list $a]
2210 if {$highlight_related ne "None"} {
2216 proc rhighlight_none {} {
2219 catch {unset rhighlights}
2223 proc is_descendent {a} {
2224 global curview children commitrow descendent desc_todo
2227 set la $commitrow($v,$a)
2231 for {set i 0} {$i < [llength $todo]} {incr i} {
2232 set do [lindex $todo $i]
2233 if {$commitrow($v,$do) < $la} {
2234 lappend leftover $do
2237 foreach nk $children($v,$do) {
2238 if {![info exists descendent($nk)]} {
2239 set descendent($nk) 1
2247 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2251 set descendent($a) 0
2252 set desc_todo $leftover
2255 proc is_ancestor {a} {
2256 global curview parentlist commitrow ancestor anc_todo
2259 set la $commitrow($v,$a)
2263 for {set i 0} {$i < [llength $todo]} {incr i} {
2264 set do [lindex $todo $i]
2265 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2266 lappend leftover $do
2269 foreach np [lindex $parentlist $commitrow($v,$do)] {
2270 if {![info exists ancestor($np)]} {
2279 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2284 set anc_todo $leftover
2287 proc askrelhighlight {row id} {
2288 global descendent highlight_related iddrawn mainfont rhighlights
2289 global selectedline ancestor
2291 if {![info exists selectedline]} return
2293 if {$highlight_related eq "Descendent" ||
2294 $highlight_related eq "Not descendent"} {
2295 if {![info exists descendent($id)]} {
2298 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2301 } elseif {$highlight_related eq "Ancestor" ||
2302 $highlight_related eq "Not ancestor"} {
2303 if {![info exists ancestor($id)]} {
2306 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2310 if {[info exists iddrawn($id)]} {
2311 if {$isbold && ![ishighlighted $row]} {
2312 bolden $row [concat $mainfont bold]
2315 set rhighlights($row) $isbold
2318 proc next_hlcont {} {
2319 global fhl_row fhl_dirn displayorder numcommits
2320 global vhighlights fhighlights nhighlights rhighlights
2321 global hlview filehighlight findstring highlight_related
2323 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2326 if {$row < 0 || $row >= $numcommits} {
2331 set id [lindex $displayorder $row]
2332 if {[info exists hlview]} {
2333 if {![info exists vhighlights($row)]} {
2334 askvhighlight $row $id
2336 if {$vhighlights($row) > 0} break
2338 if {$findstring ne {}} {
2339 if {![info exists nhighlights($row)]} {
2340 askfindhighlight $row $id
2342 if {$nhighlights($row) > 0} break
2344 if {$highlight_related ne "None"} {
2345 if {![info exists rhighlights($row)]} {
2346 askrelhighlight $row $id
2348 if {$rhighlights($row) > 0} break
2350 if {[info exists filehighlight]} {
2351 if {![info exists fhighlights($row)]} {
2352 # ask for a few more while we're at it...
2354 for {set n 0} {$n < 100} {incr n} {
2355 if {![info exists fhighlights($r)]} {
2356 askfilehighlight $r [lindex $displayorder $r]
2359 if {$r < 0 || $r >= $numcommits} break
2363 if {$fhighlights($row) < 0} {
2367 if {$fhighlights($row) > 0} break
2375 proc next_highlight {dirn} {
2376 global selectedline fhl_row fhl_dirn
2377 global hlview filehighlight findstring highlight_related
2379 if {![info exists selectedline]} return
2380 if {!([info exists hlview] || $findstring ne {} ||
2381 $highlight_related ne "None" || [info exists filehighlight])} return
2382 set fhl_row [expr {$selectedline + $dirn}]
2387 proc cancel_next_highlight {} {
2393 # Graph layout functions
2395 proc shortids {ids} {
2398 if {[llength $id] > 1} {
2399 lappend res [shortids $id]
2400 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2401 lappend res [string range $id 0 7]
2409 proc incrange {l x o} {
2412 set e [lindex $l $x]
2414 lset l $x [expr {$e + $o}]
2423 for {} {$n > 0} {incr n -1} {
2429 proc usedinrange {id l1 l2} {
2430 global children commitrow curview
2432 if {[info exists commitrow($curview,$id)]} {
2433 set r $commitrow($curview,$id)
2434 if {$l1 <= $r && $r <= $l2} {
2435 return [expr {$r - $l1 + 1}]
2438 set kids $children($curview,$id)
2440 set r $commitrow($curview,$c)
2441 if {$l1 <= $r && $r <= $l2} {
2442 return [expr {$r - $l1 + 1}]
2448 proc sanity {row {full 0}} {
2449 global rowidlist rowoffsets
2452 set ids [lindex $rowidlist $row]
2455 if {$id eq {}} continue
2456 if {$col < [llength $ids] - 1 &&
2457 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2458 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2460 set o [lindex $rowoffsets $row $col]
2466 if {[lindex $rowidlist $y $x] != $id} {
2467 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2468 puts " id=[shortids $id] check started at row $row"
2469 for {set i $row} {$i >= $y} {incr i -1} {
2470 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2475 set o [lindex $rowoffsets $y $x]
2480 proc makeuparrow {oid x y z} {
2481 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2483 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2486 set off0 [lindex $rowoffsets $y]
2487 for {set x0 $x} {1} {incr x0} {
2488 if {$x0 >= [llength $off0]} {
2489 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2492 set z [lindex $off0 $x0]
2498 set z [expr {$x0 - $x}]
2499 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2500 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2502 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2503 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2504 lappend idrowranges($oid) [lindex $displayorder $y]
2507 proc initlayout {} {
2508 global rowidlist rowoffsets displayorder commitlisted
2509 global rowlaidout rowoptim
2510 global idinlist rowchk rowrangelist idrowranges
2511 global numcommits canvxmax canv
2514 global colormap rowtextx
2525 catch {unset idinlist}
2526 catch {unset rowchk}
2529 set canvxmax [$canv cget -width]
2530 catch {unset colormap}
2531 catch {unset rowtextx}
2532 catch {unset idrowranges}
2536 proc setcanvscroll {} {
2537 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2539 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2540 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2541 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2542 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2545 proc visiblerows {} {
2546 global canv numcommits linespc
2548 set ymax [lindex [$canv cget -scrollregion] 3]
2549 if {$ymax eq {} || $ymax == 0} return
2551 set y0 [expr {int([lindex $f 0] * $ymax)}]
2552 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2556 set y1 [expr {int([lindex $f 1] * $ymax)}]
2557 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2558 if {$r1 >= $numcommits} {
2559 set r1 [expr {$numcommits - 1}]
2561 return [list $r0 $r1]
2564 proc layoutmore {tmax allread} {
2565 global rowlaidout rowoptim commitidx numcommits optim_delay
2566 global uparrowlen curview rowidlist idinlist
2569 set showdelay $optim_delay
2570 set optdelay [expr {$uparrowlen + 1}]
2572 if {$rowoptim - $showdelay > $numcommits} {
2573 showstuff [expr {$rowoptim - $showdelay}] $showlast
2574 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2575 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2579 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2581 } elseif {$commitidx($curview) > $rowlaidout} {
2582 set nr [expr {$commitidx($curview) - $rowlaidout}]
2583 # may need to increase this threshold if uparrowlen or
2584 # mingaplen are increased...
2589 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2590 if {$rowlaidout == $row} {
2593 } elseif {$allread} {
2595 set nrows $commitidx($curview)
2596 if {[lindex $rowidlist $nrows] ne {} ||
2597 [array names idinlist] ne {}} {
2599 set rowlaidout $commitidx($curview)
2600 } elseif {$rowoptim == $nrows} {
2603 if {$numcommits == $nrows} {
2610 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2616 proc showstuff {canshow last} {
2617 global numcommits commitrow pending_select selectedline curview
2618 global lookingforhead mainheadid displayorder nullid selectfirst
2620 if {$numcommits == 0} {
2622 set phase "incrdraw"
2626 set numcommits $canshow
2628 set rows [visiblerows]
2629 set r1 [lindex $rows 1]
2630 if {$r1 >= $canshow} {
2631 set r1 [expr {$canshow - 1}]
2636 if {[info exists pending_select] &&
2637 [info exists commitrow($curview,$pending_select)] &&
2638 $commitrow($curview,$pending_select) < $numcommits} {
2639 selectline $commitrow($curview,$pending_select) 1
2642 if {[info exists selectedline] || [info exists pending_select]} {
2645 set l [expr {[lindex $displayorder 0] eq $nullid}]
2650 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2651 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2652 set lookingforhead 0
2657 proc doshowlocalchanges {} {
2658 global lookingforhead curview mainheadid phase commitrow
2660 if {[info exists commitrow($curview,$mainheadid)] &&
2661 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2663 } elseif {$phase ne {}} {
2664 set lookingforhead 1
2668 proc dohidelocalchanges {} {
2669 global lookingforhead localrow lserial
2671 set lookingforhead 0
2672 if {$localrow >= 0} {
2679 # spawn off a process to do git diff-index HEAD
2680 proc dodiffindex {} {
2681 global localrow lserial
2685 set fd [open "|git diff-index HEAD" r]
2686 fconfigure $fd -blocking 0
2687 filerun $fd [list readdiffindex $fd $lserial]
2690 proc readdiffindex {fd serial} {
2691 global localrow commitrow mainheadid nullid curview
2692 global commitinfo commitdata lserial
2694 if {[gets $fd line] < 0} {
2701 # we only need to see one line and we don't really care what it says...
2704 if {$serial == $lserial && $localrow == -1} {
2705 # add the line for the local diff to the graph
2706 set localrow $commitrow($curview,$mainheadid)
2707 set hl "Local uncommitted changes"
2708 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2709 set commitdata($nullid) "\n $hl\n"
2710 insertrow $localrow $nullid
2715 proc layoutrows {row endrow last} {
2716 global rowidlist rowoffsets displayorder
2717 global uparrowlen downarrowlen maxwidth mingaplen
2718 global children parentlist
2720 global commitidx curview
2721 global idinlist rowchk rowrangelist
2723 set idlist [lindex $rowidlist $row]
2724 set offs [lindex $rowoffsets $row]
2725 while {$row < $endrow} {
2726 set id [lindex $displayorder $row]
2729 foreach p [lindex $parentlist $row] {
2730 if {![info exists idinlist($p)]} {
2732 } elseif {!$idinlist($p)} {
2736 set nev [expr {[llength $idlist] + [llength $newolds]
2737 + [llength $oldolds] - $maxwidth + 1}]
2740 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2741 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2742 set i [lindex $idlist $x]
2743 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2744 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2745 [expr {$row + $uparrowlen + $mingaplen}]]
2747 set idlist [lreplace $idlist $x $x]
2748 set offs [lreplace $offs $x $x]
2749 set offs [incrange $offs $x 1]
2751 set rm1 [expr {$row - 1}]
2752 lappend idrowranges($i) [lindex $displayorder $rm1]
2753 if {[incr nev -1] <= 0} break
2756 set rowchk($id) [expr {$row + $r}]
2759 lset rowidlist $row $idlist
2760 lset rowoffsets $row $offs
2762 set col [lsearch -exact $idlist $id]
2764 set col [llength $idlist]
2766 lset rowidlist $row $idlist
2768 if {$children($curview,$id) ne {}} {
2769 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2773 lset rowoffsets $row $offs
2775 makeuparrow $id $col $row $z
2781 if {[info exists idrowranges($id)]} {
2782 set ranges $idrowranges($id)
2784 unset idrowranges($id)
2786 lappend rowrangelist $ranges
2788 set offs [ntimes [llength $idlist] 0]
2789 set l [llength $newolds]
2790 set idlist [eval lreplace \$idlist $col $col $newolds]
2793 set offs [lrange $offs 0 [expr {$col - 1}]]
2794 foreach x $newolds {
2799 set tmp [expr {[llength $idlist] - [llength $offs]}]
2801 set offs [concat $offs [ntimes $tmp $o]]
2806 foreach i $newolds {
2808 set idrowranges($i) $id
2811 foreach oid $oldolds {
2812 set idinlist($oid) 1
2813 set idlist [linsert $idlist $col $oid]
2814 set offs [linsert $offs $col $o]
2815 makeuparrow $oid $col $row $o
2818 lappend rowidlist $idlist
2819 lappend rowoffsets $offs
2824 proc addextraid {id row} {
2825 global displayorder commitrow commitinfo
2826 global commitidx commitlisted
2827 global parentlist children curview
2829 incr commitidx($curview)
2830 lappend displayorder $id
2831 lappend commitlisted 0
2832 lappend parentlist {}
2833 set commitrow($curview,$id) $row
2835 if {![info exists commitinfo($id)]} {
2836 set commitinfo($id) {"No commit information available"}
2838 if {![info exists children($curview,$id)]} {
2839 set children($curview,$id) {}
2843 proc layouttail {} {
2844 global rowidlist rowoffsets idinlist commitidx curview
2845 global idrowranges rowrangelist
2847 set row $commitidx($curview)
2848 set idlist [lindex $rowidlist $row]
2849 while {$idlist ne {}} {
2850 set col [expr {[llength $idlist] - 1}]
2851 set id [lindex $idlist $col]
2854 lappend idrowranges($id) $row
2855 lappend rowrangelist $idrowranges($id)
2856 unset idrowranges($id)
2858 set offs [ntimes $col 0]
2859 set idlist [lreplace $idlist $col $col]
2860 lappend rowidlist $idlist
2861 lappend rowoffsets $offs
2864 foreach id [array names idinlist] {
2867 lset rowidlist $row [list $id]
2868 lset rowoffsets $row 0
2869 makeuparrow $id 0 $row 0
2870 lappend idrowranges($id) $row
2871 lappend rowrangelist $idrowranges($id)
2872 unset idrowranges($id)
2874 lappend rowidlist {}
2875 lappend rowoffsets {}
2879 proc insert_pad {row col npad} {
2880 global rowidlist rowoffsets
2882 set pad [ntimes $npad {}]
2883 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2884 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2885 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2888 proc optimize_rows {row col endrow} {
2889 global rowidlist rowoffsets displayorder
2891 for {} {$row < $endrow} {incr row} {
2892 set idlist [lindex $rowidlist $row]
2893 set offs [lindex $rowoffsets $row]
2895 for {} {$col < [llength $offs]} {incr col} {
2896 if {[lindex $idlist $col] eq {}} {
2900 set z [lindex $offs $col]
2901 if {$z eq {}} continue
2903 set x0 [expr {$col + $z}]
2904 set y0 [expr {$row - 1}]
2905 set z0 [lindex $rowoffsets $y0 $x0]
2907 set id [lindex $idlist $col]
2908 set ranges [rowranges $id]
2909 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2913 # Looking at lines from this row to the previous row,
2914 # make them go straight up if they end in an arrow on
2915 # the previous row; otherwise make them go straight up
2917 if {$z < -1 || ($z < 0 && $isarrow)} {
2918 # Line currently goes left too much;
2919 # insert pads in the previous row, then optimize it
2920 set npad [expr {-1 - $z + $isarrow}]
2921 set offs [incrange $offs $col $npad]
2922 insert_pad $y0 $x0 $npad
2924 optimize_rows $y0 $x0 $row
2926 set z [lindex $offs $col]
2927 set x0 [expr {$col + $z}]
2928 set z0 [lindex $rowoffsets $y0 $x0]
2929 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2930 # Line currently goes right too much;
2931 # insert pads in this line and adjust the next's rowoffsets
2932 set npad [expr {$z - 1 + $isarrow}]
2933 set y1 [expr {$row + 1}]
2934 set offs2 [lindex $rowoffsets $y1]
2938 if {$z eq {} || $x1 + $z < $col} continue
2939 if {$x1 + $z > $col} {
2942 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2945 set pad [ntimes $npad {}]
2946 set idlist [eval linsert \$idlist $col $pad]
2947 set tmp [eval linsert \$offs $col $pad]
2949 set offs [incrange $tmp $col [expr {-$npad}]]
2950 set z [lindex $offs $col]
2953 if {$z0 eq {} && !$isarrow} {
2954 # this line links to its first child on row $row-2
2955 set rm2 [expr {$row - 2}]
2956 set id [lindex $displayorder $rm2]
2957 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2959 set z0 [expr {$xc - $x0}]
2962 # avoid lines jigging left then immediately right
2963 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2964 insert_pad $y0 $x0 1
2965 set offs [incrange $offs $col 1]
2966 optimize_rows $y0 [expr {$x0 + 1}] $row
2971 # Find the first column that doesn't have a line going right
2972 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2973 set o [lindex $offs $col]
2975 # check if this is the link to the first child
2976 set id [lindex $idlist $col]
2977 set ranges [rowranges $id]
2978 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2979 # it is, work out offset to child
2980 set y0 [expr {$row - 1}]
2981 set id [lindex $displayorder $y0]
2982 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2984 set o [expr {$x0 - $col}]
2988 if {$o eq {} || $o <= 0} break
2990 # Insert a pad at that column as long as it has a line and
2991 # isn't the last column, and adjust the next row' offsets
2992 if {$o ne {} && [incr col] < [llength $idlist]} {
2993 set y1 [expr {$row + 1}]
2994 set offs2 [lindex $rowoffsets $y1]
2998 if {$z eq {} || $x1 + $z < $col} continue
2999 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3002 set idlist [linsert $idlist $col {}]
3003 set tmp [linsert $offs $col {}]
3005 set offs [incrange $tmp $col -1]
3008 lset rowidlist $row $idlist
3009 lset rowoffsets $row $offs
3015 global canvx0 linespc
3016 return [expr {$canvx0 + $col * $linespc}]
3020 global canvy0 linespc
3021 return [expr {$canvy0 + $row * $linespc}]
3024 proc linewidth {id} {
3025 global thickerline lthickness
3028 if {[info exists thickerline] && $id eq $thickerline} {
3029 set wid [expr {2 * $lthickness}]
3034 proc rowranges {id} {
3035 global phase idrowranges commitrow rowlaidout rowrangelist curview
3039 ([info exists commitrow($curview,$id)]
3040 && $commitrow($curview,$id) < $rowlaidout)} {
3041 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3042 } elseif {[info exists idrowranges($id)]} {
3043 set ranges $idrowranges($id)
3046 foreach rid $ranges {
3047 lappend linenos $commitrow($curview,$rid)
3049 if {$linenos ne {}} {
3050 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3055 # work around tk8.4 refusal to draw arrows on diagonal segments
3056 proc adjarrowhigh {coords} {
3059 set x0 [lindex $coords 0]
3060 set x1 [lindex $coords 2]
3062 set y0 [lindex $coords 1]
3063 set y1 [lindex $coords 3]
3064 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3065 # we have a nearby vertical segment, just trim off the diag bit
3066 set coords [lrange $coords 2 end]
3068 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3069 set xi [expr {$x0 - $slope * $linespc / 2}]
3070 set yi [expr {$y0 - $linespc / 2}]
3071 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3077 proc drawlineseg {id row endrow arrowlow} {
3078 global rowidlist displayorder iddrawn linesegs
3079 global canv colormap linespc curview maxlinelen
3081 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3082 set le [expr {$row + 1}]
3085 set c [lsearch -exact [lindex $rowidlist $le] $id]
3091 set x [lindex $displayorder $le]
3096 if {[info exists iddrawn($x)] || $le == $endrow} {
3097 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3113 if {[info exists linesegs($id)]} {
3114 set lines $linesegs($id)
3116 set r0 [lindex $li 0]
3118 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3128 set li [lindex $lines [expr {$i-1}]]
3129 set r1 [lindex $li 1]
3130 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3135 set x [lindex $cols [expr {$le - $row}]]
3136 set xp [lindex $cols [expr {$le - 1 - $row}]]
3137 set dir [expr {$xp - $x}]
3139 set ith [lindex $lines $i 2]
3140 set coords [$canv coords $ith]
3141 set ah [$canv itemcget $ith -arrow]
3142 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3143 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3144 if {$x2 ne {} && $x - $x2 == $dir} {
3145 set coords [lrange $coords 0 end-2]
3148 set coords [list [xc $le $x] [yc $le]]
3151 set itl [lindex $lines [expr {$i-1}] 2]
3152 set al [$canv itemcget $itl -arrow]
3153 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3154 } elseif {$arrowlow &&
3155 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3158 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3159 for {set y $le} {[incr y -1] > $row} {} {
3161 set xp [lindex $cols [expr {$y - 1 - $row}]]
3162 set ndir [expr {$xp - $x}]
3163 if {$dir != $ndir || $xp < 0} {
3164 lappend coords [xc $y $x] [yc $y]
3170 # join parent line to first child
3171 set ch [lindex $displayorder $row]
3172 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3174 puts "oops: drawlineseg: child $ch not on row $row"
3177 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3178 } elseif {$xc > $x + 1} {
3179 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3183 lappend coords [xc $row $x] [yc $row]
3185 set xn [xc $row $xp]
3187 # work around tk8.4 refusal to draw arrows on diagonal segments
3188 if {$arrowlow && $xn != [lindex $coords end-1]} {
3189 if {[llength $coords] < 4 ||
3190 [lindex $coords end-3] != [lindex $coords end-1] ||
3191 [lindex $coords end] - $yn > 2 * $linespc} {
3192 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3193 set yo [yc [expr {$row + 0.5}]]
3194 lappend coords $xn $yo $xn $yn
3197 lappend coords $xn $yn
3202 set coords [adjarrowhigh $coords]
3205 set t [$canv create line $coords -width [linewidth $id] \
3206 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3209 set lines [linsert $lines $i [list $row $le $t]]
3211 $canv coords $ith $coords
3212 if {$arrow ne $ah} {
3213 $canv itemconf $ith -arrow $arrow
3215 lset lines $i 0 $row
3218 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3219 set ndir [expr {$xo - $xp}]
3220 set clow [$canv coords $itl]
3221 if {$dir == $ndir} {
3222 set clow [lrange $clow 2 end]
3224 set coords [concat $coords $clow]
3226 lset lines [expr {$i-1}] 1 $le
3228 set coords [adjarrowhigh $coords]
3231 # coalesce two pieces
3233 set b [lindex $lines [expr {$i-1}] 0]
3234 set e [lindex $lines $i 1]
3235 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3237 $canv coords $itl $coords
3238 if {$arrow ne $al} {
3239 $canv itemconf $itl -arrow $arrow
3243 set linesegs($id) $lines
3247 proc drawparentlinks {id row} {
3248 global rowidlist canv colormap curview parentlist
3251 set rowids [lindex $rowidlist $row]
3252 set col [lsearch -exact $rowids $id]
3253 if {$col < 0} return
3254 set olds [lindex $parentlist $row]
3255 set row2 [expr {$row + 1}]
3256 set x [xc $row $col]
3259 set ids [lindex $rowidlist $row2]
3260 # rmx = right-most X coord used
3263 set i [lsearch -exact $ids $p]
3265 puts "oops, parent $p of $id not in list"
3268 set x2 [xc $row2 $i]
3272 if {[lsearch -exact $rowids $p] < 0} {
3273 # drawlineseg will do this one for us
3277 # should handle duplicated parents here...
3278 set coords [list $x $y]
3279 if {$i < $col - 1} {
3280 lappend coords [xc $row [expr {$i + 1}]] $y
3281 } elseif {$i > $col + 1} {
3282 lappend coords [xc $row [expr {$i - 1}]] $y
3284 lappend coords $x2 $y2
3285 set t [$canv create line $coords -width [linewidth $p] \
3286 -fill $colormap($p) -tags lines.$p]
3290 if {$rmx > [lindex $idpos($id) 1]} {
3291 lset idpos($id) 1 $rmx
3296 proc drawlines {id} {
3299 $canv itemconf lines.$id -width [linewidth $id]
3302 proc drawcmittext {id row col} {
3303 global linespc canv canv2 canv3 canvy0 fgcolor
3304 global commitlisted commitinfo rowidlist parentlist
3305 global rowtextx idpos idtags idheads idotherrefs
3306 global linehtag linentag linedtag
3307 global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3309 if {$id eq $nullid} {
3312 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3314 set x [xc $row $col]
3316 set orad [expr {$linespc / 3}]
3317 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3318 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3319 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3321 $canv bind $t <1> {selcanvline {} %x %y}
3322 set rmx [llength [lindex $rowidlist $row]]
3323 set olds [lindex $parentlist $row]
3325 set nextids [lindex $rowidlist [expr {$row + 1}]]
3327 set i [lsearch -exact $nextids $p]
3333 set xt [xc $row $rmx]
3334 set rowtextx($row) $xt
3335 set idpos($id) [list $x $xt $y]
3336 if {[info exists idtags($id)] || [info exists idheads($id)]
3337 || [info exists idotherrefs($id)]} {
3338 set xt [drawtags $id $x $xt $y]
3340 set headline [lindex $commitinfo($id) 0]
3341 set name [lindex $commitinfo($id) 1]
3342 set date [lindex $commitinfo($id) 2]
3343 set date [formatdate $date]
3346 set isbold [ishighlighted $row]
3348 lappend boldrows $row
3351 lappend boldnamerows $row
3355 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3356 -text $headline -font $font -tags text]
3357 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3358 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3359 -text $name -font $nfont -tags text]
3360 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3361 -text $date -font $mainfont -tags text]
3362 set xr [expr {$xt + [font measure $mainfont $headline]}]
3363 if {$xr > $canvxmax} {
3369 proc drawcmitrow {row} {
3370 global displayorder rowidlist
3372 global commitinfo parentlist numcommits
3373 global filehighlight fhighlights findstring nhighlights
3374 global hlview vhighlights
3375 global highlight_related rhighlights
3377 if {$row >= $numcommits} return
3379 set id [lindex $displayorder $row]
3380 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3381 askvhighlight $row $id
3383 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3384 askfilehighlight $row $id
3386 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3387 askfindhighlight $row $id
3389 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3390 askrelhighlight $row $id
3392 if {[info exists iddrawn($id)]} return
3393 set col [lsearch -exact [lindex $rowidlist $row] $id]
3395 puts "oops, row $row id $id not in list"
3398 if {![info exists commitinfo($id)]} {
3402 drawcmittext $id $row $col
3406 proc drawcommits {row {endrow {}}} {
3407 global numcommits iddrawn displayorder curview
3408 global parentlist rowidlist
3413 if {$endrow eq {}} {
3416 if {$endrow >= $numcommits} {
3417 set endrow [expr {$numcommits - 1}]
3420 # make the lines join to already-drawn rows either side
3421 set r [expr {$row - 1}]
3422 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3425 set er [expr {$endrow + 1}]
3426 if {$er >= $numcommits ||
3427 ![info exists iddrawn([lindex $displayorder $er])]} {
3430 for {} {$r <= $er} {incr r} {
3431 set id [lindex $displayorder $r]
3432 set wasdrawn [info exists iddrawn($id)]
3436 if {$r == $er} break
3437 set nextid [lindex $displayorder [expr {$r + 1}]]
3438 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3439 catch {unset prevlines}
3442 drawparentlinks $id $r
3444 if {[info exists lineends($r)]} {
3445 foreach lid $lineends($r) {
3446 unset prevlines($lid)
3449 set rowids [lindex $rowidlist $r]
3450 foreach lid $rowids {
3451 if {$lid eq {}} continue
3453 # see if this is the first child of any of its parents
3454 foreach p [lindex $parentlist $r] {
3455 if {[lsearch -exact $rowids $p] < 0} {
3456 # make this line extend up to the child
3457 set le [drawlineseg $p $r $er 0]
3458 lappend lineends($le) $p
3462 } elseif {![info exists prevlines($lid)]} {
3463 set le [drawlineseg $lid $r $er 1]
3464 lappend lineends($le) $lid
3465 set prevlines($lid) 1
3471 proc drawfrac {f0 f1} {
3474 set ymax [lindex [$canv cget -scrollregion] 3]
3475 if {$ymax eq {} || $ymax == 0} return
3476 set y0 [expr {int($f0 * $ymax)}]
3477 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3478 set y1 [expr {int($f1 * $ymax)}]
3479 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3480 drawcommits $row $endrow
3483 proc drawvisible {} {
3485 eval drawfrac [$canv yview]
3488 proc clear_display {} {
3489 global iddrawn linesegs
3490 global vhighlights fhighlights nhighlights rhighlights
3493 catch {unset iddrawn}
3494 catch {unset linesegs}
3495 catch {unset vhighlights}
3496 catch {unset fhighlights}
3497 catch {unset nhighlights}
3498 catch {unset rhighlights}
3501 proc findcrossings {id} {
3502 global rowidlist parentlist numcommits rowoffsets displayorder
3506 foreach {s e} [rowranges $id] {
3507 if {$e >= $numcommits} {
3508 set e [expr {$numcommits - 1}]
3510 if {$e <= $s} continue
3511 set x [lsearch -exact [lindex $rowidlist $e] $id]
3513 puts "findcrossings: oops, no [shortids $id] in row $e"
3516 for {set row $e} {[incr row -1] >= $s} {} {
3517 set olds [lindex $parentlist $row]
3518 set kid [lindex $displayorder $row]
3519 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3520 if {$kidx < 0} continue
3521 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3523 set px [lsearch -exact $nextrow $p]
3524 if {$px < 0} continue
3525 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3526 if {[lsearch -exact $ccross $p] >= 0} continue
3527 if {$x == $px + ($kidx < $px? -1: 1)} {
3529 } elseif {[lsearch -exact $cross $p] < 0} {
3534 set inc [lindex $rowoffsets $row $x]
3535 if {$inc eq {}} break
3539 return [concat $ccross {{}} $cross]
3542 proc assigncolor {id} {
3543 global colormap colors nextcolor
3544 global commitrow parentlist children children curview
3546 if {[info exists colormap($id)]} return
3547 set ncolors [llength $colors]
3548 if {[info exists children($curview,$id)]} {
3549 set kids $children($curview,$id)
3553 if {[llength $kids] == 1} {
3554 set child [lindex $kids 0]
3555 if {[info exists colormap($child)]
3556 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3557 set colormap($id) $colormap($child)
3563 foreach x [findcrossings $id] {
3565 # delimiter between corner crossings and other crossings
3566 if {[llength $badcolors] >= $ncolors - 1} break
3567 set origbad $badcolors
3569 if {[info exists colormap($x)]
3570 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3571 lappend badcolors $colormap($x)
3574 if {[llength $badcolors] >= $ncolors} {
3575 set badcolors $origbad
3577 set origbad $badcolors
3578 if {[llength $badcolors] < $ncolors - 1} {
3579 foreach child $kids {
3580 if {[info exists colormap($child)]
3581 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3582 lappend badcolors $colormap($child)
3584 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3585 if {[info exists colormap($p)]
3586 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3587 lappend badcolors $colormap($p)
3591 if {[llength $badcolors] >= $ncolors} {
3592 set badcolors $origbad
3595 for {set i 0} {$i <= $ncolors} {incr i} {
3596 set c [lindex $colors $nextcolor]
3597 if {[incr nextcolor] >= $ncolors} {
3600 if {[lsearch -exact $badcolors $c]} break
3602 set colormap($id) $c
3605 proc bindline {t id} {
3608 $canv bind $t <Enter> "lineenter %x %y $id"
3609 $canv bind $t <Motion> "linemotion %x %y $id"
3610 $canv bind $t <Leave> "lineleave $id"
3611 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3614 proc drawtags {id x xt y1} {
3615 global idtags idheads idotherrefs mainhead
3616 global linespc lthickness
3617 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3622 if {[info exists idtags($id)]} {
3623 set marks $idtags($id)
3624 set ntags [llength $marks]
3626 if {[info exists idheads($id)]} {
3627 set marks [concat $marks $idheads($id)]
3628 set nheads [llength $idheads($id)]
3630 if {[info exists idotherrefs($id)]} {
3631 set marks [concat $marks $idotherrefs($id)]
3637 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3638 set yt [expr {$y1 - 0.5 * $linespc}]
3639 set yb [expr {$yt + $linespc - 1}]
3643 foreach tag $marks {
3645 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3646 set wid [font measure [concat $mainfont bold] $tag]
3648 set wid [font measure $mainfont $tag]
3652 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3654 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3655 -width $lthickness -fill black -tags tag.$id]
3657 foreach tag $marks x $xvals wid $wvals {
3658 set xl [expr {$x + $delta}]
3659 set xr [expr {$x + $delta + $wid + $lthickness}]
3661 if {[incr ntags -1] >= 0} {
3663 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3664 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3665 -width 1 -outline black -fill yellow -tags tag.$id]
3666 $canv bind $t <1> [list showtag $tag 1]
3667 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3669 # draw a head or other ref
3670 if {[incr nheads -1] >= 0} {
3672 if {$tag eq $mainhead} {
3678 set xl [expr {$xl - $delta/2}]
3679 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3680 -width 1 -outline black -fill $col -tags tag.$id
3681 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3682 set rwid [font measure $mainfont $remoteprefix]
3683 set xi [expr {$x + 1}]
3684 set yti [expr {$yt + 1}]
3685 set xri [expr {$x + $rwid}]
3686 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3687 -width 0 -fill "#ffddaa" -tags tag.$id
3690 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3691 -font $font -tags [list tag.$id text]]
3693 $canv bind $t <1> [list showtag $tag 1]
3694 } elseif {$nheads >= 0} {
3695 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3701 proc xcoord {i level ln} {
3702 global canvx0 xspc1 xspc2
3704 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3705 if {$i > 0 && $i == $level} {
3706 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3707 } elseif {$i > $level} {
3708 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3713 proc show_status {msg} {
3714 global canv mainfont fgcolor
3717 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3718 -tags text -fill $fgcolor
3721 # Insert a new commit as the child of the commit on row $row.
3722 # The new commit will be displayed on row $row and the commits
3723 # on that row and below will move down one row.
3724 proc insertrow {row newcmit} {
3725 global displayorder parentlist commitlisted children
3726 global commitrow curview rowidlist rowoffsets numcommits
3727 global rowrangelist rowlaidout rowoptim numcommits
3728 global selectedline rowchk commitidx
3730 if {$row >= $numcommits} {
3731 puts "oops, inserting new row $row but only have $numcommits rows"
3734 set p [lindex $displayorder $row]
3735 set displayorder [linsert $displayorder $row $newcmit]
3736 set parentlist [linsert $parentlist $row $p]
3737 set kids $children($curview,$p)
3738 lappend kids $newcmit
3739 set children($curview,$p) $kids
3740 set children($curview,$newcmit) {}
3741 set commitlisted [linsert $commitlisted $row 1]
3742 set l [llength $displayorder]
3743 for {set r $row} {$r < $l} {incr r} {
3744 set id [lindex $displayorder $r]
3745 set commitrow($curview,$id) $r
3747 incr commitidx($curview)
3749 set idlist [lindex $rowidlist $row]
3750 set offs [lindex $rowoffsets $row]
3753 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3759 if {[llength $kids] == 1} {
3760 set col [lsearch -exact $idlist $p]
3761 lset idlist $col $newcmit
3763 set col [llength $idlist]
3764 lappend idlist $newcmit
3766 lset rowoffsets $row $offs
3768 set rowidlist [linsert $rowidlist $row $idlist]
3769 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3771 set rowrangelist [linsert $rowrangelist $row {}]
3772 if {[llength $kids] > 1} {
3773 set rp1 [expr {$row + 1}]
3774 set ranges [lindex $rowrangelist $rp1]
3775 if {$ranges eq {}} {
3776 set ranges [list $newcmit $p]
3777 } elseif {[lindex $ranges end-1] eq $p} {
3778 lset ranges end-1 $newcmit
3780 lset rowrangelist $rp1 $ranges
3783 catch {unset rowchk}
3789 if {[info exists selectedline] && $selectedline >= $row} {
3795 # Remove a commit that was inserted with insertrow on row $row.
3796 proc removerow {row} {
3797 global displayorder parentlist commitlisted children
3798 global commitrow curview rowidlist rowoffsets numcommits
3799 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3800 global linesegends selectedline rowchk commitidx
3802 if {$row >= $numcommits} {
3803 puts "oops, removing row $row but only have $numcommits rows"
3806 set rp1 [expr {$row + 1}]
3807 set id [lindex $displayorder $row]
3808 set p [lindex $parentlist $row]
3809 set displayorder [lreplace $displayorder $row $row]
3810 set parentlist [lreplace $parentlist $row $row]
3811 set commitlisted [lreplace $commitlisted $row $row]
3812 set kids $children($curview,$p)
3813 set i [lsearch -exact $kids $id]
3815 set kids [lreplace $kids $i $i]
3816 set children($curview,$p) $kids
3818 set l [llength $displayorder]
3819 for {set r $row} {$r < $l} {incr r} {
3820 set id [lindex $displayorder $r]
3821 set commitrow($curview,$id) $r
3823 incr commitidx($curview) -1
3825 set rowidlist [lreplace $rowidlist $row $row]
3826 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3828 set offs [lindex $rowoffsets $row]
3829 set offs [lreplace $offs end end]
3830 lset rowoffsets $row $offs
3833 set rowrangelist [lreplace $rowrangelist $row $row]
3834 if {[llength $kids] > 0} {
3835 set ranges [lindex $rowrangelist $row]
3836 if {[lindex $ranges end-1] eq $id} {
3837 set ranges [lreplace $ranges end-1 end]
3838 lset rowrangelist $row $ranges
3842 catch {unset rowchk}
3848 if {[info exists selectedline] && $selectedline > $row} {
3849 incr selectedline -1
3854 # Don't change the text pane cursor if it is currently the hand cursor,
3855 # showing that we are over a sha1 ID link.
3856 proc settextcursor {c} {
3857 global ctext curtextcursor
3859 if {[$ctext cget -cursor] == $curtextcursor} {
3860 $ctext config -cursor $c
3862 set curtextcursor $c
3865 proc nowbusy {what} {
3868 if {[array names isbusy] eq {}} {
3869 . config -cursor watch
3875 proc notbusy {what} {
3876 global isbusy maincursor textcursor
3878 catch {unset isbusy($what)}
3879 if {[array names isbusy] eq {}} {
3880 . config -cursor $maincursor
3881 settextcursor $textcursor
3885 proc findmatches {f} {
3886 global findtype foundstring foundstrlen
3887 if {$findtype == "Regexp"} {
3888 set matches [regexp -indices -all -inline $foundstring $f]
3890 if {$findtype == "IgnCase"} {
3891 set str [string tolower $f]
3897 while {[set j [string first $foundstring $str $i]] >= 0} {
3898 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3899 set i [expr {$j + $foundstrlen}]
3906 global findtype findloc findstring markedmatches commitinfo
3907 global numcommits displayorder linehtag linentag linedtag
3908 global mainfont canv canv2 canv3 selectedline
3909 global matchinglines foundstring foundstrlen matchstring
3914 cancel_next_highlight
3916 set matchinglines {}
3917 if {$findtype == "IgnCase"} {
3918 set foundstring [string tolower $findstring]
3920 set foundstring $findstring
3922 set foundstrlen [string length $findstring]
3923 if {$foundstrlen == 0} return
3924 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3925 set matchstring "*$matchstring*"
3926 if {![info exists selectedline]} {
3929 set oldsel $selectedline
3932 set fldtypes {Headline Author Date Committer CDate Comments}
3934 foreach id $displayorder {
3935 set d $commitdata($id)
3937 if {$findtype == "Regexp"} {
3938 set doesmatch [regexp $foundstring $d]
3939 } elseif {$findtype == "IgnCase"} {
3940 set doesmatch [string match -nocase $matchstring $d]
3942 set doesmatch [string match $matchstring $d]
3944 if {!$doesmatch} continue
3945 if {![info exists commitinfo($id)]} {
3948 set info $commitinfo($id)
3950 foreach f $info ty $fldtypes {
3951 if {$findloc != "All fields" && $findloc != $ty} {
3954 set matches [findmatches $f]
3955 if {$matches == {}} continue
3957 if {$ty == "Headline"} {
3959 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3960 } elseif {$ty == "Author"} {
3962 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3963 } elseif {$ty == "Date"} {
3965 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3969 lappend matchinglines $l
3970 if {!$didsel && $l > $oldsel} {
3976 if {$matchinglines == {}} {
3978 } elseif {!$didsel} {
3979 findselectline [lindex $matchinglines 0]
3983 proc findselectline {l} {
3984 global findloc commentend ctext
3986 if {$findloc == "All fields" || $findloc == "Comments"} {
3987 # highlight the matches in the comments
3988 set f [$ctext get 1.0 $commentend]
3989 set matches [findmatches $f]
3990 foreach match $matches {
3991 set start [lindex $match 0]
3992 set end [expr {[lindex $match 1] + 1}]
3993 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3998 proc findnext {restart} {
3999 global matchinglines selectedline
4000 if {![info exists matchinglines]} {
4006 if {![info exists selectedline]} return
4007 foreach l $matchinglines {
4008 if {$l > $selectedline} {
4017 global matchinglines selectedline
4018 if {![info exists matchinglines]} {
4022 if {![info exists selectedline]} return
4024 foreach l $matchinglines {
4025 if {$l >= $selectedline} break
4029 findselectline $prev
4035 proc stopfindproc {{done 0}} {
4036 global findprocpid findprocfile findids
4037 global ctext findoldcursor phase maincursor textcursor
4038 global findinprogress
4040 catch {unset findids}
4041 if {[info exists findprocpid]} {
4043 catch {exec kill $findprocpid}
4045 catch {close $findprocfile}
4048 catch {unset findinprogress}
4052 # mark a commit as matching by putting a yellow background
4053 # behind the headline
4054 proc markheadline {l id} {
4055 global canv mainfont linehtag
4058 set bbox [$canv bbox $linehtag($l)]
4059 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
4063 # mark the bits of a headline, author or date that match a find string
4064 proc markmatches {canv l str tag matches font} {
4065 set bbox [$canv bbox $tag]
4066 set x0 [lindex $bbox 0]
4067 set y0 [lindex $bbox 1]
4068 set y1 [lindex $bbox 3]
4069 foreach match $matches {
4070 set start [lindex $match 0]
4071 set end [lindex $match 1]
4072 if {$start > $end} continue
4073 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4074 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4075 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4076 [expr {$x0+$xlen+2}] $y1 \
4077 -outline {} -tags matches -fill yellow]
4082 proc unmarkmatches {} {
4083 global matchinglines findids
4084 allcanvs delete matches
4085 catch {unset matchinglines}
4086 catch {unset findids}
4089 proc selcanvline {w x y} {
4090 global canv canvy0 ctext linespc
4092 set ymax [lindex [$canv cget -scrollregion] 3]
4093 if {$ymax == {}} return
4094 set yfrac [lindex [$canv yview] 0]
4095 set y [expr {$y + $yfrac * $ymax}]
4096 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4101 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4107 proc commit_descriptor {p} {
4109 if {![info exists commitinfo($p)]} {
4113 if {[llength $commitinfo($p)] > 1} {
4114 set l [lindex $commitinfo($p) 0]
4119 # append some text to the ctext widget, and make any SHA1 ID
4120 # that we know about be a clickable link.
4121 proc appendwithlinks {text tags} {
4122 global ctext commitrow linknum curview
4124 set start [$ctext index "end - 1c"]
4125 $ctext insert end $text $tags
4126 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4130 set linkid [string range $text $s $e]
4131 if {![info exists commitrow($curview,$linkid)]} continue
4133 $ctext tag add link "$start + $s c" "$start + $e c"
4134 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4135 $ctext tag bind link$linknum <1> \
4136 [list selectline $commitrow($curview,$linkid) 1]
4139 $ctext tag conf link -foreground blue -underline 1
4140 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4141 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4144 proc viewnextline {dir} {
4148 set ymax [lindex [$canv cget -scrollregion] 3]
4149 set wnow [$canv yview]
4150 set wtop [expr {[lindex $wnow 0] * $ymax}]
4151 set newtop [expr {$wtop + $dir * $linespc}]
4154 } elseif {$newtop > $ymax} {
4157 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4160 # add a list of tag or branch names at position pos
4161 # returns the number of names inserted
4162 proc appendrefs {pos ids var} {
4163 global ctext commitrow linknum curview $var maxrefs
4165 if {[catch {$ctext index $pos}]} {
4168 $ctext conf -state normal
4169 $ctext delete $pos "$pos lineend"
4172 foreach tag [set $var\($id\)] {
4173 lappend tags [list $tag $id]
4176 if {[llength $tags] > $maxrefs} {
4177 $ctext insert $pos "many ([llength $tags])"
4179 set tags [lsort -index 0 -decreasing $tags]
4182 set id [lindex $ti 1]
4185 $ctext tag delete $lk
4186 $ctext insert $pos $sep
4187 $ctext insert $pos [lindex $ti 0] $lk
4188 if {[info exists commitrow($curview,$id)]} {
4189 $ctext tag conf $lk -foreground blue
4190 $ctext tag bind $lk <1> \
4191 [list selectline $commitrow($curview,$id) 1]
4192 $ctext tag conf $lk -underline 1
4193 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4194 $ctext tag bind $lk <Leave> \
4195 { %W configure -cursor $curtextcursor }
4200 $ctext conf -state disabled
4201 return [llength $tags]
4204 # called when we have finished computing the nearby tags
4205 proc dispneartags {delay} {
4206 global selectedline currentid showneartags tagphase
4208 if {![info exists selectedline] || !$showneartags} return
4209 after cancel dispnexttag
4211 after 200 dispnexttag
4214 after idle dispnexttag
4219 proc dispnexttag {} {
4220 global selectedline currentid showneartags tagphase ctext
4222 if {![info exists selectedline] || !$showneartags} return
4223 switch -- $tagphase {
4225 set dtags [desctags $currentid]
4227 appendrefs precedes $dtags idtags
4231 set atags [anctags $currentid]
4233 appendrefs follows $atags idtags
4237 set dheads [descheads $currentid]
4238 if {$dheads ne {}} {
4239 if {[appendrefs branch $dheads idheads] > 1
4240 && [$ctext get "branch -3c"] eq "h"} {
4241 # turn "Branch" into "Branches"
4242 $ctext conf -state normal
4243 $ctext insert "branch -2c" "es"
4244 $ctext conf -state disabled
4249 if {[incr tagphase] <= 2} {
4250 after idle dispnexttag
4254 proc selectline {l isnew} {
4255 global canv canv2 canv3 ctext commitinfo selectedline
4256 global displayorder linehtag linentag linedtag
4257 global canvy0 linespc parentlist children curview
4258 global currentid sha1entry
4259 global commentend idtags linknum
4260 global mergemax numcommits pending_select
4261 global cmitmode showneartags allcommits
4263 catch {unset pending_select}
4266 cancel_next_highlight
4267 if {$l < 0 || $l >= $numcommits} return
4268 set y [expr {$canvy0 + $l * $linespc}]
4269 set ymax [lindex [$canv cget -scrollregion] 3]
4270 set ytop [expr {$y - $linespc - 1}]
4271 set ybot [expr {$y + $linespc + 1}]
4272 set wnow [$canv yview]
4273 set wtop [expr {[lindex $wnow 0] * $ymax}]
4274 set wbot [expr {[lindex $wnow 1] * $ymax}]
4275 set wh [expr {$wbot - $wtop}]
4277 if {$ytop < $wtop} {
4278 if {$ybot < $wtop} {
4279 set newtop [expr {$y - $wh / 2.0}]
4282 if {$newtop > $wtop - $linespc} {
4283 set newtop [expr {$wtop - $linespc}]
4286 } elseif {$ybot > $wbot} {
4287 if {$ytop > $wbot} {
4288 set newtop [expr {$y - $wh / 2.0}]
4290 set newtop [expr {$ybot - $wh}]
4291 if {$newtop < $wtop + $linespc} {
4292 set newtop [expr {$wtop + $linespc}]
4296 if {$newtop != $wtop} {
4300 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4304 if {![info exists linehtag($l)]} return
4306 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4307 -tags secsel -fill [$canv cget -selectbackground]]
4309 $canv2 delete secsel
4310 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4311 -tags secsel -fill [$canv2 cget -selectbackground]]
4313 $canv3 delete secsel
4314 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4315 -tags secsel -fill [$canv3 cget -selectbackground]]
4319 addtohistory [list selectline $l 0]
4324 set id [lindex $displayorder $l]
4326 $sha1entry delete 0 end
4327 $sha1entry insert 0 $id
4328 $sha1entry selection from 0
4329 $sha1entry selection to end
4332 $ctext conf -state normal
4335 set info $commitinfo($id)
4336 set date [formatdate [lindex $info 2]]
4337 $ctext insert end "Author: [lindex $info 1] $date\n"
4338 set date [formatdate [lindex $info 4]]
4339 $ctext insert end "Committer: [lindex $info 3] $date\n"
4340 if {[info exists idtags($id)]} {
4341 $ctext insert end "Tags:"
4342 foreach tag $idtags($id) {
4343 $ctext insert end " $tag"
4345 $ctext insert end "\n"
4349 set olds [lindex $parentlist $l]
4350 if {[llength $olds] > 1} {
4353 if {$np >= $mergemax} {
4358 $ctext insert end "Parent: " $tag
4359 appendwithlinks [commit_descriptor $p] {}
4364 append headers "Parent: [commit_descriptor $p]"
4368 foreach c $children($curview,$id) {
4369 append headers "Child: [commit_descriptor $c]"
4372 # make anything that looks like a SHA1 ID be a clickable link
4373 appendwithlinks $headers {}
4374 if {$showneartags} {
4375 if {![info exists allcommits]} {
4378 $ctext insert end "Branch: "
4379 $ctext mark set branch "end -1c"
4380 $ctext mark gravity branch left
4381 $ctext insert end "\nFollows: "
4382 $ctext mark set follows "end -1c"
4383 $ctext mark gravity follows left
4384 $ctext insert end "\nPrecedes: "
4385 $ctext mark set precedes "end -1c"
4386 $ctext mark gravity precedes left
4387 $ctext insert end "\n"
4390 $ctext insert end "\n"
4391 set comment [lindex $info 5]
4392 if {[string first "\r" $comment] >= 0} {
4393 set comment [string map {"\r" "\n "} $comment]
4395 appendwithlinks $comment {comment}
4397 $ctext tag delete Comments
4398 $ctext tag remove found 1.0 end
4399 $ctext conf -state disabled
4400 set commentend [$ctext index "end - 1c"]
4402 init_flist "Comments"
4403 if {$cmitmode eq "tree"} {
4405 } elseif {[llength $olds] <= 1} {
4412 proc selfirstline {} {
4417 proc sellastline {} {
4420 set l [expr {$numcommits - 1}]
4424 proc selnextline {dir} {
4426 if {![info exists selectedline]} return
4427 set l [expr {$selectedline + $dir}]
4432 proc selnextpage {dir} {
4433 global canv linespc selectedline numcommits
4435 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4439 allcanvs yview scroll [expr {$dir * $lpp}] units
4441 if {![info exists selectedline]} return
4442 set l [expr {$selectedline + $dir * $lpp}]
4445 } elseif {$l >= $numcommits} {
4446 set l [expr $numcommits - 1]
4452 proc unselectline {} {
4453 global selectedline currentid
4455 catch {unset selectedline}
4456 catch {unset currentid}
4457 allcanvs delete secsel
4459 cancel_next_highlight
4462 proc reselectline {} {
4465 if {[info exists selectedline]} {
4466 selectline $selectedline 0
4470 proc addtohistory {cmd} {
4471 global history historyindex curview
4473 set elt [list $curview $cmd]
4474 if {$historyindex > 0
4475 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4479 if {$historyindex < [llength $history]} {
4480 set history [lreplace $history $historyindex end $elt]
4482 lappend history $elt
4485 if {$historyindex > 1} {
4486 .tf.bar.leftbut conf -state normal
4488 .tf.bar.leftbut conf -state disabled
4490 .tf.bar.rightbut conf -state disabled
4496 set view [lindex $elt 0]
4497 set cmd [lindex $elt 1]
4498 if {$curview != $view} {
4505 global history historyindex
4507 if {$historyindex > 1} {
4508 incr historyindex -1
4509 godo [lindex $history [expr {$historyindex - 1}]]
4510 .tf.bar.rightbut conf -state normal
4512 if {$historyindex <= 1} {
4513 .tf.bar.leftbut conf -state disabled
4518 global history historyindex
4520 if {$historyindex < [llength $history]} {
4521 set cmd [lindex $history $historyindex]
4524 .tf.bar.leftbut conf -state normal
4526 if {$historyindex >= [llength $history]} {
4527 .tf.bar.rightbut conf -state disabled
4532 global treefilelist treeidlist diffids diffmergeid treepending nullid
4535 catch {unset diffmergeid}
4536 if {![info exists treefilelist($id)]} {
4537 if {![info exists treepending]} {
4538 if {$id ne $nullid} {
4539 set cmd [concat | git ls-tree -r $id]
4541 set cmd [concat | git ls-files]
4543 if {[catch {set gtf [open $cmd r]}]} {
4547 set treefilelist($id) {}
4548 set treeidlist($id) {}
4549 fconfigure $gtf -blocking 0
4550 filerun $gtf [list gettreeline $gtf $id]
4557 proc gettreeline {gtf id} {
4558 global treefilelist treeidlist treepending cmitmode diffids nullid
4561 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4562 if {$diffids ne $nullid} {
4563 set tl [split $line "\t"]
4564 if {[lindex $tl 0 1] ne "blob"} continue
4565 set sha1 [lindex $tl 0 2]
4566 set fname [lindex $tl 1]
4567 if {[string index $fname 0] eq "\""} {
4568 set fname [lindex $fname 0]
4570 lappend treeidlist($id) $sha1
4574 lappend treefilelist($id) $fname
4577 return [expr {$nl >= 1000? 2: 1}]
4581 if {$cmitmode ne "tree"} {
4582 if {![info exists diffmergeid]} {
4583 gettreediffs $diffids
4585 } elseif {$id ne $diffids} {
4594 global treefilelist treeidlist diffids nullid
4595 global ctext commentend
4597 set i [lsearch -exact $treefilelist($diffids) $f]
4599 puts "oops, $f not in list for id $diffids"
4602 if {$diffids ne $nullid} {
4603 set blob [lindex $treeidlist($diffids) $i]
4604 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4605 puts "oops, error reading blob $blob: $err"
4609 if {[catch {set bf [open $f r]} err]} {
4610 puts "oops, can't read $f: $err"
4614 fconfigure $bf -blocking 0
4615 filerun $bf [list getblobline $bf $diffids]
4616 $ctext config -state normal
4617 clear_ctext $commentend
4618 $ctext insert end "\n"
4619 $ctext insert end "$f\n" filesep
4620 $ctext config -state disabled
4621 $ctext yview $commentend
4624 proc getblobline {bf id} {
4625 global diffids cmitmode ctext
4627 if {$id ne $diffids || $cmitmode ne "tree"} {
4631 $ctext config -state normal
4633 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4634 $ctext insert end "$line\n"
4637 # delete last newline
4638 $ctext delete "end - 2c" "end - 1c"
4642 $ctext config -state disabled
4643 return [expr {$nl >= 1000? 2: 1}]
4646 proc mergediff {id l} {
4647 global diffmergeid diffopts mdifffd
4653 # this doesn't seem to actually affect anything...
4654 set env(GIT_DIFF_OPTS) $diffopts
4655 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4656 if {[catch {set mdf [open $cmd r]} err]} {
4657 error_popup "Error getting merge diffs: $err"
4660 fconfigure $mdf -blocking 0
4661 set mdifffd($id) $mdf
4662 set np [llength [lindex $parentlist $l]]
4663 filerun $mdf [list getmergediffline $mdf $id $np]
4666 proc getmergediffline {mdf id np} {
4667 global diffmergeid ctext cflist mergemax
4668 global difffilestart mdifffd
4670 $ctext conf -state normal
4672 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4673 if {![info exists diffmergeid] || $id != $diffmergeid
4674 || $mdf != $mdifffd($id)} {
4678 if {[regexp {^diff --cc (.*)} $line match fname]} {
4679 # start of a new file
4680 $ctext insert end "\n"
4681 set here [$ctext index "end - 1c"]
4682 lappend difffilestart $here
4683 add_flist [list $fname]
4684 set l [expr {(78 - [string length $fname]) / 2}]
4685 set pad [string range "----------------------------------------" 1 $l]
4686 $ctext insert end "$pad $fname $pad\n" filesep
4687 } elseif {[regexp {^@@} $line]} {
4688 $ctext insert end "$line\n" hunksep
4689 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4692 # parse the prefix - one ' ', '-' or '+' for each parent
4697 for {set j 0} {$j < $np} {incr j} {
4698 set c [string range $line $j $j]
4701 } elseif {$c == "-"} {
4703 } elseif {$c == "+"} {
4712 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4713 # line doesn't appear in result, parents in $minuses have the line
4714 set num [lindex $minuses 0]
4715 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4716 # line appears in result, parents in $pluses don't have the line
4717 lappend tags mresult
4718 set num [lindex $spaces 0]
4721 if {$num >= $mergemax} {
4726 $ctext insert end "$line\n" $tags
4729 $ctext conf -state disabled
4734 return [expr {$nr >= 1000? 2: 1}]
4737 proc startdiff {ids} {
4738 global treediffs diffids treepending diffmergeid nullid
4741 catch {unset diffmergeid}
4742 if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4743 if {![info exists treepending]} {
4751 proc addtocflist {ids} {
4752 global treediffs cflist
4753 add_flist $treediffs($ids)
4757 proc diffcmd {ids flags} {
4760 set i [lsearch -exact $ids $nullid]
4762 set cmd [concat | git diff-index $flags]
4763 if {[llength $ids] > 1} {
4765 lappend cmd -R [lindex $ids 1]
4767 lappend cmd [lindex $ids 0]
4773 set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4778 proc gettreediffs {ids} {
4779 global treediff treepending
4781 set treepending $ids
4783 if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4784 fconfigure $gdtf -blocking 0
4785 filerun $gdtf [list gettreediffline $gdtf $ids]
4788 proc gettreediffline {gdtf ids} {
4789 global treediff treediffs treepending diffids diffmergeid
4793 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4794 set file [lindex $line 5]
4795 lappend treediff $file
4798 return [expr {$nr >= 1000? 2: 1}]
4801 set treediffs($ids) $treediff
4803 if {$cmitmode eq "tree"} {
4805 } elseif {$ids != $diffids} {
4806 if {![info exists diffmergeid]} {
4807 gettreediffs $diffids
4815 proc getblobdiffs {ids} {
4816 global diffopts blobdifffd diffids env curdifftag curtagstart
4817 global diffinhdr treediffs
4819 set env(GIT_DIFF_OPTS) $diffopts
4820 if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4821 puts "error getting diffs: $err"
4825 fconfigure $bdf -blocking 0
4826 set blobdifffd($ids) $bdf
4827 set curdifftag Comments
4829 filerun $bdf [list getblobdiffline $bdf $diffids]
4832 proc setinlist {var i val} {
4835 while {[llength [set $var]] < $i} {
4838 if {[llength [set $var]] == $i} {
4845 proc getblobdiffline {bdf ids} {
4846 global diffids blobdifffd ctext curdifftag curtagstart
4847 global diffnexthead diffnextnote difffilestart
4848 global diffinhdr treediffs
4851 $ctext conf -state normal
4852 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4853 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4857 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4858 # start of a new file
4859 $ctext insert end "\n"
4860 $ctext tag add $curdifftag $curtagstart end
4861 set here [$ctext index "end - 1c"]
4862 set curtagstart $here
4864 set i [lsearch -exact $treediffs($ids) $fname]
4866 setinlist difffilestart $i $here
4868 if {$newname ne $fname} {
4869 set i [lsearch -exact $treediffs($ids) $newname]
4871 setinlist difffilestart $i $here
4874 set curdifftag "f:$fname"
4875 $ctext tag delete $curdifftag
4876 set l [expr {(78 - [string length $header]) / 2}]
4877 set pad [string range "----------------------------------------" \
4879 $ctext insert end "$pad $header $pad\n" filesep
4881 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4883 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4885 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4886 $line match f1l f1c f2l f2c rest]} {
4887 $ctext insert end "$line\n" hunksep
4890 set x [string range $line 0 0]
4891 if {$x == "-" || $x == "+"} {
4892 set tag [expr {$x == "+"}]
4893 $ctext insert end "$line\n" d$tag
4894 } elseif {$x == " "} {
4895 $ctext insert end "$line\n"
4896 } elseif {$diffinhdr || $x == "\\"} {
4897 # e.g. "\ No newline at end of file"
4898 $ctext insert end "$line\n" filesep
4900 # Something else we don't recognize
4901 if {$curdifftag != "Comments"} {
4902 $ctext insert end "\n"
4903 $ctext tag add $curdifftag $curtagstart end
4904 set curtagstart [$ctext index "end - 1c"]
4905 set curdifftag Comments
4907 $ctext insert end "$line\n" filesep
4911 $ctext conf -state disabled
4914 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4915 $ctext tag add $curdifftag $curtagstart end
4919 return [expr {$nr >= 1000? 2: 1}]
4922 proc changediffdisp {} {
4923 global ctext diffelide
4925 $ctext tag conf d0 -elide [lindex $diffelide 0]
4926 $ctext tag conf d1 -elide [lindex $diffelide 1]
4930 global difffilestart ctext
4931 set prev [lindex $difffilestart 0]
4932 set here [$ctext index @0,0]
4933 foreach loc $difffilestart {
4934 if {[$ctext compare $loc >= $here]} {
4944 global difffilestart ctext
4945 set here [$ctext index @0,0]
4946 foreach loc $difffilestart {
4947 if {[$ctext compare $loc > $here]} {
4954 proc clear_ctext {{first 1.0}} {
4955 global ctext smarktop smarkbot
4957 set l [lindex [split $first .] 0]
4958 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4961 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4964 $ctext delete $first end
4967 proc incrsearch {name ix op} {
4968 global ctext searchstring searchdirn
4970 $ctext tag remove found 1.0 end
4971 if {[catch {$ctext index anchor}]} {
4972 # no anchor set, use start of selection, or of visible area
4973 set sel [$ctext tag ranges sel]
4975 $ctext mark set anchor [lindex $sel 0]
4976 } elseif {$searchdirn eq "-forwards"} {
4977 $ctext mark set anchor @0,0
4979 $ctext mark set anchor @0,[winfo height $ctext]
4982 if {$searchstring ne {}} {
4983 set here [$ctext search $searchdirn -- $searchstring anchor]
4992 global sstring ctext searchstring searchdirn
4995 $sstring icursor end
4996 set searchdirn -forwards
4997 if {$searchstring ne {}} {
4998 set sel [$ctext tag ranges sel]
5000 set start "[lindex $sel 0] + 1c"
5001 } elseif {[catch {set start [$ctext index anchor]}]} {
5004 set match [$ctext search -count mlen -- $searchstring $start]
5005 $ctext tag remove sel 1.0 end
5011 set mend "$match + $mlen c"
5012 $ctext tag add sel $match $mend
5013 $ctext mark unset anchor
5017 proc dosearchback {} {
5018 global sstring ctext searchstring searchdirn
5021 $sstring icursor end
5022 set searchdirn -backwards
5023 if {$searchstring ne {}} {
5024 set sel [$ctext tag ranges sel]
5026 set start [lindex $sel 0]
5027 } elseif {[catch {set start [$ctext index anchor]}]} {
5028 set start @0,[winfo height $ctext]
5030 set match [$ctext search -backwards -count ml -- $searchstring $start]
5031 $ctext tag remove sel 1.0 end
5037 set mend "$match + $ml c"
5038 $ctext tag add sel $match $mend
5039 $ctext mark unset anchor
5043 proc searchmark {first last} {
5044 global ctext searchstring
5048 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5049 if {$match eq {}} break
5050 set mend "$match + $mlen c"
5051 $ctext tag add found $match $mend
5055 proc searchmarkvisible {doall} {
5056 global ctext smarktop smarkbot
5058 set topline [lindex [split [$ctext index @0,0] .] 0]
5059 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5060 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5061 # no overlap with previous
5062 searchmark $topline $botline
5063 set smarktop $topline
5064 set smarkbot $botline
5066 if {$topline < $smarktop} {
5067 searchmark $topline [expr {$smarktop-1}]
5068 set smarktop $topline
5070 if {$botline > $smarkbot} {
5071 searchmark [expr {$smarkbot+1}] $botline
5072 set smarkbot $botline
5077 proc scrolltext {f0 f1} {
5080 .bleft.sb set $f0 $f1
5081 if {$searchstring ne {}} {
5087 global linespc charspc canvx0 canvy0 mainfont
5088 global xspc1 xspc2 lthickness
5090 set linespc [font metrics $mainfont -linespace]
5091 set charspc [font measure $mainfont "m"]
5092 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5093 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5094 set lthickness [expr {int($linespc / 9) + 1}]
5095 set xspc1(0) $linespc
5103 set ymax [lindex [$canv cget -scrollregion] 3]
5104 if {$ymax eq {} || $ymax == 0} return
5105 set span [$canv yview]
5108 allcanvs yview moveto [lindex $span 0]
5110 if {[info exists selectedline]} {
5111 selectline $selectedline 0
5112 allcanvs yview moveto [lindex $span 0]
5116 proc incrfont {inc} {
5117 global mainfont textfont ctext canv phase cflist
5118 global charspc tabstop
5119 global stopped entries
5121 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5122 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5124 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5125 $cflist conf -font $textfont
5126 $ctext tag conf filesep -font [concat $textfont bold]
5127 foreach e $entries {
5128 $e conf -font $mainfont
5130 if {$phase eq "getcommits"} {
5131 $canv itemconf textitems -font $mainfont
5137 global sha1entry sha1string
5138 if {[string length $sha1string] == 40} {
5139 $sha1entry delete 0 end
5143 proc sha1change {n1 n2 op} {
5144 global sha1string currentid sha1but
5145 if {$sha1string == {}
5146 || ([info exists currentid] && $sha1string == $currentid)} {
5151 if {[$sha1but cget -state] == $state} return
5152 if {$state == "normal"} {
5153 $sha1but conf -state normal -relief raised -text "Goto: "
5155 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5159 proc gotocommit {} {
5160 global sha1string currentid commitrow tagids headids
5161 global displayorder numcommits curview
5163 if {$sha1string == {}
5164 || ([info exists currentid] && $sha1string == $currentid)} return
5165 if {[info exists tagids($sha1string)]} {
5166 set id $tagids($sha1string)
5167 } elseif {[info exists headids($sha1string)]} {
5168 set id $headids($sha1string)
5170 set id [string tolower $sha1string]
5171 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5173 foreach i $displayorder {
5174 if {[string match $id* $i]} {
5178 if {$matches ne {}} {
5179 if {[llength $matches] > 1} {
5180 error_popup "Short SHA1 id $id is ambiguous"
5183 set id [lindex $matches 0]
5187 if {[info exists commitrow($curview,$id)]} {
5188 selectline $commitrow($curview,$id) 1
5191 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5196 error_popup "$type $sha1string is not known"
5199 proc lineenter {x y id} {
5200 global hoverx hovery hoverid hovertimer
5201 global commitinfo canv
5203 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5207 if {[info exists hovertimer]} {
5208 after cancel $hovertimer
5210 set hovertimer [after 500 linehover]
5214 proc linemotion {x y id} {
5215 global hoverx hovery hoverid hovertimer
5217 if {[info exists hoverid] && $id == $hoverid} {
5220 if {[info exists hovertimer]} {
5221 after cancel $hovertimer
5223 set hovertimer [after 500 linehover]
5227 proc lineleave {id} {
5228 global hoverid hovertimer canv
5230 if {[info exists hoverid] && $id == $hoverid} {
5232 if {[info exists hovertimer]} {
5233 after cancel $hovertimer
5241 global hoverx hovery hoverid hovertimer
5242 global canv linespc lthickness
5243 global commitinfo mainfont
5245 set text [lindex $commitinfo($hoverid) 0]
5246 set ymax [lindex [$canv cget -scrollregion] 3]
5247 if {$ymax == {}} return
5248 set yfrac [lindex [$canv yview] 0]
5249 set x [expr {$hoverx + 2 * $linespc}]
5250 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5251 set x0 [expr {$x - 2 * $lthickness}]
5252 set y0 [expr {$y - 2 * $lthickness}]
5253 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5254 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5255 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5256 -fill \#ffff80 -outline black -width 1 -tags hover]
5258 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5263 proc clickisonarrow {id y} {
5266 set ranges [rowranges $id]
5267 set thresh [expr {2 * $lthickness + 6}]
5268 set n [expr {[llength $ranges] - 1}]
5269 for {set i 1} {$i < $n} {incr i} {
5270 set row [lindex $ranges $i]
5271 if {abs([yc $row] - $y) < $thresh} {
5278 proc arrowjump {id n y} {
5281 # 1 <-> 2, 3 <-> 4, etc...
5282 set n [expr {(($n - 1) ^ 1) + 1}]
5283 set row [lindex [rowranges $id] $n]
5285 set ymax [lindex [$canv cget -scrollregion] 3]
5286 if {$ymax eq {} || $ymax <= 0} return
5287 set view [$canv yview]
5288 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5289 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5293 allcanvs yview moveto $yfrac
5296 proc lineclick {x y id isnew} {
5297 global ctext commitinfo children canv thickerline curview
5299 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5304 # draw this line thicker than normal
5308 set ymax [lindex [$canv cget -scrollregion] 3]
5309 if {$ymax eq {}} return
5310 set yfrac [lindex [$canv yview] 0]
5311 set y [expr {$y + $yfrac * $ymax}]
5313 set dirn [clickisonarrow $id $y]
5315 arrowjump $id $dirn $y
5320 addtohistory [list lineclick $x $y $id 0]
5322 # fill the details pane with info about this line
5323 $ctext conf -state normal
5325 $ctext tag conf link -foreground blue -underline 1
5326 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5327 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5328 $ctext insert end "Parent:\t"
5329 $ctext insert end $id [list link link0]
5330 $ctext tag bind link0 <1> [list selbyid $id]
5331 set info $commitinfo($id)
5332 $ctext insert end "\n\t[lindex $info 0]\n"
5333 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5334 set date [formatdate [lindex $info 2]]
5335 $ctext insert end "\tDate:\t$date\n"
5336 set kids $children($curview,$id)
5338 $ctext insert end "\nChildren:"
5340 foreach child $kids {
5342 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5343 set info $commitinfo($child)
5344 $ctext insert end "\n\t"
5345 $ctext insert end $child [list link link$i]
5346 $ctext tag bind link$i <1> [list selbyid $child]
5347 $ctext insert end "\n\t[lindex $info 0]"
5348 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5349 set date [formatdate [lindex $info 2]]
5350 $ctext insert end "\n\tDate:\t$date\n"
5353 $ctext conf -state disabled
5357 proc normalline {} {
5359 if {[info exists thickerline]} {
5367 global commitrow curview
5368 if {[info exists commitrow($curview,$id)]} {
5369 selectline $commitrow($curview,$id) 1
5375 if {![info exists startmstime]} {
5376 set startmstime [clock clicks -milliseconds]
5378 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5381 proc rowmenu {x y id} {
5382 global rowctxmenu commitrow selectedline rowmenuid curview
5383 global nullid fakerowmenu mainhead
5386 if {![info exists selectedline]
5387 || $commitrow($curview,$id) eq $selectedline} {
5392 if {$id ne $nullid} {
5393 set menu $rowctxmenu
5394 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5396 set menu $fakerowmenu
5398 $menu entryconfigure "Diff this*" -state $state
5399 $menu entryconfigure "Diff selected*" -state $state
5400 $menu entryconfigure "Make patch" -state $state
5401 tk_popup $menu $x $y
5404 proc diffvssel {dirn} {
5405 global rowmenuid selectedline displayorder
5407 if {![info exists selectedline]} return
5409 set oldid [lindex $displayorder $selectedline]
5410 set newid $rowmenuid
5412 set oldid $rowmenuid
5413 set newid [lindex $displayorder $selectedline]
5415 addtohistory [list doseldiff $oldid $newid]
5416 doseldiff $oldid $newid
5419 proc doseldiff {oldid newid} {
5423 $ctext conf -state normal
5426 $ctext insert end "From "
5427 $ctext tag conf link -foreground blue -underline 1
5428 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5429 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5430 $ctext tag bind link0 <1> [list selbyid $oldid]
5431 $ctext insert end $oldid [list link link0]
5432 $ctext insert end "\n "
5433 $ctext insert end [lindex $commitinfo($oldid) 0]
5434 $ctext insert end "\n\nTo "
5435 $ctext tag bind link1 <1> [list selbyid $newid]
5436 $ctext insert end $newid [list link link1]
5437 $ctext insert end "\n "
5438 $ctext insert end [lindex $commitinfo($newid) 0]
5439 $ctext insert end "\n"
5440 $ctext conf -state disabled
5441 $ctext tag delete Comments
5442 $ctext tag remove found 1.0 end
5443 startdiff [list $oldid $newid]
5447 global rowmenuid currentid commitinfo patchtop patchnum
5449 if {![info exists currentid]} return
5450 set oldid $currentid
5451 set oldhead [lindex $commitinfo($oldid) 0]
5452 set newid $rowmenuid
5453 set newhead [lindex $commitinfo($newid) 0]
5456 catch {destroy $top}
5458 label $top.title -text "Generate patch"
5459 grid $top.title - -pady 10
5460 label $top.from -text "From:"
5461 entry $top.fromsha1 -width 40 -relief flat
5462 $top.fromsha1 insert 0 $oldid
5463 $top.fromsha1 conf -state readonly
5464 grid $top.from $top.fromsha1 -sticky w
5465 entry $top.fromhead -width 60 -relief flat
5466 $top.fromhead insert 0 $oldhead
5467 $top.fromhead conf -state readonly
5468 grid x $top.fromhead -sticky w
5469 label $top.to -text "To:"
5470 entry $top.tosha1 -width 40 -relief flat
5471 $top.tosha1 insert 0 $newid
5472 $top.tosha1 conf -state readonly
5473 grid $top.to $top.tosha1 -sticky w
5474 entry $top.tohead -width 60 -relief flat
5475 $top.tohead insert 0 $newhead
5476 $top.tohead conf -state readonly
5477 grid x $top.tohead -sticky w
5478 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5479 grid $top.rev x -pady 10
5480 label $top.flab -text "Output file:"
5481 entry $top.fname -width 60
5482 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5484 grid $top.flab $top.fname -sticky w
5486 button $top.buts.gen -text "Generate" -command mkpatchgo
5487 button $top.buts.can -text "Cancel" -command mkpatchcan
5488 grid $top.buts.gen $top.buts.can
5489 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5490 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5491 grid $top.buts - -pady 10 -sticky ew
5495 proc mkpatchrev {} {
5498 set oldid [$patchtop.fromsha1 get]
5499 set oldhead [$patchtop.fromhead get]
5500 set newid [$patchtop.tosha1 get]
5501 set newhead [$patchtop.tohead get]
5502 foreach e [list fromsha1 fromhead tosha1 tohead] \
5503 v [list $newid $newhead $oldid $oldhead] {
5504 $patchtop.$e conf -state normal
5505 $patchtop.$e delete 0 end
5506 $patchtop.$e insert 0 $v
5507 $patchtop.$e conf -state readonly
5512 global patchtop nullid
5514 set oldid [$patchtop.fromsha1 get]
5515 set newid [$patchtop.tosha1 get]
5516 set fname [$patchtop.fname get]
5517 if {$newid eq $nullid} {
5518 set cmd [list git diff-index -p $oldid]
5519 } elseif {$oldid eq $nullid} {
5520 set cmd [list git diff-index -p -R $newid]
5522 set cmd [list git diff-tree -p $oldid $newid]
5524 lappend cmd >$fname &
5525 if {[catch {eval exec $cmd} err]} {
5526 error_popup "Error creating patch: $err"
5528 catch {destroy $patchtop}
5532 proc mkpatchcan {} {
5535 catch {destroy $patchtop}
5540 global rowmenuid mktagtop commitinfo
5544 catch {destroy $top}
5546 label $top.title -text "Create tag"
5547 grid $top.title - -pady 10
5548 label $top.id -text "ID:"
5549 entry $top.sha1 -width 40 -relief flat
5550 $top.sha1 insert 0 $rowmenuid
5551 $top.sha1 conf -state readonly
5552 grid $top.id $top.sha1 -sticky w
5553 entry $top.head -width 60 -relief flat
5554 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5555 $top.head conf -state readonly
5556 grid x $top.head -sticky w
5557 label $top.tlab -text "Tag name:"
5558 entry $top.tag -width 60
5559 grid $top.tlab $top.tag -sticky w
5561 button $top.buts.gen -text "Create" -command mktaggo
5562 button $top.buts.can -text "Cancel" -command mktagcan
5563 grid $top.buts.gen $top.buts.can
5564 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5565 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5566 grid $top.buts - -pady 10 -sticky ew
5571 global mktagtop env tagids idtags
5573 set id [$mktagtop.sha1 get]
5574 set tag [$mktagtop.tag get]
5576 error_popup "No tag name specified"
5579 if {[info exists tagids($tag)]} {
5580 error_popup "Tag \"$tag\" already exists"
5585 set fname [file join $dir "refs/tags" $tag]
5586 set f [open $fname w]
5590 error_popup "Error creating tag: $err"
5594 set tagids($tag) $id
5595 lappend idtags($id) $tag
5600 proc redrawtags {id} {
5601 global canv linehtag commitrow idpos selectedline curview
5602 global mainfont canvxmax iddrawn
5604 if {![info exists commitrow($curview,$id)]} return
5605 if {![info exists iddrawn($id)]} return
5606 drawcommits $commitrow($curview,$id)
5607 $canv delete tag.$id
5608 set xt [eval drawtags $id $idpos($id)]
5609 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5610 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5611 set xr [expr {$xt + [font measure $mainfont $text]}]
5612 if {$xr > $canvxmax} {
5616 if {[info exists selectedline]
5617 && $selectedline == $commitrow($curview,$id)} {
5618 selectline $selectedline 0
5625 catch {destroy $mktagtop}
5634 proc writecommit {} {
5635 global rowmenuid wrcomtop commitinfo wrcomcmd
5637 set top .writecommit
5639 catch {destroy $top}
5641 label $top.title -text "Write commit to file"
5642 grid $top.title - -pady 10
5643 label $top.id -text "ID:"
5644 entry $top.sha1 -width 40 -relief flat
5645 $top.sha1 insert 0 $rowmenuid
5646 $top.sha1 conf -state readonly
5647 grid $top.id $top.sha1 -sticky w
5648 entry $top.head -width 60 -relief flat
5649 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5650 $top.head conf -state readonly
5651 grid x $top.head -sticky w
5652 label $top.clab -text "Command:"
5653 entry $top.cmd -width 60 -textvariable wrcomcmd
5654 grid $top.clab $top.cmd -sticky w -pady 10
5655 label $top.flab -text "Output file:"
5656 entry $top.fname -width 60
5657 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5658 grid $top.flab $top.fname -sticky w
5660 button $top.buts.gen -text "Write" -command wrcomgo
5661 button $top.buts.can -text "Cancel" -command wrcomcan
5662 grid $top.buts.gen $top.buts.can
5663 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5664 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5665 grid $top.buts - -pady 10 -sticky ew
5672 set id [$wrcomtop.sha1 get]
5673 set cmd "echo $id | [$wrcomtop.cmd get]"
5674 set fname [$wrcomtop.fname get]
5675 if {[catch {exec sh -c $cmd >$fname &} err]} {
5676 error_popup "Error writing commit: $err"
5678 catch {destroy $wrcomtop}
5685 catch {destroy $wrcomtop}
5690 global rowmenuid mkbrtop
5693 catch {destroy $top}
5695 label $top.title -text "Create new branch"
5696 grid $top.title - -pady 10
5697 label $top.id -text "ID:"
5698 entry $top.sha1 -width 40 -relief flat
5699 $top.sha1 insert 0 $rowmenuid
5700 $top.sha1 conf -state readonly
5701 grid $top.id $top.sha1 -sticky w
5702 label $top.nlab -text "Name:"
5703 entry $top.name -width 40
5704 grid $top.nlab $top.name -sticky w
5706 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5707 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5708 grid $top.buts.go $top.buts.can
5709 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5710 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5711 grid $top.buts - -pady 10 -sticky ew
5716 global headids idheads
5718 set name [$top.name get]
5719 set id [$top.sha1 get]
5721 error_popup "Please specify a name for the new branch"
5724 catch {destroy $top}
5728 exec git branch $name $id
5733 set headids($name) $id
5734 lappend idheads($id) $name
5742 proc cherrypick {} {
5743 global rowmenuid curview commitrow
5746 set oldhead [exec git rev-parse HEAD]
5747 set dheads [descheads $rowmenuid]
5748 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5749 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5750 included in branch $mainhead -- really re-apply it?"]
5755 # Unfortunately git-cherry-pick writes stuff to stderr even when
5756 # no error occurs, and exec takes that as an indication of error...
5757 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5762 set newhead [exec git rev-parse HEAD]
5763 if {$newhead eq $oldhead} {
5765 error_popup "No changes committed"
5768 addnewchild $newhead $oldhead
5769 if {[info exists commitrow($curview,$oldhead)]} {
5770 insertrow $commitrow($curview,$oldhead) $newhead
5771 if {$mainhead ne {}} {
5772 movehead $newhead $mainhead
5773 movedhead $newhead $mainhead
5782 global mainheadid mainhead rowmenuid confirm_ok resettype
5783 global showlocalchanges
5786 set w ".confirmreset"
5789 wm title $w "Confirm reset"
5790 message $w.m -text \
5791 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5792 -justify center -aspect 1000
5793 pack $w.m -side top -fill x -padx 20 -pady 20
5794 frame $w.f -relief sunken -border 2
5795 message $w.f.rt -text "Reset type:" -aspect 1000
5796 grid $w.f.rt -sticky w
5798 radiobutton $w.f.soft -value soft -variable resettype -justify left \
5799 -text "Soft: Leave working tree and index untouched"
5800 grid $w.f.soft -sticky w
5801 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5802 -text "Mixed: Leave working tree untouched, reset index"
5803 grid $w.f.mixed -sticky w
5804 radiobutton $w.f.hard -value hard -variable resettype -justify left \
5805 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5806 grid $w.f.hard -sticky w
5807 pack $w.f -side top -fill x
5808 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5809 pack $w.ok -side left -fill x -padx 20 -pady 20
5810 button $w.cancel -text Cancel -command "destroy $w"
5811 pack $w.cancel -side right -fill x -padx 20 -pady 20
5812 bind $w <Visibility> "grab $w; focus $w"
5814 if {!$confirm_ok} return
5816 if {[catch {exec git reset --$resettype $rowmenuid} err]} {
5819 set oldhead $mainheadid
5820 movedhead $rowmenuid $mainhead
5821 set mainheadid $rowmenuid
5823 redrawtags $rowmenuid
5825 if {$showlocalchanges} {
5830 # context menu for a head
5831 proc headmenu {x y id head} {
5832 global headmenuid headmenuhead headctxmenu mainhead
5835 set headmenuhead $head
5837 if {$head eq $mainhead} {
5840 $headctxmenu entryconfigure 0 -state $state
5841 $headctxmenu entryconfigure 1 -state $state
5842 tk_popup $headctxmenu $x $y
5846 global headmenuid headmenuhead mainhead headids
5847 global showlocalchanges mainheadid
5849 # check the tree is clean first??
5850 set oldmainhead $mainhead
5855 exec git checkout -q $headmenuhead
5861 set mainhead $headmenuhead
5862 set mainheadid $headmenuid
5863 if {[info exists headids($oldmainhead)]} {
5864 redrawtags $headids($oldmainhead)
5866 redrawtags $headmenuid
5868 if {$showlocalchanges} {
5874 global headmenuid headmenuhead mainhead
5875 global headids idheads
5877 set head $headmenuhead
5879 # this check shouldn't be needed any more...
5880 if {$head eq $mainhead} {
5881 error_popup "Cannot delete the currently checked-out branch"
5884 set dheads [descheads $id]
5885 if {$dheads eq $headids($head)} {
5886 # the stuff on this branch isn't on any other branch
5887 if {![confirm_popup "The commits on branch $head aren't on any other\
5888 branch.\nReally delete branch $head?"]} return
5892 if {[catch {exec git branch -D $head} err]} {
5897 removehead $id $head
5898 removedhead $id $head
5904 # Stuff for finding nearby tags
5905 proc getallcommits {} {
5906 global allcommits allids nbmp nextarc seeds
5916 # Called when the graph might have changed
5917 proc regetallcommits {} {
5918 global allcommits seeds
5920 set cmd [concat | git rev-list --all --parents]
5924 set fd [open $cmd r]
5925 fconfigure $fd -blocking 0
5928 filerun $fd [list getallclines $fd]
5931 # Since most commits have 1 parent and 1 child, we group strings of
5932 # such commits into "arcs" joining branch/merge points (BMPs), which
5933 # are commits that either don't have 1 parent or don't have 1 child.
5935 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5936 # arcout(id) - outgoing arcs for BMP
5937 # arcids(a) - list of IDs on arc including end but not start
5938 # arcstart(a) - BMP ID at start of arc
5939 # arcend(a) - BMP ID at end of arc
5940 # growing(a) - arc a is still growing
5941 # arctags(a) - IDs out of arcids (excluding end) that have tags
5942 # archeads(a) - IDs out of arcids (excluding end) that have heads
5943 # The start of an arc is at the descendent end, so "incoming" means
5944 # coming from descendents, and "outgoing" means going towards ancestors.
5946 proc getallclines {fd} {
5947 global allids allparents allchildren idtags nextarc nbmp
5948 global arcnos arcids arctags arcout arcend arcstart archeads growing
5949 global seeds allcommits
5952 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
5953 set id [lindex $line 0]
5954 if {[info exists allparents($id)]} {
5959 set olds [lrange $line 1 end]
5960 set allparents($id) $olds
5961 if {![info exists allchildren($id)]} {
5962 set allchildren($id) {}
5967 if {[llength $olds] == 1 && [llength $a] == 1} {
5968 lappend arcids($a) $id
5969 if {[info exists idtags($id)]} {
5970 lappend arctags($a) $id
5972 if {[info exists idheads($id)]} {
5973 lappend archeads($a) $id
5975 if {[info exists allparents($olds)]} {
5976 # seen parent already
5977 if {![info exists arcout($olds)]} {
5980 lappend arcids($a) $olds
5981 set arcend($a) $olds
5984 lappend allchildren($olds) $id
5985 lappend arcnos($olds) $a
5990 foreach a $arcnos($id) {
5991 lappend arcids($a) $id
5998 lappend allchildren($p) $id
5999 set a [incr nextarc]
6000 set arcstart($a) $id
6007 if {[info exists allparents($p)]} {
6008 # seen it already, may need to make a new branch
6009 if {![info exists arcout($p)]} {
6012 lappend arcids($a) $p
6016 lappend arcnos($p) $a
6021 return [expr {$nid >= 1000? 2: 1}]
6024 if {[incr allcommits -1] == 0} {
6031 proc recalcarc {a} {
6032 global arctags archeads arcids idtags idheads
6036 foreach id [lrange $arcids($a) 0 end-1] {
6037 if {[info exists idtags($id)]} {
6040 if {[info exists idheads($id)]} {
6045 set archeads($a) $ah
6049 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6050 global arcstart arcend arcout allparents growing
6053 if {[llength $a] != 1} {
6054 puts "oops splitarc called but [llength $a] arcs already"
6058 set i [lsearch -exact $arcids($a) $p]
6060 puts "oops splitarc $p not in arc $a"
6063 set na [incr nextarc]
6064 if {[info exists arcend($a)]} {
6065 set arcend($na) $arcend($a)
6067 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6068 set j [lsearch -exact $arcnos($l) $a]
6069 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6071 set tail [lrange $arcids($a) [expr {$i+1}] end]
6072 set arcids($a) [lrange $arcids($a) 0 $i]
6074 set arcstart($na) $p
6076 set arcids($na) $tail
6077 if {[info exists growing($a)]} {
6084 if {[llength $arcnos($id)] == 1} {
6087 set j [lsearch -exact $arcnos($id) $a]
6088 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6092 # reconstruct tags and heads lists
6093 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6098 set archeads($na) {}
6102 # Update things for a new commit added that is a child of one
6103 # existing commit. Used when cherry-picking.
6104 proc addnewchild {id p} {
6105 global allids allparents allchildren idtags nextarc nbmp
6106 global arcnos arcids arctags arcout arcend arcstart archeads growing
6110 set allparents($id) [list $p]
6111 set allchildren($id) {}
6115 lappend allchildren($p) $id
6116 set a [incr nextarc]
6117 set arcstart($a) $id
6120 set arcids($a) [list $p]
6122 if {![info exists arcout($p)]} {
6125 lappend arcnos($p) $a
6126 set arcout($id) [list $a]
6129 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6130 # or 0 if neither is true.
6131 proc anc_or_desc {a b} {
6132 global arcout arcstart arcend arcnos cached_isanc
6134 if {$arcnos($a) eq $arcnos($b)} {
6135 # Both are on the same arc(s); either both are the same BMP,
6136 # or if one is not a BMP, the other is also not a BMP or is
6137 # the BMP at end of the arc (and it only has 1 incoming arc).
6141 # assert {[llength $arcnos($a)] == 1}
6142 set arc [lindex $arcnos($a) 0]
6143 set i [lsearch -exact $arcids($arc) $a]
6144 set j [lsearch -exact $arcids($arc) $b]
6145 if {$i < 0 || $i > $j} {
6152 if {![info exists arcout($a)]} {
6153 set arc [lindex $arcnos($a) 0]
6154 if {[info exists arcend($arc)]} {
6155 set aend $arcend($arc)
6159 set a $arcstart($arc)
6163 if {![info exists arcout($b)]} {
6164 set arc [lindex $arcnos($b) 0]
6165 if {[info exists arcend($arc)]} {
6166 set bend $arcend($arc)
6170 set b $arcstart($arc)
6180 if {[info exists cached_isanc($a,$bend)]} {
6181 if {$cached_isanc($a,$bend)} {
6185 if {[info exists cached_isanc($b,$aend)]} {
6186 if {$cached_isanc($b,$aend)} {
6189 if {[info exists cached_isanc($a,$bend)]} {
6194 set todo [list $a $b]
6197 for {set i 0} {$i < [llength $todo]} {incr i} {
6198 set x [lindex $todo $i]
6199 if {$anc($x) eq {}} {
6202 foreach arc $arcnos($x) {
6203 set xd $arcstart($arc)
6205 set cached_isanc($a,$bend) 1
6206 set cached_isanc($b,$aend) 0
6208 } elseif {$xd eq $aend} {
6209 set cached_isanc($b,$aend) 1
6210 set cached_isanc($a,$bend) 0
6213 if {![info exists anc($xd)]} {
6214 set anc($xd) $anc($x)
6216 } elseif {$anc($xd) ne $anc($x)} {
6221 set cached_isanc($a,$bend) 0
6222 set cached_isanc($b,$aend) 0
6226 # This identifies whether $desc has an ancestor that is
6227 # a growing tip of the graph and which is not an ancestor of $anc
6228 # and returns 0 if so and 1 if not.
6229 # If we subsequently discover a tag on such a growing tip, and that
6230 # turns out to be a descendent of $anc (which it could, since we
6231 # don't necessarily see children before parents), then $desc
6232 # isn't a good choice to display as a descendent tag of
6233 # $anc (since it is the descendent of another tag which is
6234 # a descendent of $anc). Similarly, $anc isn't a good choice to
6235 # display as a ancestor tag of $desc.
6237 proc is_certain {desc anc} {
6238 global arcnos arcout arcstart arcend growing problems
6241 if {[llength $arcnos($anc)] == 1} {
6242 # tags on the same arc are certain
6243 if {$arcnos($desc) eq $arcnos($anc)} {
6246 if {![info exists arcout($anc)]} {
6247 # if $anc is partway along an arc, use the start of the arc instead
6248 set a [lindex $arcnos($anc) 0]
6249 set anc $arcstart($a)
6252 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6255 set a [lindex $arcnos($desc) 0]
6261 set anclist [list $x]
6265 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6266 set x [lindex $anclist $i]
6271 foreach a $arcout($x) {
6272 if {[info exists growing($a)]} {
6273 if {![info exists growanc($x)] && $dl($x)} {
6279 if {[info exists dl($y)]} {
6283 if {![info exists done($y)]} {
6286 if {[info exists growanc($x)]} {
6290 for {set k 0} {$k < [llength $xl]} {incr k} {
6291 set z [lindex $xl $k]
6292 foreach c $arcout($z) {
6293 if {[info exists arcend($c)]} {
6295 if {[info exists dl($v)] && $dl($v)} {
6297 if {![info exists done($v)]} {
6300 if {[info exists growanc($v)]} {
6310 } elseif {$y eq $anc || !$dl($x)} {
6321 foreach x [array names growanc] {
6330 proc validate_arctags {a} {
6331 global arctags idtags
6335 foreach id $arctags($a) {
6337 if {![info exists idtags($id)]} {
6338 set na [lreplace $na $i $i]
6345 proc validate_archeads {a} {
6346 global archeads idheads
6349 set na $archeads($a)
6350 foreach id $archeads($a) {
6352 if {![info exists idheads($id)]} {
6353 set na [lreplace $na $i $i]
6357 set archeads($a) $na
6360 # Return the list of IDs that have tags that are descendents of id,
6361 # ignoring IDs that are descendents of IDs already reported.
6362 proc desctags {id} {
6363 global arcnos arcstart arcids arctags idtags allparents
6364 global growing cached_dtags
6366 if {![info exists allparents($id)]} {
6369 set t1 [clock clicks -milliseconds]
6371 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6372 # part-way along an arc; check that arc first
6373 set a [lindex $arcnos($id) 0]
6374 if {$arctags($a) ne {}} {
6376 set i [lsearch -exact $arcids($a) $id]
6378 foreach t $arctags($a) {
6379 set j [lsearch -exact $arcids($a) $t]
6387 set id $arcstart($a)
6388 if {[info exists idtags($id)]} {
6392 if {[info exists cached_dtags($id)]} {
6393 return $cached_dtags($id)
6400 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6401 set id [lindex $todo $i]
6403 set ta [info exists hastaggedancestor($id)]
6407 # ignore tags on starting node
6408 if {!$ta && $i > 0} {
6409 if {[info exists idtags($id)]} {
6412 } elseif {[info exists cached_dtags($id)]} {
6413 set tagloc($id) $cached_dtags($id)
6417 foreach a $arcnos($id) {
6419 if {!$ta && $arctags($a) ne {}} {
6421 if {$arctags($a) ne {}} {
6422 lappend tagloc($id) [lindex $arctags($a) end]
6425 if {$ta || $arctags($a) ne {}} {
6426 set tomark [list $d]
6427 for {set j 0} {$j < [llength $tomark]} {incr j} {
6428 set dd [lindex $tomark $j]
6429 if {![info exists hastaggedancestor($dd)]} {
6430 if {[info exists done($dd)]} {
6431 foreach b $arcnos($dd) {
6432 lappend tomark $arcstart($b)
6434 if {[info exists tagloc($dd)]} {
6437 } elseif {[info exists queued($dd)]} {
6440 set hastaggedancestor($dd) 1
6444 if {![info exists queued($d)]} {
6447 if {![info exists hastaggedancestor($d)]} {
6454 foreach id [array names tagloc] {
6455 if {![info exists hastaggedancestor($id)]} {
6456 foreach t $tagloc($id) {
6457 if {[lsearch -exact $tags $t] < 0} {
6463 set t2 [clock clicks -milliseconds]
6466 # remove tags that are descendents of other tags
6467 for {set i 0} {$i < [llength $tags]} {incr i} {
6468 set a [lindex $tags $i]
6469 for {set j 0} {$j < $i} {incr j} {
6470 set b [lindex $tags $j]
6471 set r [anc_or_desc $a $b]
6473 set tags [lreplace $tags $j $j]
6476 } elseif {$r == -1} {
6477 set tags [lreplace $tags $i $i]
6484 if {[array names growing] ne {}} {
6485 # graph isn't finished, need to check if any tag could get
6486 # eclipsed by another tag coming later. Simply ignore any
6487 # tags that could later get eclipsed.
6490 if {[is_certain $t $origid]} {
6494 if {$tags eq $ctags} {
6495 set cached_dtags($origid) $tags
6500 set cached_dtags($origid) $tags
6502 set t3 [clock clicks -milliseconds]
6503 if {0 && $t3 - $t1 >= 100} {
6504 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6505 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6511 global arcnos arcids arcout arcend arctags idtags allparents
6512 global growing cached_atags
6514 if {![info exists allparents($id)]} {
6517 set t1 [clock clicks -milliseconds]
6519 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6520 # part-way along an arc; check that arc first
6521 set a [lindex $arcnos($id) 0]
6522 if {$arctags($a) ne {}} {
6524 set i [lsearch -exact $arcids($a) $id]
6525 foreach t $arctags($a) {
6526 set j [lsearch -exact $arcids($a) $t]
6532 if {![info exists arcend($a)]} {
6536 if {[info exists idtags($id)]} {
6540 if {[info exists cached_atags($id)]} {
6541 return $cached_atags($id)
6549 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6550 set id [lindex $todo $i]
6552 set td [info exists hastaggeddescendent($id)]
6556 # ignore tags on starting node
6557 if {!$td && $i > 0} {
6558 if {[info exists idtags($id)]} {
6561 } elseif {[info exists cached_atags($id)]} {
6562 set tagloc($id) $cached_atags($id)
6566 foreach a $arcout($id) {
6567 if {!$td && $arctags($a) ne {}} {
6569 if {$arctags($a) ne {}} {
6570 lappend tagloc($id) [lindex $arctags($a) 0]
6573 if {![info exists arcend($a)]} continue
6575 if {$td || $arctags($a) ne {}} {
6576 set tomark [list $d]
6577 for {set j 0} {$j < [llength $tomark]} {incr j} {
6578 set dd [lindex $tomark $j]
6579 if {![info exists hastaggeddescendent($dd)]} {
6580 if {[info exists done($dd)]} {
6581 foreach b $arcout($dd) {
6582 if {[info exists arcend($b)]} {
6583 lappend tomark $arcend($b)
6586 if {[info exists tagloc($dd)]} {
6589 } elseif {[info exists queued($dd)]} {
6592 set hastaggeddescendent($dd) 1
6596 if {![info exists queued($d)]} {
6599 if {![info exists hastaggeddescendent($d)]} {
6605 set t2 [clock clicks -milliseconds]
6608 foreach id [array names tagloc] {
6609 if {![info exists hastaggeddescendent($id)]} {
6610 foreach t $tagloc($id) {
6611 if {[lsearch -exact $tags $t] < 0} {
6618 # remove tags that are ancestors of other tags
6619 for {set i 0} {$i < [llength $tags]} {incr i} {
6620 set a [lindex $tags $i]
6621 for {set j 0} {$j < $i} {incr j} {
6622 set b [lindex $tags $j]
6623 set r [anc_or_desc $a $b]
6625 set tags [lreplace $tags $j $j]
6628 } elseif {$r == 1} {
6629 set tags [lreplace $tags $i $i]
6636 if {[array names growing] ne {}} {
6637 # graph isn't finished, need to check if any tag could get
6638 # eclipsed by another tag coming later. Simply ignore any
6639 # tags that could later get eclipsed.
6642 if {[is_certain $origid $t]} {
6646 if {$tags eq $ctags} {
6647 set cached_atags($origid) $tags
6652 set cached_atags($origid) $tags
6654 set t3 [clock clicks -milliseconds]
6655 if {0 && $t3 - $t1 >= 100} {
6656 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6657 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6662 # Return the list of IDs that have heads that are descendents of id,
6663 # including id itself if it has a head.
6664 proc descheads {id} {
6665 global arcnos arcstart arcids archeads idheads cached_dheads
6668 if {![info exists allparents($id)]} {
6672 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6673 # part-way along an arc; check it first
6674 set a [lindex $arcnos($id) 0]
6675 if {$archeads($a) ne {}} {
6676 validate_archeads $a
6677 set i [lsearch -exact $arcids($a) $id]
6678 foreach t $archeads($a) {
6679 set j [lsearch -exact $arcids($a) $t]
6684 set id $arcstart($a)
6689 for {set i 0} {$i < [llength $todo]} {incr i} {
6690 set id [lindex $todo $i]
6691 if {[info exists cached_dheads($id)]} {
6692 set ret [concat $ret $cached_dheads($id)]
6694 if {[info exists idheads($id)]} {
6697 foreach a $arcnos($id) {
6698 if {$archeads($a) ne {}} {
6699 set ret [concat $ret $archeads($a)]
6702 if {![info exists seen($d)]} {
6709 set ret [lsort -unique $ret]
6710 set cached_dheads($origid) $ret
6713 proc addedtag {id} {
6714 global arcnos arcout cached_dtags cached_atags
6716 if {![info exists arcnos($id)]} return
6717 if {![info exists arcout($id)]} {
6718 recalcarc [lindex $arcnos($id) 0]
6720 catch {unset cached_dtags}
6721 catch {unset cached_atags}
6724 proc addedhead {hid head} {
6725 global arcnos arcout cached_dheads
6727 if {![info exists arcnos($hid)]} return
6728 if {![info exists arcout($hid)]} {
6729 recalcarc [lindex $arcnos($hid) 0]
6731 catch {unset cached_dheads}
6734 proc removedhead {hid head} {
6735 global cached_dheads
6737 catch {unset cached_dheads}
6740 proc movedhead {hid head} {
6741 global arcnos arcout cached_dheads
6743 if {![info exists arcnos($hid)]} return
6744 if {![info exists arcout($hid)]} {
6745 recalcarc [lindex $arcnos($hid) 0]
6747 catch {unset cached_dheads}
6750 proc changedrefs {} {
6751 global cached_dheads cached_dtags cached_atags
6752 global arctags archeads arcnos arcout idheads idtags
6754 foreach id [concat [array names idheads] [array names idtags]] {
6755 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6756 set a [lindex $arcnos($id) 0]
6757 if {![info exists donearc($a)]} {
6763 catch {unset cached_dtags}
6764 catch {unset cached_atags}
6765 catch {unset cached_dheads}
6768 proc rereadrefs {} {
6769 global idtags idheads idotherrefs mainhead
6771 set refids [concat [array names idtags] \
6772 [array names idheads] [array names idotherrefs]]
6773 foreach id $refids {
6774 if {![info exists ref($id)]} {
6775 set ref($id) [listrefs $id]
6778 set oldmainhead $mainhead
6781 set refids [lsort -unique [concat $refids [array names idtags] \
6782 [array names idheads] [array names idotherrefs]]]
6783 foreach id $refids {
6784 set v [listrefs $id]
6785 if {![info exists ref($id)] || $ref($id) != $v ||
6786 ($id eq $oldmainhead && $id ne $mainhead) ||
6787 ($id eq $mainhead && $id ne $oldmainhead)} {
6793 proc listrefs {id} {
6794 global idtags idheads idotherrefs
6797 if {[info exists idtags($id)]} {
6801 if {[info exists idheads($id)]} {
6805 if {[info exists idotherrefs($id)]} {
6806 set z $idotherrefs($id)
6808 return [list $x $y $z]
6811 proc showtag {tag isnew} {
6812 global ctext tagcontents tagids linknum tagobjid
6815 addtohistory [list showtag $tag 0]
6817 $ctext conf -state normal
6820 if {![info exists tagcontents($tag)]} {
6822 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6825 if {[info exists tagcontents($tag)]} {
6826 set text $tagcontents($tag)
6828 set text "Tag: $tag\nId: $tagids($tag)"
6830 appendwithlinks $text {}
6831 $ctext conf -state disabled
6843 global maxwidth maxgraphpct diffopts
6844 global oldprefs prefstop showneartags showlocalchanges
6845 global bgcolor fgcolor ctext diffcolors selectbgcolor
6846 global uifont tabstop
6850 if {[winfo exists $top]} {
6854 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6855 set oldprefs($v) [set $v]
6858 wm title $top "Gitk preferences"
6859 label $top.ldisp -text "Commit list display options"
6860 $top.ldisp configure -font $uifont
6861 grid $top.ldisp - -sticky w -pady 10
6862 label $top.spacer -text " "
6863 label $top.maxwidthl -text "Maximum graph width (lines)" \
6865 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6866 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6867 label $top.maxpctl -text "Maximum graph width (% of pane)" \
6869 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6870 grid x $top.maxpctl $top.maxpct -sticky w
6871 frame $top.showlocal
6872 label $top.showlocal.l -text "Show local changes" -font optionfont
6873 checkbutton $top.showlocal.b -variable showlocalchanges
6874 pack $top.showlocal.b $top.showlocal.l -side left
6875 grid x $top.showlocal -sticky w
6877 label $top.ddisp -text "Diff display options"
6878 $top.ddisp configure -font $uifont
6879 grid $top.ddisp - -sticky w -pady 10
6880 label $top.diffoptl -text "Options for diff program" \
6882 entry $top.diffopt -width 20 -textvariable diffopts
6883 grid x $top.diffoptl $top.diffopt -sticky w
6885 label $top.ntag.l -text "Display nearby tags" -font optionfont
6886 checkbutton $top.ntag.b -variable showneartags
6887 pack $top.ntag.b $top.ntag.l -side left
6888 grid x $top.ntag -sticky w
6889 label $top.tabstopl -text "tabstop" -font optionfont
6890 entry $top.tabstop -width 10 -textvariable tabstop
6891 grid x $top.tabstopl $top.tabstop -sticky w
6893 label $top.cdisp -text "Colors: press to choose"
6894 $top.cdisp configure -font $uifont
6895 grid $top.cdisp - -sticky w -pady 10
6896 label $top.bg -padx 40 -relief sunk -background $bgcolor
6897 button $top.bgbut -text "Background" -font optionfont \
6898 -command [list choosecolor bgcolor 0 $top.bg background setbg]
6899 grid x $top.bgbut $top.bg -sticky w
6900 label $top.fg -padx 40 -relief sunk -background $fgcolor
6901 button $top.fgbut -text "Foreground" -font optionfont \
6902 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6903 grid x $top.fgbut $top.fg -sticky w
6904 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6905 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6906 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6907 [list $ctext tag conf d0 -foreground]]
6908 grid x $top.diffoldbut $top.diffold -sticky w
6909 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6910 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6911 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6912 [list $ctext tag conf d1 -foreground]]
6913 grid x $top.diffnewbut $top.diffnew -sticky w
6914 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6915 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6916 -command [list choosecolor diffcolors 2 $top.hunksep \
6917 "diff hunk header" \
6918 [list $ctext tag conf hunksep -foreground]]
6919 grid x $top.hunksepbut $top.hunksep -sticky w
6920 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6921 button $top.selbgbut -text "Select bg" -font optionfont \
6922 -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6923 grid x $top.selbgbut $top.selbgsep -sticky w
6926 button $top.buts.ok -text "OK" -command prefsok -default active
6927 $top.buts.ok configure -font $uifont
6928 button $top.buts.can -text "Cancel" -command prefscan -default normal
6929 $top.buts.can configure -font $uifont
6930 grid $top.buts.ok $top.buts.can
6931 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6932 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6933 grid $top.buts - - -pady 10 -sticky ew
6934 bind $top <Visibility> "focus $top.buts.ok"
6937 proc choosecolor {v vi w x cmd} {
6940 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6941 -title "Gitk: choose color for $x"]
6942 if {$c eq {}} return
6943 $w conf -background $c
6949 global bglist cflist
6951 $w configure -selectbackground $c
6953 $cflist tag configure highlight \
6954 -background [$cflist cget -selectbackground]
6955 allcanvs itemconf secsel -fill $c
6962 $w conf -background $c
6970 $w conf -foreground $c
6972 allcanvs itemconf text -fill $c
6973 $canv itemconf circle -outline $c
6977 global maxwidth maxgraphpct diffopts
6978 global oldprefs prefstop showneartags showlocalchanges
6980 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6981 set $v $oldprefs($v)
6983 catch {destroy $prefstop}
6988 global maxwidth maxgraphpct
6989 global oldprefs prefstop showneartags showlocalchanges
6990 global charspc ctext tabstop
6992 catch {destroy $prefstop}
6994 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
6995 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
6996 if {$showlocalchanges} {
7002 if {$maxwidth != $oldprefs(maxwidth)
7003 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7005 } elseif {$showneartags != $oldprefs(showneartags)} {
7010 proc formatdate {d} {
7012 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7017 # This list of encoding names and aliases is distilled from
7018 # http://www.iana.org/assignments/character-sets.
7019 # Not all of them are supported by Tcl.
7020 set encoding_aliases {
7021 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7022 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7023 { ISO-10646-UTF-1 csISO10646UTF1 }
7024 { ISO_646.basic:1983 ref csISO646basic1983 }
7025 { INVARIANT csINVARIANT }
7026 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7027 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7028 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7029 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7030 { NATS-DANO iso-ir-9-1 csNATSDANO }
7031 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7032 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7033 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7034 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7035 { ISO-2022-KR csISO2022KR }
7037 { ISO-2022-JP csISO2022JP }
7038 { ISO-2022-JP-2 csISO2022JP2 }
7039 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7041 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7042 { IT iso-ir-15 ISO646-IT csISO15Italian }
7043 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7044 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7045 { greek7-old iso-ir-18 csISO18Greek7Old }
7046 { latin-greek iso-ir-19 csISO19LatinGreek }
7047 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7048 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7049 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7050 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7051 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7052 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7053 { INIS iso-ir-49 csISO49INIS }
7054 { INIS-8 iso-ir-50 csISO50INIS8 }
7055 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7056 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7057 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7058 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7059 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7060 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7062 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7063 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7064 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7065 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7066 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7067 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7068 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7069 { greek7 iso-ir-88 csISO88Greek7 }
7070 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7071 { iso-ir-90 csISO90 }
7072 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7073 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7074 csISO92JISC62991984b }
7075 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7076 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7077 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7078 csISO95JIS62291984handadd }
7079 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7080 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7081 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7082 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7084 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7085 { T.61-7bit iso-ir-102 csISO102T617bit }
7086 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7087 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7088 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7089 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7090 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7091 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7092 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7093 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7094 arabic csISOLatinArabic }
7095 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7096 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7097 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7098 greek greek8 csISOLatinGreek }
7099 { T.101-G2 iso-ir-128 csISO128T101G2 }
7100 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7102 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7103 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7104 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7105 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7106 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7107 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7108 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7109 csISOLatinCyrillic }
7110 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7111 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7112 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7113 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7114 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7115 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7116 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7117 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7118 { ISO_10367-box iso-ir-155 csISO10367Box }
7119 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7120 { latin-lap lap iso-ir-158 csISO158Lap }
7121 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7122 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7125 { JIS_X0201 X0201 csHalfWidthKatakana }
7126 { KSC5636 ISO646-KR csKSC5636 }
7127 { ISO-10646-UCS-2 csUnicode }
7128 { ISO-10646-UCS-4 csUCS4 }
7129 { DEC-MCS dec csDECMCS }
7130 { hp-roman8 roman8 r8 csHPRoman8 }
7131 { macintosh mac csMacintosh }
7132 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7134 { IBM038 EBCDIC-INT cp038 csIBM038 }
7135 { IBM273 CP273 csIBM273 }
7136 { IBM274 EBCDIC-BE CP274 csIBM274 }
7137 { IBM275 EBCDIC-BR cp275 csIBM275 }
7138 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7139 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7140 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7141 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7142 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7143 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7144 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7145 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7146 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7147 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7148 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7149 { IBM437 cp437 437 csPC8CodePage437 }
7150 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7151 { IBM775 cp775 csPC775Baltic }
7152 { IBM850 cp850 850 csPC850Multilingual }
7153 { IBM851 cp851 851 csIBM851 }
7154 { IBM852 cp852 852 csPCp852 }
7155 { IBM855 cp855 855 csIBM855 }
7156 { IBM857 cp857 857 csIBM857 }
7157 { IBM860 cp860 860 csIBM860 }
7158 { IBM861 cp861 861 cp-is csIBM861 }
7159 { IBM862 cp862 862 csPC862LatinHebrew }
7160 { IBM863 cp863 863 csIBM863 }
7161 { IBM864 cp864 csIBM864 }
7162 { IBM865 cp865 865 csIBM865 }
7163 { IBM866 cp866 866 csIBM866 }
7164 { IBM868 CP868 cp-ar csIBM868 }
7165 { IBM869 cp869 869 cp-gr csIBM869 }
7166 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7167 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7168 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7169 { IBM891 cp891 csIBM891 }
7170 { IBM903 cp903 csIBM903 }
7171 { IBM904 cp904 904 csIBBM904 }
7172 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7173 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7174 { IBM1026 CP1026 csIBM1026 }
7175 { EBCDIC-AT-DE csIBMEBCDICATDE }
7176 { EBCDIC-AT-DE-A csEBCDICATDEA }
7177 { EBCDIC-CA-FR csEBCDICCAFR }
7178 { EBCDIC-DK-NO csEBCDICDKNO }
7179 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7180 { EBCDIC-FI-SE csEBCDICFISE }
7181 { EBCDIC-FI-SE-A csEBCDICFISEA }
7182 { EBCDIC-FR csEBCDICFR }
7183 { EBCDIC-IT csEBCDICIT }
7184 { EBCDIC-PT csEBCDICPT }
7185 { EBCDIC-ES csEBCDICES }
7186 { EBCDIC-ES-A csEBCDICESA }
7187 { EBCDIC-ES-S csEBCDICESS }
7188 { EBCDIC-UK csEBCDICUK }
7189 { EBCDIC-US csEBCDICUS }
7190 { UNKNOWN-8BIT csUnknown8BiT }
7191 { MNEMONIC csMnemonic }
7196 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7197 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7198 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7199 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7200 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7201 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7202 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7203 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7204 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7205 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7206 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7207 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7208 { IBM1047 IBM-1047 }
7209 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7210 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7211 { UNICODE-1-1 csUnicode11 }
7214 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7215 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7217 { ISO-8859-15 ISO_8859-15 Latin-9 }
7218 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7219 { GBK CP936 MS936 windows-936 }
7220 { JIS_Encoding csJISEncoding }
7221 { Shift_JIS MS_Kanji csShiftJIS }
7222 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7224 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7225 { ISO-10646-UCS-Basic csUnicodeASCII }
7226 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7227 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7228 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7229 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7230 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7231 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7232 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7233 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7234 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7235 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7236 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7237 { Ventura-US csVenturaUS }
7238 { Ventura-International csVenturaInternational }
7239 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7240 { PC8-Turkish csPC8Turkish }
7241 { IBM-Symbols csIBMSymbols }
7242 { IBM-Thai csIBMThai }
7243 { HP-Legal csHPLegal }
7244 { HP-Pi-font csHPPiFont }
7245 { HP-Math8 csHPMath8 }
7246 { Adobe-Symbol-Encoding csHPPSMath }
7247 { HP-DeskTop csHPDesktop }
7248 { Ventura-Math csVenturaMath }
7249 { Microsoft-Publishing csMicrosoftPublishing }
7250 { Windows-31J csWindows31J }
7255 proc tcl_encoding {enc} {
7256 global encoding_aliases
7257 set names [encoding names]
7258 set lcnames [string tolower $names]
7259 set enc [string tolower $enc]
7260 set i [lsearch -exact $lcnames $enc]
7262 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7263 if {[regsub {^iso[-_]} $enc iso encx]} {
7264 set i [lsearch -exact $lcnames $encx]
7268 foreach l $encoding_aliases {
7269 set ll [string tolower $l]
7270 if {[lsearch -exact $ll $enc] < 0} continue
7271 # look through the aliases for one that tcl knows about
7273 set i [lsearch -exact $lcnames $e]
7275 if {[regsub {^iso[-_]} $e iso ex]} {
7276 set i [lsearch -exact $lcnames $ex]
7285 return [lindex $names $i]
7292 set diffopts "-U 5 -p"
7293 set wrcomcmd "git diff-tree --stdin -p --pretty"
7297 set gitencoding [exec git config --get i18n.commitencoding]
7299 if {$gitencoding == ""} {
7300 set gitencoding "utf-8"
7302 set tclencoding [tcl_encoding $gitencoding]
7303 if {$tclencoding == {}} {
7304 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7307 set mainfont {Helvetica 9}
7308 set textfont {Courier 9}
7309 set uifont {Helvetica 9 bold}
7311 set findmergefiles 0
7319 set cmitmode "patch"
7320 set wrapcomment "none"
7324 set showlocalchanges 1
7326 set colors {green red blue magenta darkgrey brown orange}
7329 set diffcolors {red "#00a000" blue}
7330 set selectbgcolor gray85
7332 catch {source ~/.gitk}
7334 font create optionfont -family sans-serif -size -12
7338 switch -regexp -- $arg {
7340 "^-d" { set datemode 1 }
7342 lappend revtreeargs $arg
7347 # check that we can find a .git directory somewhere...
7349 if {![file isdirectory $gitdir]} {
7350 show_error {} . "Cannot find the git directory \"$gitdir\"."
7354 set cmdline_files {}
7355 set i [lsearch -exact $revtreeargs "--"]
7357 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
7358 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
7359 } elseif {$revtreeargs ne {}} {
7361 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7362 set cmdline_files [split $f "\n"]
7363 set n [llength $cmdline_files]
7364 set revtreeargs [lrange $revtreeargs 0 end-$n]
7366 # unfortunately we get both stdout and stderr in $err,
7367 # so look for "fatal:".
7368 set i [string first "fatal:" $err]
7370 set err [string range $err [expr {$i + 6}] end]
7372 show_error {} . "Bad arguments to gitk:\n$err"
7377 set nullid "0000000000000000000000000000000000000000"
7384 set highlight_paths {}
7385 set searchdirn -forwards
7395 set selectedhlview None
7404 set lookingforhead 0
7409 wm title . "[file tail $argv0]: [file tail [pwd]]"
7412 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7413 # create a view for the files/dirs specified on the command line
7417 set viewname(1) "Command line"
7418 set viewfiles(1) $cmdline_files
7419 set viewargs(1) $revtreeargs
7422 .bar.view entryconf Edit* -state normal
7423 .bar.view entryconf Delete* -state normal
7426 if {[info exists permviews]} {
7427 foreach v $permviews {
7430 set viewname($n) [lindex $v 0]
7431 set viewfiles($n) [lindex $v 1]
7432 set viewargs($n) [lindex $v 2]