2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
56 set fd
[lindex
$runq 0 0]
57 set script [lindex
$runq 0 1]
58 set repeat
[eval $script]
59 set t1
[clock clicks
-milliseconds]
60 set t
[expr {$t1 - $t0}]
61 set runq
[lrange
$runq 1 end
]
62 if {$repeat ne
{} && $repeat} {
63 if {$fd eq
{} ||
$repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq
[list
$fd $script]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx
86 global lookingforhead showlocalchanges
88 set startmsecs
[clock clicks
-milliseconds]
89 set commitidx
($view) 0
90 set order
"--topo-order"
92 set order
"--date-order"
95 set fd
[open
[concat | git log
-z --pretty=raw
$order --parents \
96 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
98 error_popup
"Error executing git rev-list: $err"
101 set commfd
($view) $fd
102 set leftover
($view) {}
103 set lookingforhead
$showlocalchanges
104 fconfigure
$fd -blocking 0 -translation lf
105 if {$tclencoding != {}} {
106 fconfigure
$fd -encoding $tclencoding
108 filerun
$fd [list getcommitlines
$fd $view]
112 proc stop_rev_list
{} {
113 global commfd curview
115 if {![info exists commfd
($curview)]} return
116 set fd
$commfd($curview)
122 unset commfd
($curview)
126 global phase canv mainfont curview
130 start_rev_list
$curview
131 show_status
"Reading commits..."
134 proc getcommitlines
{fd view
} {
136 global leftover commfd
137 global displayorder commitidx commitrow commitdata
138 global parentlist children curview hlview
139 global vparentlist vdisporder vcmitlisted
141 set stuff
[read $fd 500000]
149 # set it blocking so we wait for the process to terminate
150 fconfigure
$fd -blocking 1
151 if {[catch
{close
$fd} err
]} {
153 if {$view != $curview} {
154 set fv
" for the \"$viewname($view)\" view"
156 if {[string range
$err 0 4] == "usage"} {
157 set err
"Gitk: error reading commits$fv:\
158 bad arguments to git rev-list."
159 if {$viewname($view) eq
"Command line"} {
161 " (Note: arguments to gitk are passed to git rev-list\
162 to allow selection of commits to be displayed.)"
165 set err
"Error reading commits$fv: $err"
169 if {$view == $curview} {
170 run chewcommits
$view
177 set i
[string first
"\0" $stuff $start]
179 append leftover
($view) [string range
$stuff $start end
]
183 set cmit
$leftover($view)
184 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
185 set leftover
($view) {}
187 set cmit
[string range
$stuff $start [expr {$i - 1}]]
189 set start
[expr {$i + 1}]
190 set j
[string first
"\n" $cmit]
193 if {$j >= 0 && [string match
"commit *" $cmit]} {
194 set ids
[string range
$cmit 7 [expr {$j - 1}]]
195 if {[string match
{[-<>]*} $ids]} {
196 switch
-- [string index
$ids 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 log output: {$shortcmit}"
219 set id
[lindex
$ids 0]
221 set olds
[lrange
$ids 1 end
]
224 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
225 lappend children
($view,$p) $id
232 if {![info exists children
($view,$id)]} {
233 set children
($view,$id) {}
235 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
236 set commitrow
($view,$id) $commitidx($view)
237 incr commitidx
($view)
238 if {$view == $curview} {
239 lappend parentlist
$olds
240 lappend displayorder
$id
241 lappend commitlisted
$listed
243 lappend vparentlist
($view) $olds
244 lappend vdisporder
($view) $id
245 lappend vcmitlisted
($view) $listed
250 run chewcommits
$view
255 proc chewcommits
{view
} {
256 global curview hlview commfd
257 global selectedline pending_select
260 if {$view == $curview} {
261 set allread
[expr {![info exists commfd
($view)]}]
262 set tlimit
[expr {[clock clicks
-milliseconds] + 50}]
263 set more [layoutmore
$tlimit $allread]
264 if {$allread && !$more} {
265 global displayorder nullid commitidx phase
266 global numcommits startmsecs
268 if {[info exists pending_select
]} {
269 set row
[expr {[lindex
$displayorder 0] eq
$nullid}]
272 if {$commitidx($curview) > 0} {
273 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
274 #puts "overall $ms ms for $numcommits commits"
276 show_status
"No commits selected"
282 if {[info exists hlview
] && $view == $hlview} {
288 proc readcommit
{id
} {
289 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
290 parsecommit
$id $contents 0
293 proc updatecommits
{} {
294 global viewdata curview phase displayorder
295 global children commitrow selectedline thickerline
302 foreach id
$displayorder {
303 catch
{unset children
($n,$id)}
304 catch
{unset commitrow
($n,$id)}
307 catch
{unset selectedline
}
308 catch
{unset thickerline
}
309 catch
{unset viewdata
($n)}
316 proc parsecommit
{id contents listed
} {
317 global commitinfo cdate
326 set hdrend
[string first
"\n\n" $contents]
328 # should never happen...
329 set hdrend
[string length
$contents]
331 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
332 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
333 foreach line
[split $header "\n"] {
334 set tag
[lindex
$line 0]
335 if {$tag == "author"} {
336 set audate
[lindex
$line end-1
]
337 set auname
[lrange
$line 1 end-2
]
338 } elseif
{$tag == "committer"} {
339 set comdate
[lindex
$line end-1
]
340 set comname
[lrange
$line 1 end-2
]
344 # take the first non-blank line of the comment as the headline
345 set headline
[string trimleft
$comment]
346 set i
[string first
"\n" $headline]
348 set headline
[string range
$headline 0 $i]
350 set headline
[string trimright
$headline]
351 set i
[string first
"\r" $headline]
353 set headline
[string trimright
[string range
$headline 0 $i]]
356 # git rev-list indents the comment by 4 spaces;
357 # if we got this via git cat-file, add the indentation
359 foreach line
[split $comment "\n"] {
360 append newcomment
" "
361 append newcomment
$line
362 append newcomment
"\n"
364 set comment
$newcomment
366 if {$comdate != {}} {
367 set cdate
($id) $comdate
369 set commitinfo
($id) [list
$headline $auname $audate \
370 $comname $comdate $comment]
373 proc getcommit
{id
} {
374 global commitdata commitinfo
376 if {[info exists commitdata
($id)]} {
377 parsecommit
$id $commitdata($id) 1
380 if {![info exists commitinfo
($id)]} {
381 set commitinfo
($id) {"No commit information available"}
388 global tagids idtags headids idheads tagobjid
389 global otherrefids idotherrefs mainhead mainheadid
391 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
394 set refd
[open
[list | git show-ref
-d] r
]
395 while {[gets
$refd line
] >= 0} {
396 if {[string index
$line 40] ne
" "} continue
397 set id
[string range
$line 0 39]
398 set ref
[string range
$line 41 end
]
399 if {![string match
"refs/*" $ref]} continue
400 set name
[string range
$ref 5 end
]
401 if {[string match
"remotes/*" $name]} {
402 if {![string match
"*/HEAD" $name]} {
403 set headids
($name) $id
404 lappend idheads
($id) $name
406 } elseif
{[string match
"heads/*" $name]} {
407 set name
[string range
$name 6 end
]
408 set headids
($name) $id
409 lappend idheads
($id) $name
410 } elseif
{[string match
"tags/*" $name]} {
411 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
412 # which is what we want since the former is the commit ID
413 set name
[string range
$name 5 end
]
414 if {[string match
"*^{}" $name]} {
415 set name
[string range
$name 0 end-3
]
417 set tagobjid
($name) $id
419 set tagids
($name) $id
420 lappend idtags
($id) $name
422 set otherrefids
($name) $id
423 lappend idotherrefs
($id) $name
430 set thehead
[exec git symbolic-ref HEAD
]
431 if {[string match
"refs/heads/*" $thehead]} {
432 set mainhead
[string range
$thehead 11 end
]
433 if {[info exists headids
($mainhead)]} {
434 set mainheadid
$headids($mainhead)
440 # update things for a head moved to a child of its previous location
441 proc movehead
{id name
} {
442 global headids idheads
444 removehead
$headids($name) $name
445 set headids
($name) $id
446 lappend idheads
($id) $name
449 # update things when a head has been removed
450 proc removehead
{id name
} {
451 global headids idheads
453 if {$idheads($id) eq
$name} {
456 set i
[lsearch
-exact $idheads($id) $name]
458 set idheads
($id) [lreplace
$idheads($id) $i $i]
464 proc show_error
{w top msg
} {
465 message
$w.m
-text $msg -justify center
-aspect 400
466 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
467 button
$w.ok
-text OK
-command "destroy $top"
468 pack
$w.ok
-side bottom
-fill x
469 bind $top <Visibility
> "grab $top; focus $top"
470 bind $top <Key-Return
> "destroy $top"
474 proc error_popup msg
{
478 show_error
$w $w $msg
481 proc confirm_popup msg
{
487 message
$w.m
-text $msg -justify center
-aspect 400
488 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
489 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
490 pack
$w.ok
-side left
-fill x
491 button
$w.cancel
-text Cancel
-command "destroy $w"
492 pack
$w.cancel
-side right
-fill x
493 bind $w <Visibility
> "grab $w; focus $w"
499 global canv canv2 canv3 linespc charspc ctext cflist
500 global textfont mainfont uifont tabstop
501 global findtype findtypemenu findloc findstring fstring geometry
502 global entries sha1entry sha1string sha1but
503 global maincursor textcursor curtextcursor
504 global rowctxmenu fakerowmenu mergemax wrapcomment
505 global highlight_files gdttype
506 global searchstring sstring
507 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
511 .bar add cascade
-label "File" -menu .bar.
file
512 .bar configure
-font $uifont
514 .bar.
file add
command -label "Update" -command updatecommits
515 .bar.
file add
command -label "Reread references" -command rereadrefs
516 .bar.
file add
command -label "Quit" -command doquit
517 .bar.
file configure
-font $uifont
519 .bar add cascade
-label "Edit" -menu .bar.edit
520 .bar.edit add
command -label "Preferences" -command doprefs
521 .bar.edit configure
-font $uifont
523 menu .bar.view
-font $uifont
524 .bar add cascade
-label "View" -menu .bar.view
525 .bar.view add
command -label "New view..." -command {newview
0}
526 .bar.view add
command -label "Edit view..." -command editview \
528 .bar.view add
command -label "Delete view" -command delview
-state disabled
529 .bar.view add separator
530 .bar.view add radiobutton
-label "All files" -command {showview
0} \
531 -variable selectedview
-value 0
534 .bar add cascade
-label "Help" -menu .bar.
help
535 .bar.
help add
command -label "About gitk" -command about
536 .bar.
help add
command -label "Key bindings" -command keys
537 .bar.
help configure
-font $uifont
538 . configure
-menu .bar
540 # the gui has upper and lower half, parts of a paned window.
541 panedwindow .ctop
-orient vertical
543 # possibly use assumed geometry
544 if {![info exists geometry
(pwsash0
)]} {
545 set geometry
(topheight
) [expr {15 * $linespc}]
546 set geometry
(topwidth
) [expr {80 * $charspc}]
547 set geometry
(botheight
) [expr {15 * $linespc}]
548 set geometry
(botwidth
) [expr {50 * $charspc}]
549 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
550 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
553 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
554 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
556 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
558 # create three canvases
559 set cscroll .tf.histframe.csb
560 set canv .tf.histframe.pwclist.canv
562 -selectbackground $selectbgcolor \
563 -background $bgcolor -bd 0 \
564 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
565 .tf.histframe.pwclist add
$canv
566 set canv2 .tf.histframe.pwclist.canv2
568 -selectbackground $selectbgcolor \
569 -background $bgcolor -bd 0 -yscrollincr $linespc
570 .tf.histframe.pwclist add
$canv2
571 set canv3 .tf.histframe.pwclist.canv3
573 -selectbackground $selectbgcolor \
574 -background $bgcolor -bd 0 -yscrollincr $linespc
575 .tf.histframe.pwclist add
$canv3
576 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
577 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
579 # a scroll bar to rule them
580 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
581 pack
$cscroll -side right
-fill y
582 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
583 lappend bglist
$canv $canv2 $canv3
584 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
586 # we have two button bars at bottom of top frame. Bar 1
588 frame .tf.lbar
-height 15
590 set sha1entry .tf.bar.sha1
591 set entries
$sha1entry
592 set sha1but .tf.bar.sha1label
593 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
594 -command gotocommit
-width 8 -font $uifont
595 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
596 pack .tf.bar.sha1label
-side left
597 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
598 trace add variable sha1string
write sha1change
599 pack
$sha1entry -side left
-pady 2
601 image create bitmap bm-left
-data {
602 #define left_width 16
603 #define left_height 16
604 static unsigned char left_bits
[] = {
605 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
606 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
607 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
609 image create bitmap bm-right
-data {
610 #define right_width 16
611 #define right_height 16
612 static unsigned char right_bits
[] = {
613 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
614 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
615 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
617 button .tf.bar.leftbut
-image bm-left
-command goback \
618 -state disabled
-width 26
619 pack .tf.bar.leftbut
-side left
-fill y
620 button .tf.bar.rightbut
-image bm-right
-command goforw \
621 -state disabled
-width 26
622 pack .tf.bar.rightbut
-side left
-fill y
624 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
625 pack .tf.bar.findbut
-side left
627 set fstring .tf.bar.findstring
628 lappend entries
$fstring
629 entry
$fstring -width 30 -font $textfont -textvariable findstring
630 trace add variable findstring
write find_change
631 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
633 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
634 findtype Exact IgnCase Regexp
]
635 trace add variable findtype
write find_change
636 .tf.bar.findtype configure
-font $uifont
637 .tf.bar.findtype.menu configure
-font $uifont
638 set findloc
"All fields"
639 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
640 Comments Author Committer
641 trace add variable findloc
write find_change
642 .tf.bar.findloc configure
-font $uifont
643 .tf.bar.findloc.menu configure
-font $uifont
644 pack .tf.bar.findloc
-side right
645 pack .tf.bar.findtype
-side right
647 # build up the bottom bar of upper window
648 label .tf.lbar.flabel
-text "Highlight: Commits " \
650 pack .tf.lbar.flabel
-side left
-fill y
651 set gdttype
"touching paths:"
652 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
653 "adding/removing string:"]
654 trace add variable gdttype
write hfiles_change
655 $gm conf
-font $uifont
656 .tf.lbar.gdttype conf
-font $uifont
657 pack .tf.lbar.gdttype
-side left
-fill y
658 entry .tf.lbar.fent
-width 25 -font $textfont \
659 -textvariable highlight_files
660 trace add variable highlight_files
write hfiles_change
661 lappend entries .tf.lbar.fent
662 pack .tf.lbar.fent
-side left
-fill x
-expand 1
663 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
664 pack .tf.lbar.vlabel
-side left
-fill y
665 global viewhlmenu selectedhlview
666 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
667 $viewhlmenu entryconf None
-command delvhighlight
668 $viewhlmenu conf
-font $uifont
669 .tf.lbar.vhl conf
-font $uifont
670 pack .tf.lbar.vhl
-side left
-fill y
671 label .tf.lbar.rlabel
-text " OR " -font $uifont
672 pack .tf.lbar.rlabel
-side left
-fill y
673 global highlight_related
674 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
675 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
676 $m conf
-font $uifont
677 .tf.lbar.relm conf
-font $uifont
678 trace add variable highlight_related
write vrel_change
679 pack .tf.lbar.relm
-side left
-fill y
681 # Finish putting the upper half of the viewer together
682 pack .tf.lbar
-in .tf
-side bottom
-fill x
683 pack .tf.bar
-in .tf
-side bottom
-fill x
684 pack .tf.histframe
-fill both
-side top
-expand 1
686 .ctop paneconfigure .tf
-height $geometry(topheight
)
687 .ctop paneconfigure .tf
-width $geometry(topwidth
)
689 # now build up the bottom
690 panedwindow .pwbottom
-orient horizontal
692 # lower left, a text box over search bar, scroll bar to the right
693 # if we know window height, then that will set the lower text height, otherwise
694 # we set lower text height which will drive window height
695 if {[info exists geometry
(main
)]} {
696 frame .bleft
-width $geometry(botwidth
)
698 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
703 button .bleft.top.search
-text "Search" -command dosearch \
705 pack .bleft.top.search
-side left
-padx 5
706 set sstring .bleft.top.sstring
707 entry
$sstring -width 20 -font $textfont -textvariable searchstring
708 lappend entries
$sstring
709 trace add variable searchstring
write incrsearch
710 pack
$sstring -side left
-expand 1 -fill x
711 radiobutton .bleft.mid.
diff -text "Diff" \
712 -command changediffdisp
-variable diffelide
-value {0 0}
713 radiobutton .bleft.mid.old
-text "Old version" \
714 -command changediffdisp
-variable diffelide
-value {0 1}
715 radiobutton .bleft.mid.new
-text "New version" \
716 -command changediffdisp
-variable diffelide
-value {1 0}
717 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
718 set ctext .bleft.ctext
719 text
$ctext -background $bgcolor -foreground $fgcolor \
720 -tabs "[expr {$tabstop * $charspc}]" \
721 -state disabled
-font $textfont \
722 -yscrollcommand scrolltext
-wrap none
723 scrollbar .bleft.sb
-command "$ctext yview"
724 pack .bleft.top
-side top
-fill x
725 pack .bleft.mid
-side top
-fill x
726 pack .bleft.sb
-side right
-fill y
727 pack
$ctext -side left
-fill both
-expand 1
728 lappend bglist
$ctext
729 lappend fglist
$ctext
731 $ctext tag conf comment
-wrap $wrapcomment
732 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
733 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
734 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
735 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
736 $ctext tag conf m0
-fore red
737 $ctext tag conf m1
-fore blue
738 $ctext tag conf m2
-fore green
739 $ctext tag conf m3
-fore purple
740 $ctext tag conf
m4 -fore brown
741 $ctext tag conf m5
-fore "#009090"
742 $ctext tag conf m6
-fore magenta
743 $ctext tag conf m7
-fore "#808000"
744 $ctext tag conf m8
-fore "#009000"
745 $ctext tag conf m9
-fore "#ff0080"
746 $ctext tag conf m10
-fore cyan
747 $ctext tag conf m11
-fore "#b07070"
748 $ctext tag conf m12
-fore "#70b0f0"
749 $ctext tag conf m13
-fore "#70f0b0"
750 $ctext tag conf m14
-fore "#f0b070"
751 $ctext tag conf m15
-fore "#ff70b0"
752 $ctext tag conf mmax
-fore darkgrey
754 $ctext tag conf mresult
-font [concat
$textfont bold
]
755 $ctext tag conf msep
-font [concat
$textfont bold
]
756 $ctext tag conf found
-back yellow
759 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
764 radiobutton .bright.mode.
patch -text "Patch" \
765 -command reselectline
-variable cmitmode
-value "patch"
766 .bright.mode.
patch configure
-font $uifont
767 radiobutton .bright.mode.tree
-text "Tree" \
768 -command reselectline
-variable cmitmode
-value "tree"
769 .bright.mode.tree configure
-font $uifont
770 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
771 pack .bright.mode
-side top
-fill x
772 set cflist .bright.cfiles
773 set indent
[font measure
$mainfont "nn"]
775 -selectbackground $selectbgcolor \
776 -background $bgcolor -foreground $fgcolor \
778 -tabs [list
$indent [expr {2 * $indent}]] \
779 -yscrollcommand ".bright.sb set" \
780 -cursor [. cget
-cursor] \
781 -spacing1 1 -spacing3 1
782 lappend bglist
$cflist
783 lappend fglist
$cflist
784 scrollbar .bright.sb
-command "$cflist yview"
785 pack .bright.sb
-side right
-fill y
786 pack
$cflist -side left
-fill both
-expand 1
787 $cflist tag configure highlight \
788 -background [$cflist cget
-selectbackground]
789 $cflist tag configure bold
-font [concat
$mainfont bold
]
791 .pwbottom add .bright
794 # restore window position if known
795 if {[info exists geometry
(main
)]} {
796 wm geometry .
"$geometry(main)"
799 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
800 pack .ctop
-fill both
-expand 1
801 bindall
<1> {selcanvline
%W
%x
%y
}
802 #bindall <B1-Motion> {selcanvline %W %x %y}
803 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
804 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
805 bindall
<2> "canvscan mark %W %x %y"
806 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
807 bindkey
<Home
> selfirstline
808 bindkey
<End
> sellastline
809 bind .
<Key-Up
> "selnextline -1"
810 bind .
<Key-Down
> "selnextline 1"
811 bind .
<Shift-Key-Up
> "next_highlight -1"
812 bind .
<Shift-Key-Down
> "next_highlight 1"
813 bindkey
<Key-Right
> "goforw"
814 bindkey
<Key-Left
> "goback"
815 bind .
<Key-Prior
> "selnextpage -1"
816 bind .
<Key-Next
> "selnextpage 1"
817 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
818 bind .
<Control-End
> "allcanvs yview moveto 1.0"
819 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
820 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
821 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
822 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
823 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
824 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
825 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
826 bindkey p
"selnextline -1"
827 bindkey n
"selnextline 1"
830 bindkey i
"selnextline -1"
831 bindkey k
"selnextline 1"
834 bindkey b
"$ctext yview scroll -1 pages"
835 bindkey d
"$ctext yview scroll 18 units"
836 bindkey u
"$ctext yview scroll -18 units"
837 bindkey
/ {findnext
1}
838 bindkey
<Key-Return
> {findnext
0}
841 bindkey
<F5
> updatecommits
842 bind .
<Control-q
> doquit
843 bind .
<Control-f
> dofind
844 bind .
<Control-g
> {findnext
0}
845 bind .
<Control-r
> dosearchback
846 bind .
<Control-s
> dosearch
847 bind .
<Control-equal
> {incrfont
1}
848 bind .
<Control-KP_Add
> {incrfont
1}
849 bind .
<Control-minus
> {incrfont
-1}
850 bind .
<Control-KP_Subtract
> {incrfont
-1}
851 wm protocol . WM_DELETE_WINDOW doquit
852 bind .
<Button-1
> "click %W"
853 bind $fstring <Key-Return
> dofind
854 bind $sha1entry <Key-Return
> gotocommit
855 bind $sha1entry <<PasteSelection>> clearsha1
856 bind $cflist <1> {sel_flist %W %x %y; break}
857 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
858 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
860 set maincursor [. cget -cursor]
861 set textcursor [$ctext cget -cursor]
862 set curtextcursor $textcursor
864 set rowctxmenu .rowctxmenu
865 menu $rowctxmenu -tearoff 0
866 $rowctxmenu add command -label "Diff this -> selected" \
867 -command {diffvssel 0}
868 $rowctxmenu add command -label "Diff selected -> this" \
869 -command {diffvssel 1}
870 $rowctxmenu add command -label "Make patch" -command mkpatch
871 $rowctxmenu add command -label "Create tag" -command mktag
872 $rowctxmenu add command -label "Write commit to file" -command writecommit
873 $rowctxmenu add command -label "Create new branch" -command mkbranch
874 $rowctxmenu add command -label "Cherry-pick this commit" \
876 $rowctxmenu add command -label "Reset HEAD branch to here" \
879 set fakerowmenu .fakerowmenu
880 menu $fakerowmenu -tearoff 0
881 $fakerowmenu add command -label "Diff this -> selected" \
882 -command {diffvssel 0}
883 $fakerowmenu add command -label "Diff selected -> this" \
884 -command {diffvssel 1}
885 $fakerowmenu add command -label "Make patch" -command mkpatch
886 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
887 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
888 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
890 set headctxmenu .headctxmenu
891 menu $headctxmenu -tearoff 0
892 $headctxmenu add command -label "Check out this branch" \
894 $headctxmenu add command -label "Remove this branch" \
898 # mouse-2 makes all windows scan vertically, but only the one
899 # the cursor is in scans horizontally
900 proc canvscan {op w x y} {
901 global canv canv2 canv3
902 foreach c [list $canv $canv2 $canv3] {
911 proc scrollcanv {cscroll f0 f1} {
917 # when we make a key binding for the toplevel, make sure
918 # it doesn't get triggered when that key is pressed in the
919 # find string entry widget.
920 proc bindkey {ev script} {
923 set escript [bind Entry $ev]
924 if {$escript == {}} {
925 set escript [bind Entry <Key>]
928 bind $e $ev "$escript; break"
932 # set the focus back to the toplevel for any click outside
943 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
944 global stuffsaved findmergefiles maxgraphpct
945 global maxwidth showneartags showlocalchanges
946 global viewname viewfiles viewargs viewperm nextviewnum
947 global cmitmode wrapcomment
948 global colors bgcolor fgcolor diffcolors selectbgcolor
950 if {$stuffsaved} return
951 if {![winfo viewable .]} return
953 set f [open "~/.gitk-new" w]
954 puts $f [list set mainfont $mainfont]
955 puts $f [list set textfont $textfont]
956 puts $f [list set uifont $uifont]
957 puts $f [list set tabstop $tabstop]
958 puts $f [list set findmergefiles $findmergefiles]
959 puts $f [list set maxgraphpct $maxgraphpct]
960 puts $f [list set maxwidth $maxwidth]
961 puts $f [list set cmitmode $cmitmode]
962 puts $f [list set wrapcomment $wrapcomment]
963 puts $f [list set showneartags $showneartags]
964 puts $f [list set showlocalchanges $showlocalchanges]
965 puts $f [list set bgcolor $bgcolor]
966 puts $f [list set fgcolor $fgcolor]
967 puts $f [list set colors $colors]
968 puts $f [list set diffcolors $diffcolors]
969 puts $f [list set selectbgcolor $selectbgcolor]
971 puts $f "set geometry(main) [wm geometry .]"
972 puts $f "set geometry(topwidth) [winfo width .tf]"
973 puts $f "set geometry(topheight) [winfo height .tf]"
974 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
975 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
976 puts $f "set geometry(botwidth) [winfo width .bleft]"
977 puts $f "set geometry(botheight) [winfo height .bleft]"
979 puts -nonewline $f "set permviews {"
980 for {set v 0} {$v < $nextviewnum} {incr v} {
982 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
987 catch {file delete "~/.gitk"}
988 file rename -force "~/.gitk-new" "~/.gitk"
993 proc resizeclistpanes {win w} {
995 if {[info exists oldwidth($win)]} {
996 set s0 [$win sash coord 0]
997 set s1 [$win sash coord 1]
999 set sash0 [expr {int($w/2 - 2)}]
1000 set sash1 [expr {int($w*5/6 - 2)}]
1002 set factor [expr {1.0 * $w / $oldwidth($win)}]
1003 set sash0 [expr {int($factor * [lindex $s0 0])}]
1004 set sash1 [expr {int($factor * [lindex $s1 0])}]
1008 if {$sash1 < $sash0 + 20} {
1009 set sash1 [expr {$sash0 + 20}]
1011 if {$sash1 > $w - 10} {
1012 set sash1 [expr {$w - 10}]
1013 if {$sash0 > $sash1 - 20} {
1014 set sash0 [expr {$sash1 - 20}]
1018 $win sash place 0 $sash0 [lindex $s0 1]
1019 $win sash place 1 $sash1 [lindex $s1 1]
1021 set oldwidth($win) $w
1024 proc resizecdetpanes {win w} {
1026 if {[info exists oldwidth($win)]} {
1027 set s0 [$win sash coord 0]
1029 set sash0 [expr {int($w*3/4 - 2)}]
1031 set factor [expr {1.0 * $w / $oldwidth($win)}]
1032 set sash0 [expr {int($factor * [lindex $s0 0])}]
1036 if {$sash0 > $w - 15} {
1037 set sash0 [expr {$w - 15}]
1040 $win sash place 0 $sash0 [lindex $s0 1]
1042 set oldwidth($win) $w
1045 proc allcanvs args {
1046 global canv canv2 canv3
1052 proc bindall {event action} {
1053 global canv canv2 canv3
1054 bind $canv $event $action
1055 bind $canv2 $event $action
1056 bind $canv3 $event $action
1062 if {[winfo exists $w]} {
1067 wm title $w "About gitk"
1068 message $w.m -text {
1069 Gitk - a commit viewer for git
1071 Copyright © 2005-2006 Paul Mackerras
1073 Use and redistribute under the terms of the GNU General Public License} \
1074 -justify center -aspect 400 -border 2 -bg white -relief groove
1075 pack $w.m -side top -fill x -padx 2 -pady 2
1076 $w.m configure -font $uifont
1077 button $w.ok -text Close -command "destroy $w" -default active
1078 pack $w.ok -side bottom
1079 $w.ok configure -font $uifont
1080 bind $w <Visibility> "focus $w.ok"
1081 bind $w <Key-Escape> "destroy $w"
1082 bind $w <Key-Return> "destroy $w"
1088 if {[winfo exists $w]} {
1093 wm title $w "Gitk key bindings"
1094 message $w.m -text {
1098 <Home> Move to first commit
1099 <End> Move to last commit
1100 <Up>, p, i Move up one commit
1101 <Down>, n, k Move down one commit
1102 <Left>, z, j Go back in history list
1103 <Right>, x, l Go forward in history list
1104 <PageUp> Move up one page in commit list
1105 <PageDown> Move down one page in commit list
1106 <Ctrl-Home> Scroll to top of commit list
1107 <Ctrl-End> Scroll to bottom of commit list
1108 <Ctrl-Up> Scroll commit list up one line
1109 <Ctrl-Down> Scroll commit list down one line
1110 <Ctrl-PageUp> Scroll commit list up one page
1111 <Ctrl-PageDown> Scroll commit list down one page
1112 <Shift-Up> Move to previous highlighted line
1113 <Shift-Down> Move to next highlighted line
1114 <Delete>, b Scroll diff view up one page
1115 <Backspace> Scroll diff view up one page
1116 <Space> Scroll diff view down one page
1117 u Scroll diff view up 18 lines
1118 d Scroll diff view down 18 lines
1120 <Ctrl-G> Move to next find hit
1121 <Return> Move to next find hit
1122 / Move to next find hit, or redo find
1123 ? Move to previous find hit
1124 f Scroll diff view to next file
1125 <Ctrl-S> Search for next hit in diff view
1126 <Ctrl-R> Search for previous hit in diff view
1127 <Ctrl-KP+> Increase font size
1128 <Ctrl-plus> Increase font size
1129 <Ctrl-KP-> Decrease font size
1130 <Ctrl-minus> Decrease font size
1133 -justify left -bg white -border 2 -relief groove
1134 pack $w.m -side top -fill both -padx 2 -pady 2
1135 $w.m configure -font $uifont
1136 button $w.ok -text Close -command "destroy $w" -default active
1137 pack $w.ok -side bottom
1138 $w.ok configure -font $uifont
1139 bind $w <Visibility> "focus $w.ok"
1140 bind $w <Key-Escape> "destroy $w"
1141 bind $w <Key-Return> "destroy $w"
1144 # Procedures for manipulating the file list window at the
1145 # bottom right of the overall window.
1147 proc treeview {w l openlevs} {
1148 global treecontents treediropen treeheight treeparent treeindex
1158 set treecontents() {}
1159 $w conf -state normal
1161 while {[string range $f 0 $prefixend] ne $prefix} {
1162 if {$lev <= $openlevs} {
1163 $w mark set e:$treeindex($prefix) "end -1c"
1164 $w mark gravity e:$treeindex($prefix) left
1166 set treeheight($prefix) $ht
1167 incr ht [lindex $htstack end]
1168 set htstack [lreplace $htstack end end]
1169 set prefixend [lindex $prefendstack end]
1170 set prefendstack [lreplace $prefendstack end end]
1171 set prefix [string range $prefix 0 $prefixend]
1174 set tail [string range $f [expr {$prefixend+1}] end]
1175 while {[set slash [string first "/" $tail]] >= 0} {
1178 lappend prefendstack $prefixend
1179 incr prefixend [expr {$slash + 1}]
1180 set d [string range $tail 0 $slash]
1181 lappend treecontents($prefix) $d
1182 set oldprefix $prefix
1184 set treecontents($prefix) {}
1185 set treeindex($prefix) [incr ix]
1186 set treeparent($prefix) $oldprefix
1187 set tail [string range $tail [expr {$slash+1}] end]
1188 if {$lev <= $openlevs} {
1190 set treediropen($prefix) [expr {$lev < $openlevs}]
1191 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1192 $w mark set d:$ix "end -1c"
1193 $w mark gravity d:$ix left
1195 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1197 $w image create end -align center -image $bm -padx 1 \
1199 $w insert end $d [highlight_tag $prefix]
1200 $w mark set s:$ix "end -1c"
1201 $w mark gravity s:$ix left
1206 if {$lev <= $openlevs} {
1209 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1211 $w insert end $tail [highlight_tag $f]
1213 lappend treecontents($prefix) $tail
1216 while {$htstack ne {}} {
1217 set treeheight($prefix) $ht
1218 incr ht [lindex $htstack end]
1219 set htstack [lreplace $htstack end end]
1220 set prefixend [lindex $prefendstack end]
1221 set prefendstack [lreplace $prefendstack end end]
1222 set prefix [string range $prefix 0 $prefixend]
1224 $w conf -state disabled
1227 proc linetoelt {l} {
1228 global treeheight treecontents
1233 foreach e $treecontents($prefix) {
1238 if {[string index $e end] eq "/"} {
1239 set n $treeheight($prefix$e)
1251 proc highlight_tree {y prefix} {
1252 global treeheight treecontents cflist
1254 foreach e $treecontents($prefix) {
1256 if {[highlight_tag $path] ne {}} {
1257 $cflist tag add bold $y.0 "$y.0 lineend"
1260 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1261 set y [highlight_tree $y $path]
1267 proc treeclosedir {w dir} {
1268 global treediropen treeheight treeparent treeindex
1270 set ix $treeindex($dir)
1271 $w conf -state normal
1272 $w delete s:$ix e:$ix
1273 set treediropen($dir) 0
1274 $w image configure a:$ix -image tri-rt
1275 $w conf -state disabled
1276 set n [expr {1 - $treeheight($dir)}]
1277 while {$dir ne {}} {
1278 incr treeheight($dir) $n
1279 set dir $treeparent($dir)
1283 proc treeopendir {w dir} {
1284 global treediropen treeheight treeparent treecontents treeindex
1286 set ix $treeindex($dir)
1287 $w conf -state normal
1288 $w image configure a:$ix -image tri-dn
1289 $w mark set e:$ix s:$ix
1290 $w mark gravity e:$ix right
1293 set n [llength $treecontents($dir)]
1294 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1297 incr treeheight($x) $n
1299 foreach e $treecontents($dir) {
1301 if {[string index $e end] eq "/"} {
1302 set iy $treeindex($de)
1303 $w mark set d:$iy e:$ix
1304 $w mark gravity d:$iy left
1305 $w insert e:$ix $str
1306 set treediropen($de) 0
1307 $w image create e:$ix -align center -image tri-rt -padx 1 \
1309 $w insert e:$ix $e [highlight_tag $de]
1310 $w mark set s:$iy e:$ix
1311 $w mark gravity s:$iy left
1312 set treeheight($de) 1
1314 $w insert e:$ix $str
1315 $w insert e:$ix $e [highlight_tag $de]
1318 $w mark gravity e:$ix left
1319 $w conf -state disabled
1320 set treediropen($dir) 1
1321 set top [lindex [split [$w index @0,0] .] 0]
1322 set ht [$w cget -height]
1323 set l [lindex [split [$w index s:$ix] .] 0]
1326 } elseif {$l + $n + 1 > $top + $ht} {
1327 set top [expr {$l + $n + 2 - $ht}]
1335 proc treeclick {w x y} {
1336 global treediropen cmitmode ctext cflist cflist_top
1338 if {$cmitmode ne "tree"} return
1339 if {![info exists cflist_top]} return
1340 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1341 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1342 $cflist tag add highlight $l.0 "$l.0 lineend"
1348 set e [linetoelt $l]
1349 if {[string index $e end] ne "/"} {
1351 } elseif {$treediropen($e)} {
1358 proc setfilelist {id} {
1359 global treefilelist cflist
1361 treeview $cflist $treefilelist($id) 0
1364 image create bitmap tri-rt -background black -foreground blue -data {
1365 #define tri-rt_width 13
1366 #define tri-rt_height 13
1367 static unsigned char tri-rt_bits[] = {
1368 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1369 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1372 #define tri-rt-mask_width 13
1373 #define tri-rt-mask_height 13
1374 static unsigned char tri-rt-mask_bits[] = {
1375 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1376 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1379 image create bitmap tri-dn -background black -foreground blue -data {
1380 #define tri-dn_width 13
1381 #define tri-dn_height 13
1382 static unsigned char tri-dn_bits[] = {
1383 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1384 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1387 #define tri-dn-mask_width 13
1388 #define tri-dn-mask_height 13
1389 static unsigned char tri-dn-mask_bits[] = {
1390 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1391 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1395 proc init_flist {first} {
1396 global cflist cflist_top selectedline difffilestart
1398 $cflist conf -state normal
1399 $cflist delete 0.0 end
1401 $cflist insert end $first
1403 $cflist tag add highlight 1.0 "1.0 lineend"
1405 catch {unset cflist_top}
1407 $cflist conf -state disabled
1408 set difffilestart {}
1411 proc highlight_tag {f} {
1412 global highlight_paths
1414 foreach p $highlight_paths {
1415 if {[string match $p $f]} {
1422 proc highlight_filelist {} {
1423 global cmitmode cflist
1425 $cflist conf -state normal
1426 if {$cmitmode ne "tree"} {
1427 set end [lindex [split [$cflist index end] .] 0]
1428 for {set l 2} {$l < $end} {incr l} {
1429 set line [$cflist get $l.0 "$l.0 lineend"]
1430 if {[highlight_tag $line] ne {}} {
1431 $cflist tag add bold $l.0 "$l.0 lineend"
1437 $cflist conf -state disabled
1440 proc unhighlight_filelist {} {
1443 $cflist conf -state normal
1444 $cflist tag remove bold 1.0 end
1445 $cflist conf -state disabled
1448 proc add_flist {fl} {
1451 $cflist conf -state normal
1453 $cflist insert end "\n"
1454 $cflist insert end $f [highlight_tag $f]
1456 $cflist conf -state disabled
1459 proc sel_flist {w x y} {
1460 global ctext difffilestart cflist cflist_top cmitmode
1462 if {$cmitmode eq "tree"} return
1463 if {![info exists cflist_top]} return
1464 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1465 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1466 $cflist tag add highlight $l.0 "$l.0 lineend"
1471 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1475 # Functions for adding and removing shell-type quoting
1477 proc shellquote {str} {
1478 if {![string match "*\['\"\\ \t]*" $str]} {
1481 if {![string match "*\['\"\\]*" $str]} {
1484 if {![string match "*'*" $str]} {
1487 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1490 proc shellarglist {l} {
1496 append str [shellquote $a]
1501 proc shelldequote {str} {
1506 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1507 append ret [string range $str $used end]
1508 set used [string length $str]
1511 set first [lindex $first 0]
1512 set ch [string index $str $first]
1513 if {$first > $used} {
1514 append ret [string range $str $used [expr {$first - 1}]]
1517 if {$ch eq " " || $ch eq "\t"} break
1520 set first [string first "'" $str $used]
1522 error "unmatched single-quote"
1524 append ret [string range $str $used [expr {$first - 1}]]
1529 if {$used >= [string length $str]} {
1530 error "trailing backslash"
1532 append ret [string index $str $used]
1537 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1538 error "unmatched double-quote"
1540 set first [lindex $first 0]
1541 set ch [string index $str $first]
1542 if {$first > $used} {
1543 append ret [string range $str $used [expr {$first - 1}]]
1546 if {$ch eq "\""} break
1548 append ret [string index $str $used]
1552 return [list $used $ret]
1555 proc shellsplit {str} {
1558 set str [string trimleft $str]
1559 if {$str eq {}} break
1560 set dq [shelldequote $str]
1561 set n [lindex $dq 0]
1562 set word [lindex $dq 1]
1563 set str [string range $str $n end]
1569 # Code to implement multiple views
1571 proc newview {ishighlight} {
1572 global nextviewnum newviewname newviewperm uifont newishighlight
1573 global newviewargs revtreeargs
1575 set newishighlight $ishighlight
1577 if {[winfo exists $top]} {
1581 set newviewname($nextviewnum) "View $nextviewnum"
1582 set newviewperm($nextviewnum) 0
1583 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1584 vieweditor $top $nextviewnum "Gitk view definition"
1589 global viewname viewperm newviewname newviewperm
1590 global viewargs newviewargs
1592 set top .gitkvedit-$curview
1593 if {[winfo exists $top]} {
1597 set newviewname($curview) $viewname($curview)
1598 set newviewperm($curview) $viewperm($curview)
1599 set newviewargs($curview) [shellarglist $viewargs($curview)]
1600 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1603 proc vieweditor {top n title} {
1604 global newviewname newviewperm viewfiles
1608 wm title $top $title
1609 label $top.nl -text "Name" -font $uifont
1610 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1611 grid $top.nl $top.name -sticky w -pady 5
1612 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1614 grid $top.perm - -pady 5 -sticky w
1615 message $top.al -aspect 1000 -font $uifont \
1616 -text "Commits to include (arguments to git rev-list):"
1617 grid $top.al - -sticky w -pady 5
1618 entry $top.args -width 50 -textvariable newviewargs($n) \
1619 -background white -font $uifont
1620 grid $top.args - -sticky ew -padx 5
1621 message $top.l -aspect 1000 -font $uifont \
1622 -text "Enter files and directories to include, one per line:"
1623 grid $top.l - -sticky w
1624 text $top.t -width 40 -height 10 -background white -font $uifont
1625 if {[info exists viewfiles($n)]} {
1626 foreach f $viewfiles($n) {
1627 $top.t insert end $f
1628 $top.t insert end "\n"
1630 $top.t delete {end - 1c} end
1631 $top.t mark set insert 0.0
1633 grid $top.t - -sticky ew -padx 5
1635 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1637 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1639 grid $top.buts.ok $top.buts.can
1640 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1641 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1642 grid $top.buts - -pady 10 -sticky ew
1646 proc doviewmenu {m first cmd op argv} {
1647 set nmenu [$m index end]
1648 for {set i $first} {$i <= $nmenu} {incr i} {
1649 if {[$m entrycget $i -command] eq $cmd} {
1650 eval $m $op $i $argv
1656 proc allviewmenus {n op args} {
1659 doviewmenu .bar.view 5 [list showview $n] $op $args
1660 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1663 proc newviewok {top n} {
1664 global nextviewnum newviewperm newviewname newishighlight
1665 global viewname viewfiles viewperm selectedview curview
1666 global viewargs newviewargs viewhlmenu
1669 set newargs [shellsplit $newviewargs($n)]
1671 error_popup "Error in commit selection arguments: $err"
1677 foreach f [split [$top.t get 0.0 end] "\n"] {
1678 set ft [string trim $f]
1683 if {![info exists viewfiles($n)]} {
1684 # creating a new view
1686 set viewname($n) $newviewname($n)
1687 set viewperm($n) $newviewperm($n)
1688 set viewfiles($n) $files
1689 set viewargs($n) $newargs
1691 if {!$newishighlight} {
1694 run addvhighlight $n
1697 # editing an existing view
1698 set viewperm($n) $newviewperm($n)
1699 if {$newviewname($n) ne $viewname($n)} {
1700 set viewname($n) $newviewname($n)
1701 doviewmenu .bar.view 5 [list showview $n] \
1702 entryconf [list -label $viewname($n)]
1703 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1704 entryconf [list -label $viewname($n) -value $viewname($n)]
1706 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1707 set viewfiles($n) $files
1708 set viewargs($n) $newargs
1709 if {$curview == $n} {
1714 catch {destroy $top}
1718 global curview viewdata viewperm hlview selectedhlview
1720 if {$curview == 0} return
1721 if {[info exists hlview] && $hlview == $curview} {
1722 set selectedhlview None
1725 allviewmenus $curview delete
1726 set viewdata($curview) {}
1727 set viewperm($curview) 0
1731 proc addviewmenu {n} {
1732 global viewname viewhlmenu
1734 .bar.view add radiobutton -label $viewname($n) \
1735 -command [list showview $n] -variable selectedview -value $n
1736 $viewhlmenu add radiobutton -label $viewname($n) \
1737 -command [list addvhighlight $n] -variable selectedhlview
1740 proc flatten {var} {
1744 foreach i [array names $var] {
1745 lappend ret $i [set $var\($i\)]
1750 proc unflatten {var l} {
1760 global curview viewdata viewfiles
1761 global displayorder parentlist rowidlist rowoffsets
1762 global colormap rowtextx commitrow nextcolor canvxmax
1763 global numcommits rowrangelist commitlisted idrowranges rowchk
1764 global selectedline currentid canv canvy0
1766 global pending_select phase
1767 global commitidx rowlaidout rowoptim
1769 global selectedview selectfirst
1770 global vparentlist vdisporder vcmitlisted
1771 global hlview selectedhlview
1773 if {$n == $curview} return
1775 if {[info exists selectedline]} {
1776 set selid $currentid
1777 set y [yc $selectedline]
1778 set ymax [lindex [$canv cget -scrollregion] 3]
1779 set span [$canv yview]
1780 set ytop [expr {[lindex $span 0] * $ymax}]
1781 set ybot [expr {[lindex $span 1] * $ymax}]
1782 if {$ytop < $y && $y < $ybot} {
1783 set yscreen [expr {$y - $ytop}]
1785 set yscreen [expr {($ybot - $ytop) / 2}]
1787 } elseif {[info exists pending_select]} {
1788 set selid $pending_select
1789 unset pending_select
1793 if {$curview >= 0} {
1794 set vparentlist($curview) $parentlist
1795 set vdisporder($curview) $displayorder
1796 set vcmitlisted($curview) $commitlisted
1798 set viewdata($curview) \
1799 [list $phase $rowidlist $rowoffsets $rowrangelist \
1800 [flatten idrowranges] [flatten idinlist] \
1801 $rowlaidout $rowoptim $numcommits]
1802 } elseif {![info exists viewdata($curview)]
1803 || [lindex $viewdata($curview) 0] ne {}} {
1804 set viewdata($curview) \
1805 [list {} $rowidlist $rowoffsets $rowrangelist]
1808 catch {unset treediffs}
1810 if {[info exists hlview] && $hlview == $n} {
1812 set selectedhlview None
1817 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1818 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1820 if {![info exists viewdata($n)]} {
1822 set pending_select $selid
1829 set phase [lindex $v 0]
1830 set displayorder $vdisporder($n)
1831 set parentlist $vparentlist($n)
1832 set commitlisted $vcmitlisted($n)
1833 set rowidlist [lindex $v 1]
1834 set rowoffsets [lindex $v 2]
1835 set rowrangelist [lindex $v 3]
1837 set numcommits [llength $displayorder]
1838 catch {unset idrowranges}
1840 unflatten idrowranges [lindex $v 4]
1841 unflatten idinlist [lindex $v 5]
1842 set rowlaidout [lindex $v 6]
1843 set rowoptim [lindex $v 7]
1844 set numcommits [lindex $v 8]
1845 catch {unset rowchk}
1848 catch {unset colormap}
1849 catch {unset rowtextx}
1851 set canvxmax [$canv cget -width]
1858 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1859 set row $commitrow($n,$selid)
1860 # try to get the selected row in the same position on the screen
1861 set ymax [lindex [$canv cget -scrollregion] 3]
1862 set ytop [expr {[yc $row] - $yscreen}]
1866 set yf [expr {$ytop * 1.0 / $ymax}]
1868 allcanvs yview moveto $yf
1872 } elseif {$selid ne {}} {
1873 set pending_select $selid
1875 set row [expr {[lindex $displayorder 0] eq $nullid}]
1876 if {$row < $numcommits} {
1883 if {$phase eq "getcommits"} {
1884 show_status "Reading commits..."
1887 } elseif {$numcommits == 0} {
1888 show_status "No commits selected"
1892 # Stuff relating to the highlighting facility
1894 proc ishighlighted {row} {
1895 global vhighlights fhighlights nhighlights rhighlights
1897 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1898 return $nhighlights($row)
1900 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1901 return $vhighlights($row)
1903 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1904 return $fhighlights($row)
1906 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1907 return $rhighlights($row)
1912 proc bolden {row font} {
1913 global canv linehtag selectedline boldrows
1915 lappend boldrows $row
1916 $canv itemconf $linehtag($row) -font $font
1917 if {[info exists selectedline] && $row == $selectedline} {
1919 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1920 -outline {{}} -tags secsel \
1921 -fill [$canv cget -selectbackground]]
1926 proc bolden_name {row font} {
1927 global canv2 linentag selectedline boldnamerows
1929 lappend boldnamerows $row
1930 $canv2 itemconf $linentag($row) -font $font
1931 if {[info exists selectedline] && $row == $selectedline} {
1932 $canv2 delete secsel
1933 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1934 -outline {{}} -tags secsel \
1935 -fill [$canv2 cget -selectbackground]]
1941 global mainfont boldrows
1944 foreach row $boldrows {
1945 if {![ishighlighted $row]} {
1946 bolden $row $mainfont
1948 lappend stillbold $row
1951 set boldrows $stillbold
1954 proc addvhighlight {n} {
1955 global hlview curview viewdata vhl_done vhighlights commitidx
1957 if {[info exists hlview]} {
1961 if {$n != $curview && ![info exists viewdata($n)]} {
1962 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1963 set vparentlist($n) {}
1964 set vdisporder($n) {}
1965 set vcmitlisted($n) {}
1968 set vhl_done $commitidx($hlview)
1969 if {$vhl_done > 0} {
1974 proc delvhighlight {} {
1975 global hlview vhighlights
1977 if {![info exists hlview]} return
1979 catch {unset vhighlights}
1983 proc vhighlightmore {} {
1984 global hlview vhl_done commitidx vhighlights
1985 global displayorder vdisporder curview mainfont
1987 set font [concat $mainfont bold]
1988 set max $commitidx($hlview)
1989 if {$hlview == $curview} {
1990 set disp $displayorder
1992 set disp $vdisporder($hlview)
1994 set vr [visiblerows]
1995 set r0 [lindex $vr 0]
1996 set r1 [lindex $vr 1]
1997 for {set i $vhl_done} {$i < $max} {incr i} {
1998 set id [lindex $disp $i]
1999 if {[info exists commitrow($curview,$id)]} {
2000 set row $commitrow($curview,$id)
2001 if {$r0 <= $row && $row <= $r1} {
2002 if {![highlighted $row]} {
2005 set vhighlights($row) 1
2012 proc askvhighlight {row id} {
2013 global hlview vhighlights commitrow iddrawn mainfont
2015 if {[info exists commitrow($hlview,$id)]} {
2016 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2017 bolden $row [concat $mainfont bold]
2019 set vhighlights($row) 1
2021 set vhighlights($row) 0
2025 proc hfiles_change {name ix op} {
2026 global highlight_files filehighlight fhighlights fh_serial
2027 global mainfont highlight_paths
2029 if {[info exists filehighlight]} {
2030 # delete previous highlights
2031 catch {close $filehighlight}
2033 catch {unset fhighlights}
2035 unhighlight_filelist
2037 set highlight_paths {}
2038 after cancel do_file_hl $fh_serial
2040 if {$highlight_files ne {}} {
2041 after 300 do_file_hl $fh_serial
2045 proc makepatterns {l} {
2048 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2049 if {[string index $ee end] eq "/"} {
2059 proc do_file_hl {serial} {
2060 global highlight_files filehighlight highlight_paths gdttype fhl_list
2062 if {$gdttype eq "touching paths:"} {
2063 if {[catch {set paths [shellsplit $highlight_files]}]} return
2064 set highlight_paths [makepatterns $paths]
2066 set gdtargs [concat -- $paths]
2068 set gdtargs [list "-S$highlight_files"]
2070 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2071 set filehighlight [open $cmd r+]
2072 fconfigure $filehighlight -blocking 0
2073 filerun $filehighlight readfhighlight
2079 proc flushhighlights {} {
2080 global filehighlight fhl_list
2082 if {[info exists filehighlight]} {
2084 puts $filehighlight ""
2085 flush $filehighlight
2089 proc askfilehighlight {row id} {
2090 global filehighlight fhighlights fhl_list
2092 lappend fhl_list $id
2093 set fhighlights($row) -1
2094 puts $filehighlight $id
2097 proc readfhighlight {} {
2098 global filehighlight fhighlights commitrow curview mainfont iddrawn
2101 if {![info exists filehighlight]} {
2105 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2106 set line [string trim $line]
2107 set i [lsearch -exact $fhl_list $line]
2108 if {$i < 0} continue
2109 for {set j 0} {$j < $i} {incr j} {
2110 set id [lindex $fhl_list $j]
2111 if {[info exists commitrow($curview,$id)]} {
2112 set fhighlights($commitrow($curview,$id)) 0
2115 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2116 if {$line eq {}} continue
2117 if {![info exists commitrow($curview,$line)]} continue
2118 set row $commitrow($curview,$line)
2119 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2120 bolden $row [concat $mainfont bold]
2122 set fhighlights($row) 1
2124 if {[eof $filehighlight]} {
2126 puts "oops, git diff-tree died"
2127 catch {close $filehighlight}
2135 proc find_change {name ix op} {
2136 global nhighlights mainfont boldnamerows
2137 global findstring findpattern findtype markingmatches
2139 # delete previous highlights, if any
2140 foreach row $boldnamerows {
2141 bolden_name $row $mainfont
2144 catch {unset nhighlights}
2147 if {$findtype ne "Regexp"} {
2148 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2150 set findpattern "*$e*"
2152 set markingmatches [expr {$findstring ne {}}]
2156 proc doesmatch {f} {
2157 global findtype findstring findpattern
2159 if {$findtype eq "Regexp"} {
2160 return [regexp $findstring $f]
2161 } elseif {$findtype eq "IgnCase"} {
2162 return [string match -nocase $findpattern $f]
2164 return [string match $findpattern $f]
2168 proc askfindhighlight {row id} {
2169 global nhighlights commitinfo iddrawn mainfont
2171 global markingmatches
2173 if {![info exists commitinfo($id)]} {
2176 set info $commitinfo($id)
2178 set fldtypes {Headline Author Date Committer CDate Comments}
2179 foreach f $info ty $fldtypes {
2180 if {($findloc eq "All fields" || $findloc eq $ty) &&
2182 if {$ty eq "Author"} {
2189 if {$isbold && [info exists iddrawn($id)]} {
2190 set f [concat $mainfont bold]
2191 if {![ishighlighted $row]} {
2197 if {$markingmatches} {
2198 markrowmatches $row [lindex $info 0] [lindex $info 1]
2201 set nhighlights($row) $isbold
2204 proc markrowmatches {row headline author} {
2205 global canv canv2 linehtag linentag
2207 $canv delete match$row
2208 $canv2 delete match$row
2209 set m [findmatches $headline]
2211 markmatches $canv $row $headline $linehtag($row) $m \
2212 [$canv itemcget $linehtag($row) -font]
2214 set m [findmatches $author]
2216 markmatches $canv2 $row $author $linentag($row) $m \
2217 [$canv2 itemcget $linentag($row) -font]
2221 proc vrel_change {name ix op} {
2222 global highlight_related
2225 if {$highlight_related ne "None"} {
2230 # prepare for testing whether commits are descendents or ancestors of a
2231 proc rhighlight_sel {a} {
2232 global descendent desc_todo ancestor anc_todo
2233 global highlight_related rhighlights
2235 catch {unset descendent}
2236 set desc_todo [list $a]
2237 catch {unset ancestor}
2238 set anc_todo [list $a]
2239 if {$highlight_related ne "None"} {
2245 proc rhighlight_none {} {
2248 catch {unset rhighlights}
2252 proc is_descendent {a} {
2253 global curview children commitrow descendent desc_todo
2256 set la $commitrow($v,$a)
2260 for {set i 0} {$i < [llength $todo]} {incr i} {
2261 set do [lindex $todo $i]
2262 if {$commitrow($v,$do) < $la} {
2263 lappend leftover $do
2266 foreach nk $children($v,$do) {
2267 if {![info exists descendent($nk)]} {
2268 set descendent($nk) 1
2276 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2280 set descendent($a) 0
2281 set desc_todo $leftover
2284 proc is_ancestor {a} {
2285 global curview parentlist commitrow ancestor anc_todo
2288 set la $commitrow($v,$a)
2292 for {set i 0} {$i < [llength $todo]} {incr i} {
2293 set do [lindex $todo $i]
2294 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2295 lappend leftover $do
2298 foreach np [lindex $parentlist $commitrow($v,$do)] {
2299 if {![info exists ancestor($np)]} {
2308 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2313 set anc_todo $leftover
2316 proc askrelhighlight {row id} {
2317 global descendent highlight_related iddrawn mainfont rhighlights
2318 global selectedline ancestor
2320 if {![info exists selectedline]} return
2322 if {$highlight_related eq "Descendent" ||
2323 $highlight_related eq "Not descendent"} {
2324 if {![info exists descendent($id)]} {
2327 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2330 } elseif {$highlight_related eq "Ancestor" ||
2331 $highlight_related eq "Not ancestor"} {
2332 if {![info exists ancestor($id)]} {
2335 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2339 if {[info exists iddrawn($id)]} {
2340 if {$isbold && ![ishighlighted $row]} {
2341 bolden $row [concat $mainfont bold]
2344 set rhighlights($row) $isbold
2347 proc next_hlcont {} {
2348 global fhl_row fhl_dirn displayorder numcommits
2349 global vhighlights fhighlights nhighlights rhighlights
2350 global hlview filehighlight findstring highlight_related
2352 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2355 if {$row < 0 || $row >= $numcommits} {
2360 set id [lindex $displayorder $row]
2361 if {[info exists hlview]} {
2362 if {![info exists vhighlights($row)]} {
2363 askvhighlight $row $id
2365 if {$vhighlights($row) > 0} break
2367 if {$findstring ne {}} {
2368 if {![info exists nhighlights($row)]} {
2369 askfindhighlight $row $id
2371 if {$nhighlights($row) > 0} break
2373 if {$highlight_related ne "None"} {
2374 if {![info exists rhighlights($row)]} {
2375 askrelhighlight $row $id
2377 if {$rhighlights($row) > 0} break
2379 if {[info exists filehighlight]} {
2380 if {![info exists fhighlights($row)]} {
2381 # ask for a few more while we're at it...
2383 for {set n 0} {$n < 100} {incr n} {
2384 if {![info exists fhighlights($r)]} {
2385 askfilehighlight $r [lindex $displayorder $r]
2388 if {$r < 0 || $r >= $numcommits} break
2392 if {$fhighlights($row) < 0} {
2396 if {$fhighlights($row) > 0} break
2404 proc next_highlight {dirn} {
2405 global selectedline fhl_row fhl_dirn
2406 global hlview filehighlight findstring highlight_related
2408 if {![info exists selectedline]} return
2409 if {!([info exists hlview] || $findstring ne {} ||
2410 $highlight_related ne "None" || [info exists filehighlight])} return
2411 set fhl_row [expr {$selectedline + $dirn}]
2416 proc cancel_next_highlight {} {
2422 # Graph layout functions
2424 proc shortids {ids} {
2427 if {[llength $id] > 1} {
2428 lappend res [shortids $id]
2429 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2430 lappend res [string range $id 0 7]
2438 proc incrange {l x o} {
2441 set e [lindex $l $x]
2443 lset l $x [expr {$e + $o}]
2452 for {} {$n > 0} {incr n -1} {
2458 proc usedinrange {id l1 l2} {
2459 global children commitrow curview
2461 if {[info exists commitrow($curview,$id)]} {
2462 set r $commitrow($curview,$id)
2463 if {$l1 <= $r && $r <= $l2} {
2464 return [expr {$r - $l1 + 1}]
2467 set kids $children($curview,$id)
2469 set r $commitrow($curview,$c)
2470 if {$l1 <= $r && $r <= $l2} {
2471 return [expr {$r - $l1 + 1}]
2477 proc sanity {row {full 0}} {
2478 global rowidlist rowoffsets
2481 set ids [lindex $rowidlist $row]
2484 if {$id eq {}} continue
2485 if {$col < [llength $ids] - 1 &&
2486 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2487 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2489 set o [lindex $rowoffsets $row $col]
2495 if {[lindex $rowidlist $y $x] != $id} {
2496 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2497 puts " id=[shortids $id] check started at row $row"
2498 for {set i $row} {$i >= $y} {incr i -1} {
2499 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2504 set o [lindex $rowoffsets $y $x]
2509 proc makeuparrow {oid x y z} {
2510 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2512 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2515 set off0 [lindex $rowoffsets $y]
2516 for {set x0 $x} {1} {incr x0} {
2517 if {$x0 >= [llength $off0]} {
2518 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2521 set z [lindex $off0 $x0]
2527 set z [expr {$x0 - $x}]
2528 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2529 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2531 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2532 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2533 lappend idrowranges($oid) [lindex $displayorder $y]
2536 proc initlayout {} {
2537 global rowidlist rowoffsets displayorder commitlisted
2538 global rowlaidout rowoptim
2539 global idinlist rowchk rowrangelist idrowranges
2540 global numcommits canvxmax canv
2543 global colormap rowtextx
2554 catch {unset idinlist}
2555 catch {unset rowchk}
2558 set canvxmax [$canv cget -width]
2559 catch {unset colormap}
2560 catch {unset rowtextx}
2561 catch {unset idrowranges}
2565 proc setcanvscroll {} {
2566 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2568 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2569 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2570 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2571 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2574 proc visiblerows {} {
2575 global canv numcommits linespc
2577 set ymax [lindex [$canv cget -scrollregion] 3]
2578 if {$ymax eq {} || $ymax == 0} return
2580 set y0 [expr {int([lindex $f 0] * $ymax)}]
2581 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2585 set y1 [expr {int([lindex $f 1] * $ymax)}]
2586 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2587 if {$r1 >= $numcommits} {
2588 set r1 [expr {$numcommits - 1}]
2590 return [list $r0 $r1]
2593 proc layoutmore {tmax allread} {
2594 global rowlaidout rowoptim commitidx numcommits optim_delay
2595 global uparrowlen curview rowidlist idinlist
2598 set showdelay $optim_delay
2599 set optdelay [expr {$uparrowlen + 1}]
2601 if {$rowoptim - $showdelay > $numcommits} {
2602 showstuff [expr {$rowoptim - $showdelay}] $showlast
2603 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2604 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2608 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2610 } elseif {$commitidx($curview) > $rowlaidout} {
2611 set nr [expr {$commitidx($curview) - $rowlaidout}]
2612 # may need to increase this threshold if uparrowlen or
2613 # mingaplen are increased...
2618 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2619 if {$rowlaidout == $row} {
2622 } elseif {$allread} {
2624 set nrows $commitidx($curview)
2625 if {[lindex $rowidlist $nrows] ne {} ||
2626 [array names idinlist] ne {}} {
2628 set rowlaidout $commitidx($curview)
2629 } elseif {$rowoptim == $nrows} {
2632 if {$numcommits == $nrows} {
2639 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2645 proc showstuff {canshow last} {
2646 global numcommits commitrow pending_select selectedline curview
2647 global lookingforhead mainheadid displayorder nullid selectfirst
2648 global lastscrollset
2650 if {$numcommits == 0} {
2652 set phase "incrdraw"
2656 set prev $numcommits
2657 set numcommits $canshow
2658 set t [clock clicks -milliseconds]
2659 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2660 set lastscrollset $t
2663 set rows [visiblerows]
2664 set r1 [lindex $rows 1]
2665 if {$r1 >= $canshow} {
2666 set r1 [expr {$canshow - 1}]
2671 if {[info exists pending_select] &&
2672 [info exists commitrow($curview,$pending_select)] &&
2673 $commitrow($curview,$pending_select) < $numcommits} {
2674 selectline $commitrow($curview,$pending_select) 1
2677 if {[info exists selectedline] || [info exists pending_select]} {
2680 set l [expr {[lindex $displayorder 0] eq $nullid}]
2685 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2686 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2687 set lookingforhead 0
2692 proc doshowlocalchanges {} {
2693 global lookingforhead curview mainheadid phase commitrow
2695 if {[info exists commitrow($curview,$mainheadid)] &&
2696 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2698 } elseif {$phase ne {}} {
2699 set lookingforhead 1
2703 proc dohidelocalchanges {} {
2704 global lookingforhead localrow lserial
2706 set lookingforhead 0
2707 if {$localrow >= 0} {
2714 # spawn off a process to do git diff-index HEAD
2715 proc dodiffindex {} {
2716 global localrow lserial
2720 set fd [open "|git diff-index HEAD" r]
2721 fconfigure $fd -blocking 0
2722 filerun $fd [list readdiffindex $fd $lserial]
2725 proc readdiffindex {fd serial} {
2726 global localrow commitrow mainheadid nullid curview
2727 global commitinfo commitdata lserial
2729 if {[gets $fd line] < 0} {
2736 # we only need to see one line and we don't really care what it says...
2739 if {$serial == $lserial && $localrow == -1} {
2740 # add the line for the local diff to the graph
2741 set localrow $commitrow($curview,$mainheadid)
2742 set hl "Local uncommitted changes"
2743 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2744 set commitdata($nullid) "\n $hl\n"
2745 insertrow $localrow $nullid
2750 proc layoutrows {row endrow last} {
2751 global rowidlist rowoffsets displayorder
2752 global uparrowlen downarrowlen maxwidth mingaplen
2753 global children parentlist
2755 global commitidx curview
2756 global idinlist rowchk rowrangelist
2758 set idlist [lindex $rowidlist $row]
2759 set offs [lindex $rowoffsets $row]
2760 while {$row < $endrow} {
2761 set id [lindex $displayorder $row]
2764 foreach p [lindex $parentlist $row] {
2765 if {![info exists idinlist($p)]} {
2767 } elseif {!$idinlist($p)} {
2771 set nev [expr {[llength $idlist] + [llength $newolds]
2772 + [llength $oldolds] - $maxwidth + 1}]
2775 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2776 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2777 set i [lindex $idlist $x]
2778 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2779 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2780 [expr {$row + $uparrowlen + $mingaplen}]]
2782 set idlist [lreplace $idlist $x $x]
2783 set offs [lreplace $offs $x $x]
2784 set offs [incrange $offs $x 1]
2786 set rm1 [expr {$row - 1}]
2787 lappend idrowranges($i) [lindex $displayorder $rm1]
2788 if {[incr nev -1] <= 0} break
2791 set rowchk($id) [expr {$row + $r}]
2794 lset rowidlist $row $idlist
2795 lset rowoffsets $row $offs
2797 set col [lsearch -exact $idlist $id]
2799 set col [llength $idlist]
2801 lset rowidlist $row $idlist
2803 if {$children($curview,$id) ne {}} {
2804 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2808 lset rowoffsets $row $offs
2810 makeuparrow $id $col $row $z
2816 if {[info exists idrowranges($id)]} {
2817 set ranges $idrowranges($id)
2819 unset idrowranges($id)
2821 lappend rowrangelist $ranges
2823 set offs [ntimes [llength $idlist] 0]
2824 set l [llength $newolds]
2825 set idlist [eval lreplace \$idlist $col $col $newolds]
2828 set offs [lrange $offs 0 [expr {$col - 1}]]
2829 foreach x $newolds {
2834 set tmp [expr {[llength $idlist] - [llength $offs]}]
2836 set offs [concat $offs [ntimes $tmp $o]]
2841 foreach i $newolds {
2843 set idrowranges($i) $id
2846 foreach oid $oldolds {
2847 set idinlist($oid) 1
2848 set idlist [linsert $idlist $col $oid]
2849 set offs [linsert $offs $col $o]
2850 makeuparrow $oid $col $row $o
2853 lappend rowidlist $idlist
2854 lappend rowoffsets $offs
2859 proc addextraid {id row} {
2860 global displayorder commitrow commitinfo
2861 global commitidx commitlisted
2862 global parentlist children curview
2864 incr commitidx($curview)
2865 lappend displayorder $id
2866 lappend commitlisted 0
2867 lappend parentlist {}
2868 set commitrow($curview,$id) $row
2870 if {![info exists commitinfo($id)]} {
2871 set commitinfo($id) {"No commit information available"}
2873 if {![info exists children($curview,$id)]} {
2874 set children($curview,$id) {}
2878 proc layouttail {} {
2879 global rowidlist rowoffsets idinlist commitidx curview
2880 global idrowranges rowrangelist
2882 set row $commitidx($curview)
2883 set idlist [lindex $rowidlist $row]
2884 while {$idlist ne {}} {
2885 set col [expr {[llength $idlist] - 1}]
2886 set id [lindex $idlist $col]
2889 lappend idrowranges($id) $id
2890 lappend rowrangelist $idrowranges($id)
2891 unset idrowranges($id)
2893 set offs [ntimes $col 0]
2894 set idlist [lreplace $idlist $col $col]
2895 lappend rowidlist $idlist
2896 lappend rowoffsets $offs
2899 foreach id [array names idinlist] {
2902 lset rowidlist $row [list $id]
2903 lset rowoffsets $row 0
2904 makeuparrow $id 0 $row 0
2905 lappend idrowranges($id) $id
2906 lappend rowrangelist $idrowranges($id)
2907 unset idrowranges($id)
2909 lappend rowidlist {}
2910 lappend rowoffsets {}
2914 proc insert_pad {row col npad} {
2915 global rowidlist rowoffsets
2917 set pad [ntimes $npad {}]
2918 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2919 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2920 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2923 proc optimize_rows {row col endrow} {
2924 global rowidlist rowoffsets displayorder
2926 for {} {$row < $endrow} {incr row} {
2927 set idlist [lindex $rowidlist $row]
2928 set offs [lindex $rowoffsets $row]
2930 for {} {$col < [llength $offs]} {incr col} {
2931 if {[lindex $idlist $col] eq {}} {
2935 set z [lindex $offs $col]
2936 if {$z eq {}} continue
2938 set x0 [expr {$col + $z}]
2939 set y0 [expr {$row - 1}]
2940 set z0 [lindex $rowoffsets $y0 $x0]
2942 set id [lindex $idlist $col]
2943 set ranges [rowranges $id]
2944 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2948 # Looking at lines from this row to the previous row,
2949 # make them go straight up if they end in an arrow on
2950 # the previous row; otherwise make them go straight up
2952 if {$z < -1 || ($z < 0 && $isarrow)} {
2953 # Line currently goes left too much;
2954 # insert pads in the previous row, then optimize it
2955 set npad [expr {-1 - $z + $isarrow}]
2956 set offs [incrange $offs $col $npad]
2957 insert_pad $y0 $x0 $npad
2959 optimize_rows $y0 $x0 $row
2961 set z [lindex $offs $col]
2962 set x0 [expr {$col + $z}]
2963 set z0 [lindex $rowoffsets $y0 $x0]
2964 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2965 # Line currently goes right too much;
2966 # insert pads in this line and adjust the next's rowoffsets
2967 set npad [expr {$z - 1 + $isarrow}]
2968 set y1 [expr {$row + 1}]
2969 set offs2 [lindex $rowoffsets $y1]
2973 if {$z eq {} || $x1 + $z < $col} continue
2974 if {$x1 + $z > $col} {
2977 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2980 set pad [ntimes $npad {}]
2981 set idlist [eval linsert \$idlist $col $pad]
2982 set tmp [eval linsert \$offs $col $pad]
2984 set offs [incrange $tmp $col [expr {-$npad}]]
2985 set z [lindex $offs $col]
2988 if {$z0 eq {} && !$isarrow} {
2989 # this line links to its first child on row $row-2
2990 set rm2 [expr {$row - 2}]
2991 set id [lindex $displayorder $rm2]
2992 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2994 set z0 [expr {$xc - $x0}]
2997 # avoid lines jigging left then immediately right
2998 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2999 insert_pad $y0 $x0 1
3000 set offs [incrange $offs $col 1]
3001 optimize_rows $y0 [expr {$x0 + 1}] $row
3006 # Find the first column that doesn't have a line going right
3007 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3008 set o [lindex $offs $col]
3010 # check if this is the link to the first child
3011 set id [lindex $idlist $col]
3012 set ranges [rowranges $id]
3013 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3014 # it is, work out offset to child
3015 set y0 [expr {$row - 1}]
3016 set id [lindex $displayorder $y0]
3017 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3019 set o [expr {$x0 - $col}]
3023 if {$o eq {} || $o <= 0} break
3025 # Insert a pad at that column as long as it has a line and
3026 # isn't the last column, and adjust the next row' offsets
3027 if {$o ne {} && [incr col] < [llength $idlist]} {
3028 set y1 [expr {$row + 1}]
3029 set offs2 [lindex $rowoffsets $y1]
3033 if {$z eq {} || $x1 + $z < $col} continue
3034 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3037 set idlist [linsert $idlist $col {}]
3038 set tmp [linsert $offs $col {}]
3040 set offs [incrange $tmp $col -1]
3043 lset rowidlist $row $idlist
3044 lset rowoffsets $row $offs
3050 global canvx0 linespc
3051 return [expr {$canvx0 + $col * $linespc}]
3055 global canvy0 linespc
3056 return [expr {$canvy0 + $row * $linespc}]
3059 proc linewidth {id} {
3060 global thickerline lthickness
3063 if {[info exists thickerline] && $id eq $thickerline} {
3064 set wid [expr {2 * $lthickness}]
3069 proc rowranges {id} {
3070 global phase idrowranges commitrow rowlaidout rowrangelist curview
3074 ([info exists commitrow($curview,$id)]
3075 && $commitrow($curview,$id) < $rowlaidout)} {
3076 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3077 } elseif {[info exists idrowranges($id)]} {
3078 set ranges $idrowranges($id)
3081 foreach rid $ranges {
3082 lappend linenos $commitrow($curview,$rid)
3084 if {$linenos ne {}} {
3085 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3090 # work around tk8.4 refusal to draw arrows on diagonal segments
3091 proc adjarrowhigh {coords} {
3094 set x0 [lindex $coords 0]
3095 set x1 [lindex $coords 2]
3097 set y0 [lindex $coords 1]
3098 set y1 [lindex $coords 3]
3099 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3100 # we have a nearby vertical segment, just trim off the diag bit
3101 set coords [lrange $coords 2 end]
3103 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3104 set xi [expr {$x0 - $slope * $linespc / 2}]
3105 set yi [expr {$y0 - $linespc / 2}]
3106 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3112 proc drawlineseg {id row endrow arrowlow} {
3113 global rowidlist displayorder iddrawn linesegs
3114 global canv colormap linespc curview maxlinelen
3116 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3117 set le [expr {$row + 1}]
3120 set c [lsearch -exact [lindex $rowidlist $le] $id]
3126 set x [lindex $displayorder $le]
3131 if {[info exists iddrawn($x)] || $le == $endrow} {
3132 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3148 if {[info exists linesegs($id)]} {
3149 set lines $linesegs($id)
3151 set r0 [lindex $li 0]
3153 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3163 set li [lindex $lines [expr {$i-1}]]
3164 set r1 [lindex $li 1]
3165 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3170 set x [lindex $cols [expr {$le - $row}]]
3171 set xp [lindex $cols [expr {$le - 1 - $row}]]
3172 set dir [expr {$xp - $x}]
3174 set ith [lindex $lines $i 2]
3175 set coords [$canv coords $ith]
3176 set ah [$canv itemcget $ith -arrow]
3177 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3178 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3179 if {$x2 ne {} && $x - $x2 == $dir} {
3180 set coords [lrange $coords 0 end-2]
3183 set coords [list [xc $le $x] [yc $le]]
3186 set itl [lindex $lines [expr {$i-1}] 2]
3187 set al [$canv itemcget $itl -arrow]
3188 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3189 } elseif {$arrowlow &&
3190 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3193 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3194 for {set y $le} {[incr y -1] > $row} {} {
3196 set xp [lindex $cols [expr {$y - 1 - $row}]]
3197 set ndir [expr {$xp - $x}]
3198 if {$dir != $ndir || $xp < 0} {
3199 lappend coords [xc $y $x] [yc $y]
3205 # join parent line to first child
3206 set ch [lindex $displayorder $row]
3207 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3209 puts "oops: drawlineseg: child $ch not on row $row"
3212 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3213 } elseif {$xc > $x + 1} {
3214 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3218 lappend coords [xc $row $x] [yc $row]
3220 set xn [xc $row $xp]
3222 # work around tk8.4 refusal to draw arrows on diagonal segments
3223 if {$arrowlow && $xn != [lindex $coords end-1]} {
3224 if {[llength $coords] < 4 ||
3225 [lindex $coords end-3] != [lindex $coords end-1] ||
3226 [lindex $coords end] - $yn > 2 * $linespc} {
3227 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3228 set yo [yc [expr {$row + 0.5}]]
3229 lappend coords $xn $yo $xn $yn
3232 lappend coords $xn $yn
3237 set coords [adjarrowhigh $coords]
3240 set t [$canv create line $coords -width [linewidth $id] \
3241 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3244 set lines [linsert $lines $i [list $row $le $t]]
3246 $canv coords $ith $coords
3247 if {$arrow ne $ah} {
3248 $canv itemconf $ith -arrow $arrow
3250 lset lines $i 0 $row
3253 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3254 set ndir [expr {$xo - $xp}]
3255 set clow [$canv coords $itl]
3256 if {$dir == $ndir} {
3257 set clow [lrange $clow 2 end]
3259 set coords [concat $coords $clow]
3261 lset lines [expr {$i-1}] 1 $le
3263 set coords [adjarrowhigh $coords]
3266 # coalesce two pieces
3268 set b [lindex $lines [expr {$i-1}] 0]
3269 set e [lindex $lines $i 1]
3270 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3272 $canv coords $itl $coords
3273 if {$arrow ne $al} {
3274 $canv itemconf $itl -arrow $arrow
3278 set linesegs($id) $lines
3282 proc drawparentlinks {id row} {
3283 global rowidlist canv colormap curview parentlist
3286 set rowids [lindex $rowidlist $row]
3287 set col [lsearch -exact $rowids $id]
3288 if {$col < 0} return
3289 set olds [lindex $parentlist $row]
3290 set row2 [expr {$row + 1}]
3291 set x [xc $row $col]
3294 set ids [lindex $rowidlist $row2]
3295 # rmx = right-most X coord used
3298 set i [lsearch -exact $ids $p]
3300 puts "oops, parent $p of $id not in list"
3303 set x2 [xc $row2 $i]
3307 if {[lsearch -exact $rowids $p] < 0} {
3308 # drawlineseg will do this one for us
3312 # should handle duplicated parents here...
3313 set coords [list $x $y]
3314 if {$i < $col - 1} {
3315 lappend coords [xc $row [expr {$i + 1}]] $y
3316 } elseif {$i > $col + 1} {
3317 lappend coords [xc $row [expr {$i - 1}]] $y
3319 lappend coords $x2 $y2
3320 set t [$canv create line $coords -width [linewidth $p] \
3321 -fill $colormap($p) -tags lines.$p]
3325 if {$rmx > [lindex $idpos($id) 1]} {
3326 lset idpos($id) 1 $rmx
3331 proc drawlines {id} {
3334 $canv itemconf lines.$id -width [linewidth $id]
3337 proc drawcmittext {id row col} {
3338 global linespc canv canv2 canv3 canvy0 fgcolor curview
3339 global commitlisted commitinfo rowidlist parentlist
3340 global rowtextx idpos idtags idheads idotherrefs
3341 global linehtag linentag linedtag markingmatches
3342 global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3344 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3345 set listed [lindex $commitlisted $row]
3346 if {$id eq $nullid} {
3349 set ofill [expr {$listed != 0? "blue": "white"}]
3351 set x [xc $row $col]
3353 set orad [expr {$linespc / 3}]
3355 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3356 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3357 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3358 } elseif {$listed == 2} {
3359 # triangle pointing left for left-side commits
3360 set t [$canv create polygon \
3361 [expr {$x - $orad}] $y \
3362 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3363 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3364 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3366 # triangle pointing right for right-side commits
3367 set t [$canv create polygon \
3368 [expr {$x + $orad - 1}] $y \
3369 [expr {$x - $orad}] [expr {$y - $orad}] \
3370 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3371 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3374 $canv bind $t <1> {selcanvline {} %x %y}
3375 set rmx [llength [lindex $rowidlist $row]]
3376 set olds [lindex $parentlist $row]
3378 set nextids [lindex $rowidlist [expr {$row + 1}]]
3380 set i [lsearch -exact $nextids $p]
3386 set xt [xc $row $rmx]
3387 set rowtextx($row) $xt
3388 set idpos($id) [list $x $xt $y]
3389 if {[info exists idtags($id)] || [info exists idheads($id)]
3390 || [info exists idotherrefs($id)]} {
3391 set xt [drawtags $id $x $xt $y]
3393 set headline [lindex $commitinfo($id) 0]
3394 set name [lindex $commitinfo($id) 1]
3395 set date [lindex $commitinfo($id) 2]
3396 set date [formatdate $date]
3399 set isbold [ishighlighted $row]
3401 lappend boldrows $row
3404 lappend boldnamerows $row
3408 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3409 -text $headline -font $font -tags text]
3410 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3411 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3412 -text $name -font $nfont -tags text]
3413 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3414 -text $date -font $mainfont -tags text]
3415 set xr [expr {$xt + [font measure $mainfont $headline]}]
3416 if {$markingmatches} {
3417 markrowmatches $row $headline $name
3419 if {$xr > $canvxmax} {
3425 proc drawcmitrow {row} {
3426 global displayorder rowidlist
3428 global commitinfo parentlist numcommits
3429 global filehighlight fhighlights findstring nhighlights
3430 global hlview vhighlights
3431 global highlight_related rhighlights
3433 if {$row >= $numcommits} return
3435 set id [lindex $displayorder $row]
3436 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3437 askvhighlight $row $id
3439 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3440 askfilehighlight $row $id
3442 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3443 askfindhighlight $row $id
3445 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3446 askrelhighlight $row $id
3448 if {[info exists iddrawn($id)]} return
3449 set col [lsearch -exact [lindex $rowidlist $row] $id]
3451 puts "oops, row $row id $id not in list"
3454 if {![info exists commitinfo($id)]} {
3458 drawcmittext $id $row $col
3462 proc drawcommits {row {endrow {}}} {
3463 global numcommits iddrawn displayorder curview
3464 global parentlist rowidlist
3469 if {$endrow eq {}} {
3472 if {$endrow >= $numcommits} {
3473 set endrow [expr {$numcommits - 1}]
3476 # make the lines join to already-drawn rows either side
3477 set r [expr {$row - 1}]
3478 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3481 set er [expr {$endrow + 1}]
3482 if {$er >= $numcommits ||
3483 ![info exists iddrawn([lindex $displayorder $er])]} {
3486 for {} {$r <= $er} {incr r} {
3487 set id [lindex $displayorder $r]
3488 set wasdrawn [info exists iddrawn($id)]
3490 if {$r == $er} break
3491 set nextid [lindex $displayorder [expr {$r + 1}]]
3492 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3493 catch {unset prevlines}
3496 drawparentlinks $id $r
3498 if {[info exists lineends($r)]} {
3499 foreach lid $lineends($r) {
3500 unset prevlines($lid)
3503 set rowids [lindex $rowidlist $r]
3504 foreach lid $rowids {
3505 if {$lid eq {}} continue
3507 # see if this is the first child of any of its parents
3508 foreach p [lindex $parentlist $r] {
3509 if {[lsearch -exact $rowids $p] < 0} {
3510 # make this line extend up to the child
3511 set le [drawlineseg $p $r $er 0]
3512 lappend lineends($le) $p
3516 } elseif {![info exists prevlines($lid)]} {
3517 set le [drawlineseg $lid $r $er 1]
3518 lappend lineends($le) $lid
3519 set prevlines($lid) 1
3525 proc drawfrac {f0 f1} {
3528 set ymax [lindex [$canv cget -scrollregion] 3]
3529 if {$ymax eq {} || $ymax == 0} return
3530 set y0 [expr {int($f0 * $ymax)}]
3531 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3532 set y1 [expr {int($f1 * $ymax)}]
3533 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3534 drawcommits $row $endrow
3537 proc drawvisible {} {
3539 eval drawfrac [$canv yview]
3542 proc clear_display {} {
3543 global iddrawn linesegs
3544 global vhighlights fhighlights nhighlights rhighlights
3547 catch {unset iddrawn}
3548 catch {unset linesegs}
3549 catch {unset vhighlights}
3550 catch {unset fhighlights}
3551 catch {unset nhighlights}
3552 catch {unset rhighlights}
3555 proc findcrossings {id} {
3556 global rowidlist parentlist numcommits rowoffsets displayorder
3560 foreach {s e} [rowranges $id] {
3561 if {$e >= $numcommits} {
3562 set e [expr {$numcommits - 1}]
3564 if {$e <= $s} continue
3565 set x [lsearch -exact [lindex $rowidlist $e] $id]
3567 puts "findcrossings: oops, no [shortids $id] in row $e"
3570 for {set row $e} {[incr row -1] >= $s} {} {
3571 set olds [lindex $parentlist $row]
3572 set kid [lindex $displayorder $row]
3573 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3574 if {$kidx < 0} continue
3575 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3577 set px [lsearch -exact $nextrow $p]
3578 if {$px < 0} continue
3579 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3580 if {[lsearch -exact $ccross $p] >= 0} continue
3581 if {$x == $px + ($kidx < $px? -1: 1)} {
3583 } elseif {[lsearch -exact $cross $p] < 0} {
3588 set inc [lindex $rowoffsets $row $x]
3589 if {$inc eq {}} break
3593 return [concat $ccross {{}} $cross]
3596 proc assigncolor {id} {
3597 global colormap colors nextcolor
3598 global commitrow parentlist children children curview
3600 if {[info exists colormap($id)]} return
3601 set ncolors [llength $colors]
3602 if {[info exists children($curview,$id)]} {
3603 set kids $children($curview,$id)
3607 if {[llength $kids] == 1} {
3608 set child [lindex $kids 0]
3609 if {[info exists colormap($child)]
3610 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3611 set colormap($id) $colormap($child)
3617 foreach x [findcrossings $id] {
3619 # delimiter between corner crossings and other crossings
3620 if {[llength $badcolors] >= $ncolors - 1} break
3621 set origbad $badcolors
3623 if {[info exists colormap($x)]
3624 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3625 lappend badcolors $colormap($x)
3628 if {[llength $badcolors] >= $ncolors} {
3629 set badcolors $origbad
3631 set origbad $badcolors
3632 if {[llength $badcolors] < $ncolors - 1} {
3633 foreach child $kids {
3634 if {[info exists colormap($child)]
3635 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3636 lappend badcolors $colormap($child)
3638 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3639 if {[info exists colormap($p)]
3640 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3641 lappend badcolors $colormap($p)
3645 if {[llength $badcolors] >= $ncolors} {
3646 set badcolors $origbad
3649 for {set i 0} {$i <= $ncolors} {incr i} {
3650 set c [lindex $colors $nextcolor]
3651 if {[incr nextcolor] >= $ncolors} {
3654 if {[lsearch -exact $badcolors $c]} break
3656 set colormap($id) $c
3659 proc bindline {t id} {
3662 $canv bind $t <Enter> "lineenter %x %y $id"
3663 $canv bind $t <Motion> "linemotion %x %y $id"
3664 $canv bind $t <Leave> "lineleave $id"
3665 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3668 proc drawtags {id x xt y1} {
3669 global idtags idheads idotherrefs mainhead
3670 global linespc lthickness
3671 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3676 if {[info exists idtags($id)]} {
3677 set marks $idtags($id)
3678 set ntags [llength $marks]
3680 if {[info exists idheads($id)]} {
3681 set marks [concat $marks $idheads($id)]
3682 set nheads [llength $idheads($id)]
3684 if {[info exists idotherrefs($id)]} {
3685 set marks [concat $marks $idotherrefs($id)]
3691 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3692 set yt [expr {$y1 - 0.5 * $linespc}]
3693 set yb [expr {$yt + $linespc - 1}]
3697 foreach tag $marks {
3699 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3700 set wid [font measure [concat $mainfont bold] $tag]
3702 set wid [font measure $mainfont $tag]
3706 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3708 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3709 -width $lthickness -fill black -tags tag.$id]
3711 foreach tag $marks x $xvals wid $wvals {
3712 set xl [expr {$x + $delta}]
3713 set xr [expr {$x + $delta + $wid + $lthickness}]
3715 if {[incr ntags -1] >= 0} {
3717 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3718 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3719 -width 1 -outline black -fill yellow -tags tag.$id]
3720 $canv bind $t <1> [list showtag $tag 1]
3721 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3723 # draw a head or other ref
3724 if {[incr nheads -1] >= 0} {
3726 if {$tag eq $mainhead} {
3732 set xl [expr {$xl - $delta/2}]
3733 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3734 -width 1 -outline black -fill $col -tags tag.$id
3735 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3736 set rwid [font measure $mainfont $remoteprefix]
3737 set xi [expr {$x + 1}]
3738 set yti [expr {$yt + 1}]
3739 set xri [expr {$x + $rwid}]
3740 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3741 -width 0 -fill "#ffddaa" -tags tag.$id
3744 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3745 -font $font -tags [list tag.$id text]]
3747 $canv bind $t <1> [list showtag $tag 1]
3748 } elseif {$nheads >= 0} {
3749 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3755 proc xcoord {i level ln} {
3756 global canvx0 xspc1 xspc2
3758 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3759 if {$i > 0 && $i == $level} {
3760 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3761 } elseif {$i > $level} {
3762 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3767 proc show_status {msg} {
3768 global canv mainfont fgcolor
3771 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3772 -tags text -fill $fgcolor
3775 # Insert a new commit as the child of the commit on row $row.
3776 # The new commit will be displayed on row $row and the commits
3777 # on that row and below will move down one row.
3778 proc insertrow {row newcmit} {
3779 global displayorder parentlist commitlisted children
3780 global commitrow curview rowidlist rowoffsets numcommits
3781 global rowrangelist rowlaidout rowoptim numcommits
3782 global selectedline rowchk commitidx
3784 if {$row >= $numcommits} {
3785 puts "oops, inserting new row $row but only have $numcommits rows"
3788 set p [lindex $displayorder $row]
3789 set displayorder [linsert $displayorder $row $newcmit]
3790 set parentlist [linsert $parentlist $row $p]
3791 set kids $children($curview,$p)
3792 lappend kids $newcmit
3793 set children($curview,$p) $kids
3794 set children($curview,$newcmit) {}
3795 set commitlisted [linsert $commitlisted $row 1]
3796 set l [llength $displayorder]
3797 for {set r $row} {$r < $l} {incr r} {
3798 set id [lindex $displayorder $r]
3799 set commitrow($curview,$id) $r
3801 incr commitidx($curview)
3803 set idlist [lindex $rowidlist $row]
3804 set offs [lindex $rowoffsets $row]
3807 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3813 if {[llength $kids] == 1} {
3814 set col [lsearch -exact $idlist $p]
3815 lset idlist $col $newcmit
3817 set col [llength $idlist]
3818 lappend idlist $newcmit
3820 lset rowoffsets $row $offs
3822 set rowidlist [linsert $rowidlist $row $idlist]
3823 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3825 set rowrangelist [linsert $rowrangelist $row {}]
3826 if {[llength $kids] > 1} {
3827 set rp1 [expr {$row + 1}]
3828 set ranges [lindex $rowrangelist $rp1]
3829 if {$ranges eq {}} {
3830 set ranges [list $newcmit $p]
3831 } elseif {[lindex $ranges end-1] eq $p} {
3832 lset ranges end-1 $newcmit
3834 lset rowrangelist $rp1 $ranges
3837 catch {unset rowchk}
3843 if {[info exists selectedline] && $selectedline >= $row} {
3849 # Remove a commit that was inserted with insertrow on row $row.
3850 proc removerow {row} {
3851 global displayorder parentlist commitlisted children
3852 global commitrow curview rowidlist rowoffsets numcommits
3853 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3854 global linesegends selectedline rowchk commitidx
3856 if {$row >= $numcommits} {
3857 puts "oops, removing row $row but only have $numcommits rows"
3860 set rp1 [expr {$row + 1}]
3861 set id [lindex $displayorder $row]
3862 set p [lindex $parentlist $row]
3863 set displayorder [lreplace $displayorder $row $row]
3864 set parentlist [lreplace $parentlist $row $row]
3865 set commitlisted [lreplace $commitlisted $row $row]
3866 set kids $children($curview,$p)
3867 set i [lsearch -exact $kids $id]
3869 set kids [lreplace $kids $i $i]
3870 set children($curview,$p) $kids
3872 set l [llength $displayorder]
3873 for {set r $row} {$r < $l} {incr r} {
3874 set id [lindex $displayorder $r]
3875 set commitrow($curview,$id) $r
3877 incr commitidx($curview) -1
3879 set rowidlist [lreplace $rowidlist $row $row]
3880 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3882 set offs [lindex $rowoffsets $row]
3883 set offs [lreplace $offs end end]
3884 lset rowoffsets $row $offs
3887 set rowrangelist [lreplace $rowrangelist $row $row]
3888 if {[llength $kids] > 0} {
3889 set ranges [lindex $rowrangelist $row]
3890 if {[lindex $ranges end-1] eq $id} {
3891 set ranges [lreplace $ranges end-1 end]
3892 lset rowrangelist $row $ranges
3896 catch {unset rowchk}
3902 if {[info exists selectedline] && $selectedline > $row} {
3903 incr selectedline -1
3908 # Don't change the text pane cursor if it is currently the hand cursor,
3909 # showing that we are over a sha1 ID link.
3910 proc settextcursor {c} {
3911 global ctext curtextcursor
3913 if {[$ctext cget -cursor] == $curtextcursor} {
3914 $ctext config -cursor $c
3916 set curtextcursor $c
3919 proc nowbusy {what} {
3922 if {[array names isbusy] eq {}} {
3923 . config -cursor watch
3929 proc notbusy {what} {
3930 global isbusy maincursor textcursor
3932 catch {unset isbusy($what)}
3933 if {[array names isbusy] eq {}} {
3934 . config -cursor $maincursor
3935 settextcursor $textcursor
3939 proc findmatches {f} {
3940 global findtype findstring
3941 if {$findtype == "Regexp"} {
3942 set matches [regexp -indices -all -inline $findstring $f]
3945 if {$findtype == "IgnCase"} {
3946 set f [string tolower $f]
3947 set fs [string tolower $fs]
3951 set l [string length $fs]
3952 while {[set j [string first $fs $f $i]] >= 0} {
3953 lappend matches [list $j [expr {$j+$l-1}]]
3954 set i [expr {$j + $l}]
3960 proc dofind {{rev 0}} {
3961 global findstring findstartline findcurline selectedline numcommits
3964 cancel_next_highlight
3966 if {$findstring eq {} || $numcommits == 0} return
3967 if {![info exists selectedline]} {
3968 set findstartline [lindex [visiblerows] $rev]
3970 set findstartline $selectedline
3972 set findcurline $findstartline
3977 set findcurline $findstartline
3978 if {$findcurline == 0} {
3979 set findcurline $numcommits
3986 proc findnext {restart} {
3988 if {![info exists findcurline]} {
4002 if {![info exists findcurline]} {
4011 global commitdata commitinfo numcommits findstring findpattern findloc
4012 global findstartline findcurline markingmatches displayorder
4014 set fldtypes {Headline Author Date Committer CDate Comments}
4015 set l [expr {$findcurline + 1}]
4016 if {$l >= $numcommits} {
4019 if {$l <= $findstartline} {
4020 set lim [expr {$findstartline + 1}]
4024 if {$lim - $l > 500} {
4025 set lim [expr {$l + 500}]
4028 for {} {$l < $lim} {incr l} {
4029 set id [lindex $displayorder $l]
4030 if {![doesmatch $commitdata($id)]} continue
4031 if {![info exists commitinfo($id)]} {
4034 set info $commitinfo($id)
4035 foreach f $info ty $fldtypes {
4036 if {($findloc eq "All fields" || $findloc eq $ty) &&
4038 set markingmatches 1
4045 if {$l == $findstartline + 1} {
4051 set findcurline [expr {$l - 1}]
4055 proc findmorerev {} {
4056 global commitdata commitinfo numcommits findstring findpattern findloc
4057 global findstartline findcurline markingmatches displayorder
4059 set fldtypes {Headline Author Date Committer CDate Comments}
4065 if {$l >= $findstartline} {
4066 set lim [expr {$findstartline - 1}]
4070 if {$l - $lim > 500} {
4071 set lim [expr {$l - 500}]
4074 for {} {$l > $lim} {incr l -1} {
4075 set id [lindex $displayorder $l]
4076 if {![doesmatch $commitdata($id)]} continue
4077 if {![info exists commitinfo($id)]} {
4080 set info $commitinfo($id)
4081 foreach f $info ty $fldtypes {
4082 if {($findloc eq "All fields" || $findloc eq $ty) &&
4084 set markingmatches 1
4097 set findcurline [expr {$l + 1}]
4101 proc findselectline {l} {
4102 global findloc commentend ctext
4104 if {$findloc == "All fields" || $findloc == "Comments"} {
4105 # highlight the matches in the comments
4106 set f [$ctext get 1.0 $commentend]
4107 set matches [findmatches $f]
4108 foreach match $matches {
4109 set start [lindex $match 0]
4110 set end [expr {[lindex $match 1] + 1}]
4111 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4116 # mark the bits of a headline or author that match a find string
4117 proc markmatches {canv l str tag matches font} {
4118 set bbox [$canv bbox $tag]
4119 set x0 [lindex $bbox 0]
4120 set y0 [lindex $bbox 1]
4121 set y1 [lindex $bbox 3]
4122 foreach match $matches {
4123 set start [lindex $match 0]
4124 set end [lindex $match 1]
4125 if {$start > $end} continue
4126 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4127 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4128 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4129 [expr {$x0+$xlen+2}] $y1 \
4130 -outline {} -tags [list match$l matches] -fill yellow]
4135 proc unmarkmatches {} {
4136 global findids markingmatches findcurline
4138 allcanvs delete matches
4139 catch {unset findids}
4140 set markingmatches 0
4141 catch {unset findcurline}
4144 proc selcanvline {w x y} {
4145 global canv canvy0 ctext linespc
4147 set ymax [lindex [$canv cget -scrollregion] 3]
4148 if {$ymax == {}} return
4149 set yfrac [lindex [$canv yview] 0]
4150 set y [expr {$y + $yfrac * $ymax}]
4151 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4156 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4162 proc commit_descriptor {p} {
4164 if {![info exists commitinfo($p)]} {
4168 if {[llength $commitinfo($p)] > 1} {
4169 set l [lindex $commitinfo($p) 0]
4174 # append some text to the ctext widget, and make any SHA1 ID
4175 # that we know about be a clickable link.
4176 proc appendwithlinks {text tags} {
4177 global ctext commitrow linknum curview
4179 set start [$ctext index "end - 1c"]
4180 $ctext insert end $text $tags
4181 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4185 set linkid [string range $text $s $e]
4186 if {![info exists commitrow($curview,$linkid)]} continue
4188 $ctext tag add link "$start + $s c" "$start + $e c"
4189 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4190 $ctext tag bind link$linknum <1> \
4191 [list selectline $commitrow($curview,$linkid) 1]
4194 $ctext tag conf link -foreground blue -underline 1
4195 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4196 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4199 proc viewnextline {dir} {
4203 set ymax [lindex [$canv cget -scrollregion] 3]
4204 set wnow [$canv yview]
4205 set wtop [expr {[lindex $wnow 0] * $ymax}]
4206 set newtop [expr {$wtop + $dir * $linespc}]
4209 } elseif {$newtop > $ymax} {
4212 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4215 # add a list of tag or branch names at position pos
4216 # returns the number of names inserted
4217 proc appendrefs {pos ids var} {
4218 global ctext commitrow linknum curview $var maxrefs
4220 if {[catch {$ctext index $pos}]} {
4223 $ctext conf -state normal
4224 $ctext delete $pos "$pos lineend"
4227 foreach tag [set $var\($id\)] {
4228 lappend tags [list $tag $id]
4231 if {[llength $tags] > $maxrefs} {
4232 $ctext insert $pos "many ([llength $tags])"
4234 set tags [lsort -index 0 -decreasing $tags]
4237 set id [lindex $ti 1]
4240 $ctext tag delete $lk
4241 $ctext insert $pos $sep
4242 $ctext insert $pos [lindex $ti 0] $lk
4243 if {[info exists commitrow($curview,$id)]} {
4244 $ctext tag conf $lk -foreground blue
4245 $ctext tag bind $lk <1> \
4246 [list selectline $commitrow($curview,$id) 1]
4247 $ctext tag conf $lk -underline 1
4248 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4249 $ctext tag bind $lk <Leave> \
4250 { %W configure -cursor $curtextcursor }
4255 $ctext conf -state disabled
4256 return [llength $tags]
4259 # called when we have finished computing the nearby tags
4260 proc dispneartags {delay} {
4261 global selectedline currentid showneartags tagphase
4263 if {![info exists selectedline] || !$showneartags} return
4264 after cancel dispnexttag
4266 after 200 dispnexttag
4269 after idle dispnexttag
4274 proc dispnexttag {} {
4275 global selectedline currentid showneartags tagphase ctext
4277 if {![info exists selectedline] || !$showneartags} return
4278 switch -- $tagphase {
4280 set dtags [desctags $currentid]
4282 appendrefs precedes $dtags idtags
4286 set atags [anctags $currentid]
4288 appendrefs follows $atags idtags
4292 set dheads [descheads $currentid]
4293 if {$dheads ne {}} {
4294 if {[appendrefs branch $dheads idheads] > 1
4295 && [$ctext get "branch -3c"] eq "h"} {
4296 # turn "Branch" into "Branches"
4297 $ctext conf -state normal
4298 $ctext insert "branch -2c" "es"
4299 $ctext conf -state disabled
4304 if {[incr tagphase] <= 2} {
4305 after idle dispnexttag
4309 proc selectline {l isnew} {
4310 global canv canv2 canv3 ctext commitinfo selectedline
4311 global displayorder linehtag linentag linedtag
4312 global canvy0 linespc parentlist children curview
4313 global currentid sha1entry
4314 global commentend idtags linknum
4315 global mergemax numcommits pending_select
4316 global cmitmode showneartags allcommits
4318 catch {unset pending_select}
4321 cancel_next_highlight
4322 if {$l < 0 || $l >= $numcommits} return
4323 set y [expr {$canvy0 + $l * $linespc}]
4324 set ymax [lindex [$canv cget -scrollregion] 3]
4325 set ytop [expr {$y - $linespc - 1}]
4326 set ybot [expr {$y + $linespc + 1}]
4327 set wnow [$canv yview]
4328 set wtop [expr {[lindex $wnow 0] * $ymax}]
4329 set wbot [expr {[lindex $wnow 1] * $ymax}]
4330 set wh [expr {$wbot - $wtop}]
4332 if {$ytop < $wtop} {
4333 if {$ybot < $wtop} {
4334 set newtop [expr {$y - $wh / 2.0}]
4337 if {$newtop > $wtop - $linespc} {
4338 set newtop [expr {$wtop - $linespc}]
4341 } elseif {$ybot > $wbot} {
4342 if {$ytop > $wbot} {
4343 set newtop [expr {$y - $wh / 2.0}]
4345 set newtop [expr {$ybot - $wh}]
4346 if {$newtop < $wtop + $linespc} {
4347 set newtop [expr {$wtop + $linespc}]
4351 if {$newtop != $wtop} {
4355 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4359 if {![info exists linehtag($l)]} return
4361 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4362 -tags secsel -fill [$canv cget -selectbackground]]
4364 $canv2 delete secsel
4365 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4366 -tags secsel -fill [$canv2 cget -selectbackground]]
4368 $canv3 delete secsel
4369 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4370 -tags secsel -fill [$canv3 cget -selectbackground]]
4374 addtohistory [list selectline $l 0]
4379 set id [lindex $displayorder $l]
4381 $sha1entry delete 0 end
4382 $sha1entry insert 0 $id
4383 $sha1entry selection from 0
4384 $sha1entry selection to end
4387 $ctext conf -state normal
4390 set info $commitinfo($id)
4391 set date [formatdate [lindex $info 2]]
4392 $ctext insert end "Author: [lindex $info 1] $date\n"
4393 set date [formatdate [lindex $info 4]]
4394 $ctext insert end "Committer: [lindex $info 3] $date\n"
4395 if {[info exists idtags($id)]} {
4396 $ctext insert end "Tags:"
4397 foreach tag $idtags($id) {
4398 $ctext insert end " $tag"
4400 $ctext insert end "\n"
4404 set olds [lindex $parentlist $l]
4405 if {[llength $olds] > 1} {
4408 if {$np >= $mergemax} {
4413 $ctext insert end "Parent: " $tag
4414 appendwithlinks [commit_descriptor $p] {}
4419 append headers "Parent: [commit_descriptor $p]"
4423 foreach c $children($curview,$id) {
4424 append headers "Child: [commit_descriptor $c]"
4427 # make anything that looks like a SHA1 ID be a clickable link
4428 appendwithlinks $headers {}
4429 if {$showneartags} {
4430 if {![info exists allcommits]} {
4433 $ctext insert end "Branch: "
4434 $ctext mark set branch "end -1c"
4435 $ctext mark gravity branch left
4436 $ctext insert end "\nFollows: "
4437 $ctext mark set follows "end -1c"
4438 $ctext mark gravity follows left
4439 $ctext insert end "\nPrecedes: "
4440 $ctext mark set precedes "end -1c"
4441 $ctext mark gravity precedes left
4442 $ctext insert end "\n"
4445 $ctext insert end "\n"
4446 set comment [lindex $info 5]
4447 if {[string first "\r" $comment] >= 0} {
4448 set comment [string map {"\r" "\n "} $comment]
4450 appendwithlinks $comment {comment}
4452 $ctext tag remove found 1.0 end
4453 $ctext conf -state disabled
4454 set commentend [$ctext index "end - 1c"]
4456 init_flist "Comments"
4457 if {$cmitmode eq "tree"} {
4459 } elseif {[llength $olds] <= 1} {
4466 proc selfirstline {} {
4471 proc sellastline {} {
4474 set l [expr {$numcommits - 1}]
4478 proc selnextline {dir} {
4480 if {![info exists selectedline]} return
4481 set l [expr {$selectedline + $dir}]
4486 proc selnextpage {dir} {
4487 global canv linespc selectedline numcommits
4489 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4493 allcanvs yview scroll [expr {$dir * $lpp}] units
4495 if {![info exists selectedline]} return
4496 set l [expr {$selectedline + $dir * $lpp}]
4499 } elseif {$l >= $numcommits} {
4500 set l [expr $numcommits - 1]
4506 proc unselectline {} {
4507 global selectedline currentid
4509 catch {unset selectedline}
4510 catch {unset currentid}
4511 allcanvs delete secsel
4513 cancel_next_highlight
4516 proc reselectline {} {
4519 if {[info exists selectedline]} {
4520 selectline $selectedline 0
4524 proc addtohistory {cmd} {
4525 global history historyindex curview
4527 set elt [list $curview $cmd]
4528 if {$historyindex > 0
4529 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4533 if {$historyindex < [llength $history]} {
4534 set history [lreplace $history $historyindex end $elt]
4536 lappend history $elt
4539 if {$historyindex > 1} {
4540 .tf.bar.leftbut conf -state normal
4542 .tf.bar.leftbut conf -state disabled
4544 .tf.bar.rightbut conf -state disabled
4550 set view [lindex $elt 0]
4551 set cmd [lindex $elt 1]
4552 if {$curview != $view} {
4559 global history historyindex
4561 if {$historyindex > 1} {
4562 incr historyindex -1
4563 godo [lindex $history [expr {$historyindex - 1}]]
4564 .tf.bar.rightbut conf -state normal
4566 if {$historyindex <= 1} {
4567 .tf.bar.leftbut conf -state disabled
4572 global history historyindex
4574 if {$historyindex < [llength $history]} {
4575 set cmd [lindex $history $historyindex]
4578 .tf.bar.leftbut conf -state normal
4580 if {$historyindex >= [llength $history]} {
4581 .tf.bar.rightbut conf -state disabled
4586 global treefilelist treeidlist diffids diffmergeid treepending nullid
4589 catch {unset diffmergeid}
4590 if {![info exists treefilelist($id)]} {
4591 if {![info exists treepending]} {
4592 if {$id ne $nullid} {
4593 set cmd [concat | git ls-tree -r $id]
4595 set cmd [concat | git ls-files]
4597 if {[catch {set gtf [open $cmd r]}]} {
4601 set treefilelist($id) {}
4602 set treeidlist($id) {}
4603 fconfigure $gtf -blocking 0
4604 filerun $gtf [list gettreeline $gtf $id]
4611 proc gettreeline {gtf id} {
4612 global treefilelist treeidlist treepending cmitmode diffids nullid
4615 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4616 if {$diffids ne $nullid} {
4617 if {[lindex $line 1] ne "blob"} continue
4618 set i [string first "\t" $line]
4619 if {$i < 0} continue
4620 set sha1 [lindex $line 2]
4621 set fname [string range $line [expr {$i+1}] end]
4622 if {[string index $fname 0] eq "\""} {
4623 set fname [lindex $fname 0]
4625 lappend treeidlist($id) $sha1
4629 lappend treefilelist($id) $fname
4632 return [expr {$nl >= 1000? 2: 1}]
4636 if {$cmitmode ne "tree"} {
4637 if {![info exists diffmergeid]} {
4638 gettreediffs $diffids
4640 } elseif {$id ne $diffids} {
4649 global treefilelist treeidlist diffids nullid
4650 global ctext commentend
4652 set i [lsearch -exact $treefilelist($diffids) $f]
4654 puts "oops, $f not in list for id $diffids"
4657 if {$diffids ne $nullid} {
4658 set blob [lindex $treeidlist($diffids) $i]
4659 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4660 puts "oops, error reading blob $blob: $err"
4664 if {[catch {set bf [open $f r]} err]} {
4665 puts "oops, can't read $f: $err"
4669 fconfigure $bf -blocking 0
4670 filerun $bf [list getblobline $bf $diffids]
4671 $ctext config -state normal
4672 clear_ctext $commentend
4673 $ctext insert end "\n"
4674 $ctext insert end "$f\n" filesep
4675 $ctext config -state disabled
4676 $ctext yview $commentend
4679 proc getblobline {bf id} {
4680 global diffids cmitmode ctext
4682 if {$id ne $diffids || $cmitmode ne "tree"} {
4686 $ctext config -state normal
4688 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4689 $ctext insert end "$line\n"
4692 # delete last newline
4693 $ctext delete "end - 2c" "end - 1c"
4697 $ctext config -state disabled
4698 return [expr {$nl >= 1000? 2: 1}]
4701 proc mergediff {id l} {
4702 global diffmergeid diffopts mdifffd
4708 # this doesn't seem to actually affect anything...
4709 set env(GIT_DIFF_OPTS) $diffopts
4710 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4711 if {[catch {set mdf [open $cmd r]} err]} {
4712 error_popup "Error getting merge diffs: $err"
4715 fconfigure $mdf -blocking 0
4716 set mdifffd($id) $mdf
4717 set np [llength [lindex $parentlist $l]]
4718 filerun $mdf [list getmergediffline $mdf $id $np]
4721 proc getmergediffline {mdf id np} {
4722 global diffmergeid ctext cflist mergemax
4723 global difffilestart mdifffd
4725 $ctext conf -state normal
4727 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4728 if {![info exists diffmergeid] || $id != $diffmergeid
4729 || $mdf != $mdifffd($id)} {
4733 if {[regexp {^diff --cc (.*)} $line match fname]} {
4734 # start of a new file
4735 $ctext insert end "\n"
4736 set here [$ctext index "end - 1c"]
4737 lappend difffilestart $here
4738 add_flist [list $fname]
4739 set l [expr {(78 - [string length $fname]) / 2}]
4740 set pad [string range "----------------------------------------" 1 $l]
4741 $ctext insert end "$pad $fname $pad\n" filesep
4742 } elseif {[regexp {^@@} $line]} {
4743 $ctext insert end "$line\n" hunksep
4744 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4747 # parse the prefix - one ' ', '-' or '+' for each parent
4752 for {set j 0} {$j < $np} {incr j} {
4753 set c [string range $line $j $j]
4756 } elseif {$c == "-"} {
4758 } elseif {$c == "+"} {
4767 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4768 # line doesn't appear in result, parents in $minuses have the line
4769 set num [lindex $minuses 0]
4770 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4771 # line appears in result, parents in $pluses don't have the line
4772 lappend tags mresult
4773 set num [lindex $spaces 0]
4776 if {$num >= $mergemax} {
4781 $ctext insert end "$line\n" $tags
4784 $ctext conf -state disabled
4789 return [expr {$nr >= 1000? 2: 1}]
4792 proc startdiff {ids} {
4793 global treediffs diffids treepending diffmergeid nullid
4796 catch {unset diffmergeid}
4797 if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4798 if {![info exists treepending]} {
4806 proc addtocflist {ids} {
4807 global treediffs cflist
4808 add_flist $treediffs($ids)
4812 proc diffcmd {ids flags} {
4815 set i [lsearch -exact $ids $nullid]
4817 set cmd [concat | git diff-index $flags]
4818 if {[llength $ids] > 1} {
4820 lappend cmd -R [lindex $ids 1]
4822 lappend cmd [lindex $ids 0]
4828 set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4833 proc gettreediffs {ids} {
4834 global treediff treepending
4836 set treepending $ids
4838 if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4839 fconfigure $gdtf -blocking 0
4840 filerun $gdtf [list gettreediffline $gdtf $ids]
4843 proc gettreediffline {gdtf ids} {
4844 global treediff treediffs treepending diffids diffmergeid
4848 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4849 set i [string first "\t" $line]
4851 set file [string range $line [expr {$i+1}] end]
4852 if {[string index $file 0] eq "\""} {
4853 set file [lindex $file 0]
4855 lappend treediff $file
4859 return [expr {$nr >= 1000? 2: 1}]
4862 set treediffs($ids) $treediff
4864 if {$cmitmode eq "tree"} {
4866 } elseif {$ids != $diffids} {
4867 if {![info exists diffmergeid]} {
4868 gettreediffs $diffids
4876 proc getblobdiffs {ids} {
4877 global diffopts blobdifffd diffids env
4878 global diffinhdr treediffs
4880 set env(GIT_DIFF_OPTS) $diffopts
4881 if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4882 puts "error getting diffs: $err"
4886 fconfigure $bdf -blocking 0
4887 set blobdifffd($ids) $bdf
4888 filerun $bdf [list getblobdiffline $bdf $diffids]
4891 proc setinlist {var i val} {
4894 while {[llength [set $var]] < $i} {
4897 if {[llength [set $var]] == $i} {
4904 proc makediffhdr {fname ids} {
4905 global ctext curdiffstart treediffs
4907 set i [lsearch -exact $treediffs($ids) $fname]
4909 setinlist difffilestart $i $curdiffstart
4911 set l [expr {(78 - [string length $fname]) / 2}]
4912 set pad [string range "----------------------------------------" 1 $l]
4913 $ctext insert $curdiffstart "$pad $fname $pad" filesep
4916 proc getblobdiffline {bdf ids} {
4917 global diffids blobdifffd ctext curdiffstart
4918 global diffnexthead diffnextnote difffilestart
4919 global diffinhdr treediffs
4922 $ctext conf -state normal
4923 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4924 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4928 if {![string compare -length 11 "diff --git " $line]} {
4929 # trim off "diff --git "
4930 set line [string range $line 11 end]
4932 # start of a new file
4933 $ctext insert end "\n"
4934 set curdiffstart [$ctext index "end - 1c"]
4935 $ctext insert end "\n" filesep
4936 # If the name hasn't changed the length will be odd,
4937 # the middle char will be a space, and the two bits either
4938 # side will be a/name and b/name, or "a/name" and "b/name".
4939 # If the name has changed we'll get "rename from" and
4940 # "rename to" lines following this, and we'll use them
4941 # to get the filenames.
4942 # This complexity is necessary because spaces in the filename(s)
4943 # don't get escaped.
4944 set l [string length $line]
4945 set i [expr {$l / 2}]
4946 if {!(($l & 1) && [string index $line $i] eq " " &&
4947 [string range $line 2 [expr {$i - 1}]] eq \
4948 [string range $line [expr {$i + 3}] end])} {
4951 # unescape if quoted and chop off the a/ from the front
4952 if {[string index $line 0] eq "\""} {
4953 set fname [string range [lindex $line 0] 2 end]
4955 set fname [string range $line 2 [expr {$i - 1}]]
4957 makediffhdr $fname $ids
4959 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
4960 $line match f1l f1c f2l f2c rest]} {
4961 $ctext insert end "$line\n" hunksep
4964 } elseif {$diffinhdr} {
4965 if {![string compare -length 12 "rename from " $line]} {
4966 set fname [string range $line 12 end]
4967 if {[string index $fname 0] eq "\""} {
4968 set fname [lindex $fname 0]
4970 set i [lsearch -exact $treediffs($ids) $fname]
4972 setinlist difffilestart $i $curdiffstart
4974 } elseif {![string compare -length 10 $line "rename to "]} {
4975 set fname [string range $line 10 end]
4976 if {[string index $fname 0] eq "\""} {
4977 set fname [lindex $fname 0]
4979 makediffhdr $fname $ids
4980 } elseif {[string compare -length 3 $line "---"] == 0} {
4983 } elseif {[string compare -length 3 $line "+++"] == 0} {
4987 $ctext insert end "$line\n" filesep
4990 set x [string range $line 0 0]
4991 if {$x == "-" || $x == "+"} {
4992 set tag [expr {$x == "+"}]
4993 $ctext insert end "$line\n" d$tag
4994 } elseif {$x == " "} {
4995 $ctext insert end "$line\n"
4997 # "\ No newline at end of file",
4998 # or something else we don't recognize
4999 $ctext insert end "$line\n" hunksep
5003 $ctext conf -state disabled
5008 return [expr {$nr >= 1000? 2: 1}]
5011 proc changediffdisp {} {
5012 global ctext diffelide
5014 $ctext tag conf d0 -elide [lindex $diffelide 0]
5015 $ctext tag conf d1 -elide [lindex $diffelide 1]
5019 global difffilestart ctext
5020 set prev [lindex $difffilestart 0]
5021 set here [$ctext index @0,0]
5022 foreach loc $difffilestart {
5023 if {[$ctext compare $loc >= $here]} {
5033 global difffilestart ctext
5034 set here [$ctext index @0,0]
5035 foreach loc $difffilestart {
5036 if {[$ctext compare $loc > $here]} {
5043 proc clear_ctext {{first 1.0}} {
5044 global ctext smarktop smarkbot
5046 set l [lindex [split $first .] 0]
5047 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5050 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5053 $ctext delete $first end
5056 proc incrsearch {name ix op} {
5057 global ctext searchstring searchdirn
5059 $ctext tag remove found 1.0 end
5060 if {[catch {$ctext index anchor}]} {
5061 # no anchor set, use start of selection, or of visible area
5062 set sel [$ctext tag ranges sel]
5064 $ctext mark set anchor [lindex $sel 0]
5065 } elseif {$searchdirn eq "-forwards"} {
5066 $ctext mark set anchor @0,0
5068 $ctext mark set anchor @0,[winfo height $ctext]
5071 if {$searchstring ne {}} {
5072 set here [$ctext search $searchdirn -- $searchstring anchor]
5081 global sstring ctext searchstring searchdirn
5084 $sstring icursor end
5085 set searchdirn -forwards
5086 if {$searchstring ne {}} {
5087 set sel [$ctext tag ranges sel]
5089 set start "[lindex $sel 0] + 1c"
5090 } elseif {[catch {set start [$ctext index anchor]}]} {
5093 set match [$ctext search -count mlen -- $searchstring $start]
5094 $ctext tag remove sel 1.0 end
5100 set mend "$match + $mlen c"
5101 $ctext tag add sel $match $mend
5102 $ctext mark unset anchor
5106 proc dosearchback {} {
5107 global sstring ctext searchstring searchdirn
5110 $sstring icursor end
5111 set searchdirn -backwards
5112 if {$searchstring ne {}} {
5113 set sel [$ctext tag ranges sel]
5115 set start [lindex $sel 0]
5116 } elseif {[catch {set start [$ctext index anchor]}]} {
5117 set start @0,[winfo height $ctext]
5119 set match [$ctext search -backwards -count ml -- $searchstring $start]
5120 $ctext tag remove sel 1.0 end
5126 set mend "$match + $ml c"
5127 $ctext tag add sel $match $mend
5128 $ctext mark unset anchor
5132 proc searchmark {first last} {
5133 global ctext searchstring
5137 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5138 if {$match eq {}} break
5139 set mend "$match + $mlen c"
5140 $ctext tag add found $match $mend
5144 proc searchmarkvisible {doall} {
5145 global ctext smarktop smarkbot
5147 set topline [lindex [split [$ctext index @0,0] .] 0]
5148 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5149 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5150 # no overlap with previous
5151 searchmark $topline $botline
5152 set smarktop $topline
5153 set smarkbot $botline
5155 if {$topline < $smarktop} {
5156 searchmark $topline [expr {$smarktop-1}]
5157 set smarktop $topline
5159 if {$botline > $smarkbot} {
5160 searchmark [expr {$smarkbot+1}] $botline
5161 set smarkbot $botline
5166 proc scrolltext {f0 f1} {
5169 .bleft.sb set $f0 $f1
5170 if {$searchstring ne {}} {
5176 global linespc charspc canvx0 canvy0 mainfont
5177 global xspc1 xspc2 lthickness
5179 set linespc [font metrics $mainfont -linespace]
5180 set charspc [font measure $mainfont "m"]
5181 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5182 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5183 set lthickness [expr {int($linespc / 9) + 1}]
5184 set xspc1(0) $linespc
5192 set ymax [lindex [$canv cget -scrollregion] 3]
5193 if {$ymax eq {} || $ymax == 0} return
5194 set span [$canv yview]
5197 allcanvs yview moveto [lindex $span 0]
5199 if {[info exists selectedline]} {
5200 selectline $selectedline 0
5201 allcanvs yview moveto [lindex $span 0]
5205 proc incrfont {inc} {
5206 global mainfont textfont ctext canv phase cflist
5207 global charspc tabstop
5208 global stopped entries
5210 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5211 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5213 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5214 $cflist conf -font $textfont
5215 $ctext tag conf filesep -font [concat $textfont bold]
5216 foreach e $entries {
5217 $e conf -font $mainfont
5219 if {$phase eq "getcommits"} {
5220 $canv itemconf textitems -font $mainfont
5226 global sha1entry sha1string
5227 if {[string length $sha1string] == 40} {
5228 $sha1entry delete 0 end
5232 proc sha1change {n1 n2 op} {
5233 global sha1string currentid sha1but
5234 if {$sha1string == {}
5235 || ([info exists currentid] && $sha1string == $currentid)} {
5240 if {[$sha1but cget -state] == $state} return
5241 if {$state == "normal"} {
5242 $sha1but conf -state normal -relief raised -text "Goto: "
5244 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5248 proc gotocommit {} {
5249 global sha1string currentid commitrow tagids headids
5250 global displayorder numcommits curview
5252 if {$sha1string == {}
5253 || ([info exists currentid] && $sha1string == $currentid)} return
5254 if {[info exists tagids($sha1string)]} {
5255 set id $tagids($sha1string)
5256 } elseif {[info exists headids($sha1string)]} {
5257 set id $headids($sha1string)
5259 set id [string tolower $sha1string]
5260 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5262 foreach i $displayorder {
5263 if {[string match $id* $i]} {
5267 if {$matches ne {}} {
5268 if {[llength $matches] > 1} {
5269 error_popup "Short SHA1 id $id is ambiguous"
5272 set id [lindex $matches 0]
5276 if {[info exists commitrow($curview,$id)]} {
5277 selectline $commitrow($curview,$id) 1
5280 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5285 error_popup "$type $sha1string is not known"
5288 proc lineenter {x y id} {
5289 global hoverx hovery hoverid hovertimer
5290 global commitinfo canv
5292 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5296 if {[info exists hovertimer]} {
5297 after cancel $hovertimer
5299 set hovertimer [after 500 linehover]
5303 proc linemotion {x y id} {
5304 global hoverx hovery hoverid hovertimer
5306 if {[info exists hoverid] && $id == $hoverid} {
5309 if {[info exists hovertimer]} {
5310 after cancel $hovertimer
5312 set hovertimer [after 500 linehover]
5316 proc lineleave {id} {
5317 global hoverid hovertimer canv
5319 if {[info exists hoverid] && $id == $hoverid} {
5321 if {[info exists hovertimer]} {
5322 after cancel $hovertimer
5330 global hoverx hovery hoverid hovertimer
5331 global canv linespc lthickness
5332 global commitinfo mainfont
5334 set text [lindex $commitinfo($hoverid) 0]
5335 set ymax [lindex [$canv cget -scrollregion] 3]
5336 if {$ymax == {}} return
5337 set yfrac [lindex [$canv yview] 0]
5338 set x [expr {$hoverx + 2 * $linespc}]
5339 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5340 set x0 [expr {$x - 2 * $lthickness}]
5341 set y0 [expr {$y - 2 * $lthickness}]
5342 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5343 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5344 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5345 -fill \#ffff80 -outline black -width 1 -tags hover]
5347 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5352 proc clickisonarrow {id y} {
5355 set ranges [rowranges $id]
5356 set thresh [expr {2 * $lthickness + 6}]
5357 set n [expr {[llength $ranges] - 1}]
5358 for {set i 1} {$i < $n} {incr i} {
5359 set row [lindex $ranges $i]
5360 if {abs([yc $row] - $y) < $thresh} {
5367 proc arrowjump {id n y} {
5370 # 1 <-> 2, 3 <-> 4, etc...
5371 set n [expr {(($n - 1) ^ 1) + 1}]
5372 set row [lindex [rowranges $id] $n]
5374 set ymax [lindex [$canv cget -scrollregion] 3]
5375 if {$ymax eq {} || $ymax <= 0} return
5376 set view [$canv yview]
5377 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5378 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5382 allcanvs yview moveto $yfrac
5385 proc lineclick {x y id isnew} {
5386 global ctext commitinfo children canv thickerline curview
5388 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5393 # draw this line thicker than normal
5397 set ymax [lindex [$canv cget -scrollregion] 3]
5398 if {$ymax eq {}} return
5399 set yfrac [lindex [$canv yview] 0]
5400 set y [expr {$y + $yfrac * $ymax}]
5402 set dirn [clickisonarrow $id $y]
5404 arrowjump $id $dirn $y
5409 addtohistory [list lineclick $x $y $id 0]
5411 # fill the details pane with info about this line
5412 $ctext conf -state normal
5414 $ctext tag conf link -foreground blue -underline 1
5415 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5416 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5417 $ctext insert end "Parent:\t"
5418 $ctext insert end $id [list link link0]
5419 $ctext tag bind link0 <1> [list selbyid $id]
5420 set info $commitinfo($id)
5421 $ctext insert end "\n\t[lindex $info 0]\n"
5422 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5423 set date [formatdate [lindex $info 2]]
5424 $ctext insert end "\tDate:\t$date\n"
5425 set kids $children($curview,$id)
5427 $ctext insert end "\nChildren:"
5429 foreach child $kids {
5431 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5432 set info $commitinfo($child)
5433 $ctext insert end "\n\t"
5434 $ctext insert end $child [list link link$i]
5435 $ctext tag bind link$i <1> [list selbyid $child]
5436 $ctext insert end "\n\t[lindex $info 0]"
5437 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5438 set date [formatdate [lindex $info 2]]
5439 $ctext insert end "\n\tDate:\t$date\n"
5442 $ctext conf -state disabled
5446 proc normalline {} {
5448 if {[info exists thickerline]} {
5456 global commitrow curview
5457 if {[info exists commitrow($curview,$id)]} {
5458 selectline $commitrow($curview,$id) 1
5464 if {![info exists startmstime]} {
5465 set startmstime [clock clicks -milliseconds]
5467 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5470 proc rowmenu {x y id} {
5471 global rowctxmenu commitrow selectedline rowmenuid curview
5472 global nullid fakerowmenu mainhead
5475 if {![info exists selectedline]
5476 || $commitrow($curview,$id) eq $selectedline} {
5481 if {$id ne $nullid} {
5482 set menu $rowctxmenu
5483 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5485 set menu $fakerowmenu
5487 $menu entryconfigure "Diff this*" -state $state
5488 $menu entryconfigure "Diff selected*" -state $state
5489 $menu entryconfigure "Make patch" -state $state
5490 tk_popup $menu $x $y
5493 proc diffvssel {dirn} {
5494 global rowmenuid selectedline displayorder
5496 if {![info exists selectedline]} return
5498 set oldid [lindex $displayorder $selectedline]
5499 set newid $rowmenuid
5501 set oldid $rowmenuid
5502 set newid [lindex $displayorder $selectedline]
5504 addtohistory [list doseldiff $oldid $newid]
5505 doseldiff $oldid $newid
5508 proc doseldiff {oldid newid} {
5512 $ctext conf -state normal
5515 $ctext insert end "From "
5516 $ctext tag conf link -foreground blue -underline 1
5517 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5518 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5519 $ctext tag bind link0 <1> [list selbyid $oldid]
5520 $ctext insert end $oldid [list link link0]
5521 $ctext insert end "\n "
5522 $ctext insert end [lindex $commitinfo($oldid) 0]
5523 $ctext insert end "\n\nTo "
5524 $ctext tag bind link1 <1> [list selbyid $newid]
5525 $ctext insert end $newid [list link link1]
5526 $ctext insert end "\n "
5527 $ctext insert end [lindex $commitinfo($newid) 0]
5528 $ctext insert end "\n"
5529 $ctext conf -state disabled
5530 $ctext tag remove found 1.0 end
5531 startdiff [list $oldid $newid]
5535 global rowmenuid currentid commitinfo patchtop patchnum
5537 if {![info exists currentid]} return
5538 set oldid $currentid
5539 set oldhead [lindex $commitinfo($oldid) 0]
5540 set newid $rowmenuid
5541 set newhead [lindex $commitinfo($newid) 0]
5544 catch {destroy $top}
5546 label $top.title -text "Generate patch"
5547 grid $top.title - -pady 10
5548 label $top.from -text "From:"
5549 entry $top.fromsha1 -width 40 -relief flat
5550 $top.fromsha1 insert 0 $oldid
5551 $top.fromsha1 conf -state readonly
5552 grid $top.from $top.fromsha1 -sticky w
5553 entry $top.fromhead -width 60 -relief flat
5554 $top.fromhead insert 0 $oldhead
5555 $top.fromhead conf -state readonly
5556 grid x $top.fromhead -sticky w
5557 label $top.to -text "To:"
5558 entry $top.tosha1 -width 40 -relief flat
5559 $top.tosha1 insert 0 $newid
5560 $top.tosha1 conf -state readonly
5561 grid $top.to $top.tosha1 -sticky w
5562 entry $top.tohead -width 60 -relief flat
5563 $top.tohead insert 0 $newhead
5564 $top.tohead conf -state readonly
5565 grid x $top.tohead -sticky w
5566 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5567 grid $top.rev x -pady 10
5568 label $top.flab -text "Output file:"
5569 entry $top.fname -width 60
5570 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5572 grid $top.flab $top.fname -sticky w
5574 button $top.buts.gen -text "Generate" -command mkpatchgo
5575 button $top.buts.can -text "Cancel" -command mkpatchcan
5576 grid $top.buts.gen $top.buts.can
5577 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5578 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5579 grid $top.buts - -pady 10 -sticky ew
5583 proc mkpatchrev {} {
5586 set oldid [$patchtop.fromsha1 get]
5587 set oldhead [$patchtop.fromhead get]
5588 set newid [$patchtop.tosha1 get]
5589 set newhead [$patchtop.tohead get]
5590 foreach e [list fromsha1 fromhead tosha1 tohead] \
5591 v [list $newid $newhead $oldid $oldhead] {
5592 $patchtop.$e conf -state normal
5593 $patchtop.$e delete 0 end
5594 $patchtop.$e insert 0 $v
5595 $patchtop.$e conf -state readonly
5600 global patchtop nullid
5602 set oldid [$patchtop.fromsha1 get]
5603 set newid [$patchtop.tosha1 get]
5604 set fname [$patchtop.fname get]
5605 if {$newid eq $nullid} {
5606 set cmd [list git diff-index -p $oldid]
5607 } elseif {$oldid eq $nullid} {
5608 set cmd [list git diff-index -p -R $newid]
5610 set cmd [list git diff-tree -p $oldid $newid]
5612 lappend cmd >$fname &
5613 if {[catch {eval exec $cmd} err]} {
5614 error_popup "Error creating patch: $err"
5616 catch {destroy $patchtop}
5620 proc mkpatchcan {} {
5623 catch {destroy $patchtop}
5628 global rowmenuid mktagtop commitinfo
5632 catch {destroy $top}
5634 label $top.title -text "Create tag"
5635 grid $top.title - -pady 10
5636 label $top.id -text "ID:"
5637 entry $top.sha1 -width 40 -relief flat
5638 $top.sha1 insert 0 $rowmenuid
5639 $top.sha1 conf -state readonly
5640 grid $top.id $top.sha1 -sticky w
5641 entry $top.head -width 60 -relief flat
5642 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5643 $top.head conf -state readonly
5644 grid x $top.head -sticky w
5645 label $top.tlab -text "Tag name:"
5646 entry $top.tag -width 60
5647 grid $top.tlab $top.tag -sticky w
5649 button $top.buts.gen -text "Create" -command mktaggo
5650 button $top.buts.can -text "Cancel" -command mktagcan
5651 grid $top.buts.gen $top.buts.can
5652 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5653 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5654 grid $top.buts - -pady 10 -sticky ew
5659 global mktagtop env tagids idtags
5661 set id [$mktagtop.sha1 get]
5662 set tag [$mktagtop.tag get]
5664 error_popup "No tag name specified"
5667 if {[info exists tagids($tag)]} {
5668 error_popup "Tag \"$tag\" already exists"
5673 set fname [file join $dir "refs/tags" $tag]
5674 set f [open $fname w]
5678 error_popup "Error creating tag: $err"
5682 set tagids($tag) $id
5683 lappend idtags($id) $tag
5688 proc redrawtags {id} {
5689 global canv linehtag commitrow idpos selectedline curview
5690 global mainfont canvxmax iddrawn
5692 if {![info exists commitrow($curview,$id)]} return
5693 if {![info exists iddrawn($id)]} return
5694 drawcommits $commitrow($curview,$id)
5695 $canv delete tag.$id
5696 set xt [eval drawtags $id $idpos($id)]
5697 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5698 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5699 set xr [expr {$xt + [font measure $mainfont $text]}]
5700 if {$xr > $canvxmax} {
5704 if {[info exists selectedline]
5705 && $selectedline == $commitrow($curview,$id)} {
5706 selectline $selectedline 0
5713 catch {destroy $mktagtop}
5722 proc writecommit {} {
5723 global rowmenuid wrcomtop commitinfo wrcomcmd
5725 set top .writecommit
5727 catch {destroy $top}
5729 label $top.title -text "Write commit to file"
5730 grid $top.title - -pady 10
5731 label $top.id -text "ID:"
5732 entry $top.sha1 -width 40 -relief flat
5733 $top.sha1 insert 0 $rowmenuid
5734 $top.sha1 conf -state readonly
5735 grid $top.id $top.sha1 -sticky w
5736 entry $top.head -width 60 -relief flat
5737 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5738 $top.head conf -state readonly
5739 grid x $top.head -sticky w
5740 label $top.clab -text "Command:"
5741 entry $top.cmd -width 60 -textvariable wrcomcmd
5742 grid $top.clab $top.cmd -sticky w -pady 10
5743 label $top.flab -text "Output file:"
5744 entry $top.fname -width 60
5745 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5746 grid $top.flab $top.fname -sticky w
5748 button $top.buts.gen -text "Write" -command wrcomgo
5749 button $top.buts.can -text "Cancel" -command wrcomcan
5750 grid $top.buts.gen $top.buts.can
5751 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5752 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5753 grid $top.buts - -pady 10 -sticky ew
5760 set id [$wrcomtop.sha1 get]
5761 set cmd "echo $id | [$wrcomtop.cmd get]"
5762 set fname [$wrcomtop.fname get]
5763 if {[catch {exec sh -c $cmd >$fname &} err]} {
5764 error_popup "Error writing commit: $err"
5766 catch {destroy $wrcomtop}
5773 catch {destroy $wrcomtop}
5778 global rowmenuid mkbrtop
5781 catch {destroy $top}
5783 label $top.title -text "Create new branch"
5784 grid $top.title - -pady 10
5785 label $top.id -text "ID:"
5786 entry $top.sha1 -width 40 -relief flat
5787 $top.sha1 insert 0 $rowmenuid
5788 $top.sha1 conf -state readonly
5789 grid $top.id $top.sha1 -sticky w
5790 label $top.nlab -text "Name:"
5791 entry $top.name -width 40
5792 grid $top.nlab $top.name -sticky w
5794 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5795 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5796 grid $top.buts.go $top.buts.can
5797 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5798 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5799 grid $top.buts - -pady 10 -sticky ew
5804 global headids idheads
5806 set name [$top.name get]
5807 set id [$top.sha1 get]
5809 error_popup "Please specify a name for the new branch"
5812 catch {destroy $top}
5816 exec git branch $name $id
5821 set headids($name) $id
5822 lappend idheads($id) $name
5830 proc cherrypick {} {
5831 global rowmenuid curview commitrow
5834 set oldhead [exec git rev-parse HEAD]
5835 set dheads [descheads $rowmenuid]
5836 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5837 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5838 included in branch $mainhead -- really re-apply it?"]
5843 # Unfortunately git-cherry-pick writes stuff to stderr even when
5844 # no error occurs, and exec takes that as an indication of error...
5845 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5850 set newhead [exec git rev-parse HEAD]
5851 if {$newhead eq $oldhead} {
5853 error_popup "No changes committed"
5856 addnewchild $newhead $oldhead
5857 if {[info exists commitrow($curview,$oldhead)]} {
5858 insertrow $commitrow($curview,$oldhead) $newhead
5859 if {$mainhead ne {}} {
5860 movehead $newhead $mainhead
5861 movedhead $newhead $mainhead
5870 global mainheadid mainhead rowmenuid confirm_ok resettype
5871 global showlocalchanges
5874 set w ".confirmreset"
5877 wm title $w "Confirm reset"
5878 message $w.m -text \
5879 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5880 -justify center -aspect 1000
5881 pack $w.m -side top -fill x -padx 20 -pady 20
5882 frame $w.f -relief sunken -border 2
5883 message $w.f.rt -text "Reset type:" -aspect 1000
5884 grid $w.f.rt -sticky w
5886 radiobutton $w.f.soft -value soft -variable resettype -justify left \
5887 -text "Soft: Leave working tree and index untouched"
5888 grid $w.f.soft -sticky w
5889 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5890 -text "Mixed: Leave working tree untouched, reset index"
5891 grid $w.f.mixed -sticky w
5892 radiobutton $w.f.hard -value hard -variable resettype -justify left \
5893 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5894 grid $w.f.hard -sticky w
5895 pack $w.f -side top -fill x
5896 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5897 pack $w.ok -side left -fill x -padx 20 -pady 20
5898 button $w.cancel -text Cancel -command "destroy $w"
5899 pack $w.cancel -side right -fill x -padx 20 -pady 20
5900 bind $w <Visibility> "grab $w; focus $w"
5902 if {!$confirm_ok} return
5903 if {[catch {set fd [open \
5904 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
5908 set w ".resetprogress"
5909 filerun $fd [list readresetstat $fd $w]
5912 wm title $w "Reset progress"
5913 message $w.m -text "Reset in progress, please wait..." \
5914 -justify center -aspect 1000
5915 pack $w.m -side top -fill x -padx 20 -pady 5
5916 canvas $w.c -width 150 -height 20 -bg white
5917 $w.c create rect 0 0 0 20 -fill green -tags rect
5918 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
5923 proc readresetstat {fd w} {
5924 global mainhead mainheadid showlocalchanges
5926 if {[gets $fd line] >= 0} {
5927 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
5928 set x [expr {($m * 150) / $n}]
5929 $w.c coords rect 0 0 $x 20
5935 if {[catch {close $fd} err]} {
5938 set oldhead $mainheadid
5939 set newhead [exec git rev-parse HEAD]
5940 if {$newhead ne $oldhead} {
5941 movehead $newhead $mainhead
5942 movedhead $newhead $mainhead
5943 set mainheadid $newhead
5947 if {$showlocalchanges} {
5953 # context menu for a head
5954 proc headmenu {x y id head} {
5955 global headmenuid headmenuhead headctxmenu mainhead
5958 set headmenuhead $head
5960 if {$head eq $mainhead} {
5963 $headctxmenu entryconfigure 0 -state $state
5964 $headctxmenu entryconfigure 1 -state $state
5965 tk_popup $headctxmenu $x $y
5969 global headmenuid headmenuhead mainhead headids
5970 global showlocalchanges mainheadid
5972 # check the tree is clean first??
5973 set oldmainhead $mainhead
5978 exec git checkout -q $headmenuhead
5984 set mainhead $headmenuhead
5985 set mainheadid $headmenuid
5986 if {[info exists headids($oldmainhead)]} {
5987 redrawtags $headids($oldmainhead)
5989 redrawtags $headmenuid
5991 if {$showlocalchanges} {
5997 global headmenuid headmenuhead mainhead
5998 global headids idheads
6000 set head $headmenuhead
6002 # this check shouldn't be needed any more...
6003 if {$head eq $mainhead} {
6004 error_popup "Cannot delete the currently checked-out branch"
6007 set dheads [descheads $id]
6008 if {$dheads eq $headids($head)} {
6009 # the stuff on this branch isn't on any other branch
6010 if {![confirm_popup "The commits on branch $head aren't on any other\
6011 branch.\nReally delete branch $head?"]} return
6015 if {[catch {exec git branch -D $head} err]} {
6020 removehead $id $head
6021 removedhead $id $head
6027 # Stuff for finding nearby tags
6028 proc getallcommits {} {
6029 global allcommits allids nbmp nextarc seeds
6039 # Called when the graph might have changed
6040 proc regetallcommits {} {
6041 global allcommits seeds
6043 set cmd [concat | git rev-list --all --parents]
6047 set fd [open $cmd r]
6048 fconfigure $fd -blocking 0
6051 filerun $fd [list getallclines $fd]
6054 # Since most commits have 1 parent and 1 child, we group strings of
6055 # such commits into "arcs" joining branch/merge points (BMPs), which
6056 # are commits that either don't have 1 parent or don't have 1 child.
6058 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6059 # arcout(id) - outgoing arcs for BMP
6060 # arcids(a) - list of IDs on arc including end but not start
6061 # arcstart(a) - BMP ID at start of arc
6062 # arcend(a) - BMP ID at end of arc
6063 # growing(a) - arc a is still growing
6064 # arctags(a) - IDs out of arcids (excluding end) that have tags
6065 # archeads(a) - IDs out of arcids (excluding end) that have heads
6066 # The start of an arc is at the descendent end, so "incoming" means
6067 # coming from descendents, and "outgoing" means going towards ancestors.
6069 proc getallclines {fd} {
6070 global allids allparents allchildren idtags idheads nextarc nbmp
6071 global arcnos arcids arctags arcout arcend arcstart archeads growing
6072 global seeds allcommits
6075 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6076 set id [lindex $line 0]
6077 if {[info exists allparents($id)]} {
6082 set olds [lrange $line 1 end]
6083 set allparents($id) $olds
6084 if {![info exists allchildren($id)]} {
6085 set allchildren($id) {}
6090 if {[llength $olds] == 1 && [llength $a] == 1} {
6091 lappend arcids($a) $id
6092 if {[info exists idtags($id)]} {
6093 lappend arctags($a) $id
6095 if {[info exists idheads($id)]} {
6096 lappend archeads($a) $id
6098 if {[info exists allparents($olds)]} {
6099 # seen parent already
6100 if {![info exists arcout($olds)]} {
6103 lappend arcids($a) $olds
6104 set arcend($a) $olds
6107 lappend allchildren($olds) $id
6108 lappend arcnos($olds) $a
6113 foreach a $arcnos($id) {
6114 lappend arcids($a) $id
6121 lappend allchildren($p) $id
6122 set a [incr nextarc]
6123 set arcstart($a) $id
6130 if {[info exists allparents($p)]} {
6131 # seen it already, may need to make a new branch
6132 if {![info exists arcout($p)]} {
6135 lappend arcids($a) $p
6139 lappend arcnos($p) $a
6144 global cached_dheads cached_dtags cached_atags
6145 catch {unset cached_dheads}
6146 catch {unset cached_dtags}
6147 catch {unset cached_atags}
6150 return [expr {$nid >= 1000? 2: 1}]
6153 if {[incr allcommits -1] == 0} {
6160 proc recalcarc {a} {
6161 global arctags archeads arcids idtags idheads
6165 foreach id [lrange $arcids($a) 0 end-1] {
6166 if {[info exists idtags($id)]} {
6169 if {[info exists idheads($id)]} {
6174 set archeads($a) $ah
6178 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6179 global arcstart arcend arcout allparents growing
6182 if {[llength $a] != 1} {
6183 puts "oops splitarc called but [llength $a] arcs already"
6187 set i [lsearch -exact $arcids($a) $p]
6189 puts "oops splitarc $p not in arc $a"
6192 set na [incr nextarc]
6193 if {[info exists arcend($a)]} {
6194 set arcend($na) $arcend($a)
6196 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6197 set j [lsearch -exact $arcnos($l) $a]
6198 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6200 set tail [lrange $arcids($a) [expr {$i+1}] end]
6201 set arcids($a) [lrange $arcids($a) 0 $i]
6203 set arcstart($na) $p
6205 set arcids($na) $tail
6206 if {[info exists growing($a)]} {
6213 if {[llength $arcnos($id)] == 1} {
6216 set j [lsearch -exact $arcnos($id) $a]
6217 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6221 # reconstruct tags and heads lists
6222 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6227 set archeads($na) {}
6231 # Update things for a new commit added that is a child of one
6232 # existing commit. Used when cherry-picking.
6233 proc addnewchild {id p} {
6234 global allids allparents allchildren idtags nextarc nbmp
6235 global arcnos arcids arctags arcout arcend arcstart archeads growing
6239 set allparents($id) [list $p]
6240 set allchildren($id) {}
6244 lappend allchildren($p) $id
6245 set a [incr nextarc]
6246 set arcstart($a) $id
6249 set arcids($a) [list $p]
6251 if {![info exists arcout($p)]} {
6254 lappend arcnos($p) $a
6255 set arcout($id) [list $a]
6258 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6259 # or 0 if neither is true.
6260 proc anc_or_desc {a b} {
6261 global arcout arcstart arcend arcnos cached_isanc
6263 if {$arcnos($a) eq $arcnos($b)} {
6264 # Both are on the same arc(s); either both are the same BMP,
6265 # or if one is not a BMP, the other is also not a BMP or is
6266 # the BMP at end of the arc (and it only has 1 incoming arc).
6267 # Or both can be BMPs with no incoming arcs.
6268 if {$a eq $b || $arcnos($a) eq {}} {
6271 # assert {[llength $arcnos($a)] == 1}
6272 set arc [lindex $arcnos($a) 0]
6273 set i [lsearch -exact $arcids($arc) $a]
6274 set j [lsearch -exact $arcids($arc) $b]
6275 if {$i < 0 || $i > $j} {
6282 if {![info exists arcout($a)]} {
6283 set arc [lindex $arcnos($a) 0]
6284 if {[info exists arcend($arc)]} {
6285 set aend $arcend($arc)
6289 set a $arcstart($arc)
6293 if {![info exists arcout($b)]} {
6294 set arc [lindex $arcnos($b) 0]
6295 if {[info exists arcend($arc)]} {
6296 set bend $arcend($arc)
6300 set b $arcstart($arc)
6310 if {[info exists cached_isanc($a,$bend)]} {
6311 if {$cached_isanc($a,$bend)} {
6315 if {[info exists cached_isanc($b,$aend)]} {
6316 if {$cached_isanc($b,$aend)} {
6319 if {[info exists cached_isanc($a,$bend)]} {
6324 set todo [list $a $b]
6327 for {set i 0} {$i < [llength $todo]} {incr i} {
6328 set x [lindex $todo $i]
6329 if {$anc($x) eq {}} {
6332 foreach arc $arcnos($x) {
6333 set xd $arcstart($arc)
6335 set cached_isanc($a,$bend) 1
6336 set cached_isanc($b,$aend) 0
6338 } elseif {$xd eq $aend} {
6339 set cached_isanc($b,$aend) 1
6340 set cached_isanc($a,$bend) 0
6343 if {![info exists anc($xd)]} {
6344 set anc($xd) $anc($x)
6346 } elseif {$anc($xd) ne $anc($x)} {
6351 set cached_isanc($a,$bend) 0
6352 set cached_isanc($b,$aend) 0
6356 # This identifies whether $desc has an ancestor that is
6357 # a growing tip of the graph and which is not an ancestor of $anc
6358 # and returns 0 if so and 1 if not.
6359 # If we subsequently discover a tag on such a growing tip, and that
6360 # turns out to be a descendent of $anc (which it could, since we
6361 # don't necessarily see children before parents), then $desc
6362 # isn't a good choice to display as a descendent tag of
6363 # $anc (since it is the descendent of another tag which is
6364 # a descendent of $anc). Similarly, $anc isn't a good choice to
6365 # display as a ancestor tag of $desc.
6367 proc is_certain {desc anc} {
6368 global arcnos arcout arcstart arcend growing problems
6371 if {[llength $arcnos($anc)] == 1} {
6372 # tags on the same arc are certain
6373 if {$arcnos($desc) eq $arcnos($anc)} {
6376 if {![info exists arcout($anc)]} {
6377 # if $anc is partway along an arc, use the start of the arc instead
6378 set a [lindex $arcnos($anc) 0]
6379 set anc $arcstart($a)
6382 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6385 set a [lindex $arcnos($desc) 0]
6391 set anclist [list $x]
6395 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6396 set x [lindex $anclist $i]
6401 foreach a $arcout($x) {
6402 if {[info exists growing($a)]} {
6403 if {![info exists growanc($x)] && $dl($x)} {
6409 if {[info exists dl($y)]} {
6413 if {![info exists done($y)]} {
6416 if {[info exists growanc($x)]} {
6420 for {set k 0} {$k < [llength $xl]} {incr k} {
6421 set z [lindex $xl $k]
6422 foreach c $arcout($z) {
6423 if {[info exists arcend($c)]} {
6425 if {[info exists dl($v)] && $dl($v)} {
6427 if {![info exists done($v)]} {
6430 if {[info exists growanc($v)]} {
6440 } elseif {$y eq $anc || !$dl($x)} {
6451 foreach x [array names growanc] {
6460 proc validate_arctags {a} {
6461 global arctags idtags
6465 foreach id $arctags($a) {
6467 if {![info exists idtags($id)]} {
6468 set na [lreplace $na $i $i]
6475 proc validate_archeads {a} {
6476 global archeads idheads
6479 set na $archeads($a)
6480 foreach id $archeads($a) {
6482 if {![info exists idheads($id)]} {
6483 set na [lreplace $na $i $i]
6487 set archeads($a) $na
6490 # Return the list of IDs that have tags that are descendents of id,
6491 # ignoring IDs that are descendents of IDs already reported.
6492 proc desctags {id} {
6493 global arcnos arcstart arcids arctags idtags allparents
6494 global growing cached_dtags
6496 if {![info exists allparents($id)]} {
6499 set t1 [clock clicks -milliseconds]
6501 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6502 # part-way along an arc; check that arc first
6503 set a [lindex $arcnos($id) 0]
6504 if {$arctags($a) ne {}} {
6506 set i [lsearch -exact $arcids($a) $id]
6508 foreach t $arctags($a) {
6509 set j [lsearch -exact $arcids($a) $t]
6517 set id $arcstart($a)
6518 if {[info exists idtags($id)]} {
6522 if {[info exists cached_dtags($id)]} {
6523 return $cached_dtags($id)
6530 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6531 set id [lindex $todo $i]
6533 set ta [info exists hastaggedancestor($id)]
6537 # ignore tags on starting node
6538 if {!$ta && $i > 0} {
6539 if {[info exists idtags($id)]} {
6542 } elseif {[info exists cached_dtags($id)]} {
6543 set tagloc($id) $cached_dtags($id)
6547 foreach a $arcnos($id) {
6549 if {!$ta && $arctags($a) ne {}} {
6551 if {$arctags($a) ne {}} {
6552 lappend tagloc($id) [lindex $arctags($a) end]
6555 if {$ta || $arctags($a) ne {}} {
6556 set tomark [list $d]
6557 for {set j 0} {$j < [llength $tomark]} {incr j} {
6558 set dd [lindex $tomark $j]
6559 if {![info exists hastaggedancestor($dd)]} {
6560 if {[info exists done($dd)]} {
6561 foreach b $arcnos($dd) {
6562 lappend tomark $arcstart($b)
6564 if {[info exists tagloc($dd)]} {
6567 } elseif {[info exists queued($dd)]} {
6570 set hastaggedancestor($dd) 1
6574 if {![info exists queued($d)]} {
6577 if {![info exists hastaggedancestor($d)]} {
6584 foreach id [array names tagloc] {
6585 if {![info exists hastaggedancestor($id)]} {
6586 foreach t $tagloc($id) {
6587 if {[lsearch -exact $tags $t] < 0} {
6593 set t2 [clock clicks -milliseconds]
6596 # remove tags that are descendents of other tags
6597 for {set i 0} {$i < [llength $tags]} {incr i} {
6598 set a [lindex $tags $i]
6599 for {set j 0} {$j < $i} {incr j} {
6600 set b [lindex $tags $j]
6601 set r [anc_or_desc $a $b]
6603 set tags [lreplace $tags $j $j]
6606 } elseif {$r == -1} {
6607 set tags [lreplace $tags $i $i]
6614 if {[array names growing] ne {}} {
6615 # graph isn't finished, need to check if any tag could get
6616 # eclipsed by another tag coming later. Simply ignore any
6617 # tags that could later get eclipsed.
6620 if {[is_certain $t $origid]} {
6624 if {$tags eq $ctags} {
6625 set cached_dtags($origid) $tags
6630 set cached_dtags($origid) $tags
6632 set t3 [clock clicks -milliseconds]
6633 if {0 && $t3 - $t1 >= 100} {
6634 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6635 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6641 global arcnos arcids arcout arcend arctags idtags allparents
6642 global growing cached_atags
6644 if {![info exists allparents($id)]} {
6647 set t1 [clock clicks -milliseconds]
6649 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6650 # part-way along an arc; check that arc first
6651 set a [lindex $arcnos($id) 0]
6652 if {$arctags($a) ne {}} {
6654 set i [lsearch -exact $arcids($a) $id]
6655 foreach t $arctags($a) {
6656 set j [lsearch -exact $arcids($a) $t]
6662 if {![info exists arcend($a)]} {
6666 if {[info exists idtags($id)]} {
6670 if {[info exists cached_atags($id)]} {
6671 return $cached_atags($id)
6679 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6680 set id [lindex $todo $i]
6682 set td [info exists hastaggeddescendent($id)]
6686 # ignore tags on starting node
6687 if {!$td && $i > 0} {
6688 if {[info exists idtags($id)]} {
6691 } elseif {[info exists cached_atags($id)]} {
6692 set tagloc($id) $cached_atags($id)
6696 foreach a $arcout($id) {
6697 if {!$td && $arctags($a) ne {}} {
6699 if {$arctags($a) ne {}} {
6700 lappend tagloc($id) [lindex $arctags($a) 0]
6703 if {![info exists arcend($a)]} continue
6705 if {$td || $arctags($a) ne {}} {
6706 set tomark [list $d]
6707 for {set j 0} {$j < [llength $tomark]} {incr j} {
6708 set dd [lindex $tomark $j]
6709 if {![info exists hastaggeddescendent($dd)]} {
6710 if {[info exists done($dd)]} {
6711 foreach b $arcout($dd) {
6712 if {[info exists arcend($b)]} {
6713 lappend tomark $arcend($b)
6716 if {[info exists tagloc($dd)]} {
6719 } elseif {[info exists queued($dd)]} {
6722 set hastaggeddescendent($dd) 1
6726 if {![info exists queued($d)]} {
6729 if {![info exists hastaggeddescendent($d)]} {
6735 set t2 [clock clicks -milliseconds]
6738 foreach id [array names tagloc] {
6739 if {![info exists hastaggeddescendent($id)]} {
6740 foreach t $tagloc($id) {
6741 if {[lsearch -exact $tags $t] < 0} {
6748 # remove tags that are ancestors of other tags
6749 for {set i 0} {$i < [llength $tags]} {incr i} {
6750 set a [lindex $tags $i]
6751 for {set j 0} {$j < $i} {incr j} {
6752 set b [lindex $tags $j]
6753 set r [anc_or_desc $a $b]
6755 set tags [lreplace $tags $j $j]
6758 } elseif {$r == 1} {
6759 set tags [lreplace $tags $i $i]
6766 if {[array names growing] ne {}} {
6767 # graph isn't finished, need to check if any tag could get
6768 # eclipsed by another tag coming later. Simply ignore any
6769 # tags that could later get eclipsed.
6772 if {[is_certain $origid $t]} {
6776 if {$tags eq $ctags} {
6777 set cached_atags($origid) $tags
6782 set cached_atags($origid) $tags
6784 set t3 [clock clicks -milliseconds]
6785 if {0 && $t3 - $t1 >= 100} {
6786 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6787 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6792 # Return the list of IDs that have heads that are descendents of id,
6793 # including id itself if it has a head.
6794 proc descheads {id} {
6795 global arcnos arcstart arcids archeads idheads cached_dheads
6798 if {![info exists allparents($id)]} {
6802 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6803 # part-way along an arc; check it first
6804 set a [lindex $arcnos($id) 0]
6805 if {$archeads($a) ne {}} {
6806 validate_archeads $a
6807 set i [lsearch -exact $arcids($a) $id]
6808 foreach t $archeads($a) {
6809 set j [lsearch -exact $arcids($a) $t]
6814 set id $arcstart($a)
6820 for {set i 0} {$i < [llength $todo]} {incr i} {
6821 set id [lindex $todo $i]
6822 if {[info exists cached_dheads($id)]} {
6823 set ret [concat $ret $cached_dheads($id)]
6825 if {[info exists idheads($id)]} {
6828 foreach a $arcnos($id) {
6829 if {$archeads($a) ne {}} {
6830 validate_archeads $a
6831 if {$archeads($a) ne {}} {
6832 set ret [concat $ret $archeads($a)]
6836 if {![info exists seen($d)]} {
6843 set ret [lsort -unique $ret]
6844 set cached_dheads($origid) $ret
6845 return [concat $ret $aret]
6848 proc addedtag {id} {
6849 global arcnos arcout cached_dtags cached_atags
6851 if {![info exists arcnos($id)]} return
6852 if {![info exists arcout($id)]} {
6853 recalcarc [lindex $arcnos($id) 0]
6855 catch {unset cached_dtags}
6856 catch {unset cached_atags}
6859 proc addedhead {hid head} {
6860 global arcnos arcout cached_dheads
6862 if {![info exists arcnos($hid)]} return
6863 if {![info exists arcout($hid)]} {
6864 recalcarc [lindex $arcnos($hid) 0]
6866 catch {unset cached_dheads}
6869 proc removedhead {hid head} {
6870 global cached_dheads
6872 catch {unset cached_dheads}
6875 proc movedhead {hid head} {
6876 global arcnos arcout cached_dheads
6878 if {![info exists arcnos($hid)]} return
6879 if {![info exists arcout($hid)]} {
6880 recalcarc [lindex $arcnos($hid) 0]
6882 catch {unset cached_dheads}
6885 proc changedrefs {} {
6886 global cached_dheads cached_dtags cached_atags
6887 global arctags archeads arcnos arcout idheads idtags
6889 foreach id [concat [array names idheads] [array names idtags]] {
6890 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6891 set a [lindex $arcnos($id) 0]
6892 if {![info exists donearc($a)]} {
6898 catch {unset cached_dtags}
6899 catch {unset cached_atags}
6900 catch {unset cached_dheads}
6903 proc rereadrefs {} {
6904 global idtags idheads idotherrefs mainhead
6906 set refids [concat [array names idtags] \
6907 [array names idheads] [array names idotherrefs]]
6908 foreach id $refids {
6909 if {![info exists ref($id)]} {
6910 set ref($id) [listrefs $id]
6913 set oldmainhead $mainhead
6916 set refids [lsort -unique [concat $refids [array names idtags] \
6917 [array names idheads] [array names idotherrefs]]]
6918 foreach id $refids {
6919 set v [listrefs $id]
6920 if {![info exists ref($id)] || $ref($id) != $v ||
6921 ($id eq $oldmainhead && $id ne $mainhead) ||
6922 ($id eq $mainhead && $id ne $oldmainhead)} {
6928 proc listrefs {id} {
6929 global idtags idheads idotherrefs
6932 if {[info exists idtags($id)]} {
6936 if {[info exists idheads($id)]} {
6940 if {[info exists idotherrefs($id)]} {
6941 set z $idotherrefs($id)
6943 return [list $x $y $z]
6946 proc showtag {tag isnew} {
6947 global ctext tagcontents tagids linknum tagobjid
6950 addtohistory [list showtag $tag 0]
6952 $ctext conf -state normal
6955 if {![info exists tagcontents($tag)]} {
6957 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6960 if {[info exists tagcontents($tag)]} {
6961 set text $tagcontents($tag)
6963 set text "Tag: $tag\nId: $tagids($tag)"
6965 appendwithlinks $text {}
6966 $ctext conf -state disabled
6978 global maxwidth maxgraphpct diffopts
6979 global oldprefs prefstop showneartags showlocalchanges
6980 global bgcolor fgcolor ctext diffcolors selectbgcolor
6981 global uifont tabstop
6985 if {[winfo exists $top]} {
6989 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6990 set oldprefs($v) [set $v]
6993 wm title $top "Gitk preferences"
6994 label $top.ldisp -text "Commit list display options"
6995 $top.ldisp configure -font $uifont
6996 grid $top.ldisp - -sticky w -pady 10
6997 label $top.spacer -text " "
6998 label $top.maxwidthl -text "Maximum graph width (lines)" \
7000 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7001 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7002 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7004 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7005 grid x $top.maxpctl $top.maxpct -sticky w
7006 frame $top.showlocal
7007 label $top.showlocal.l -text "Show local changes" -font optionfont
7008 checkbutton $top.showlocal.b -variable showlocalchanges
7009 pack $top.showlocal.b $top.showlocal.l -side left
7010 grid x $top.showlocal -sticky w
7012 label $top.ddisp -text "Diff display options"
7013 $top.ddisp configure -font $uifont
7014 grid $top.ddisp - -sticky w -pady 10
7015 label $top.diffoptl -text "Options for diff program" \
7017 entry $top.diffopt -width 20 -textvariable diffopts
7018 grid x $top.diffoptl $top.diffopt -sticky w
7020 label $top.ntag.l -text "Display nearby tags" -font optionfont
7021 checkbutton $top.ntag.b -variable showneartags
7022 pack $top.ntag.b $top.ntag.l -side left
7023 grid x $top.ntag -sticky w
7024 label $top.tabstopl -text "tabstop" -font optionfont
7025 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7026 grid x $top.tabstopl $top.tabstop -sticky w
7028 label $top.cdisp -text "Colors: press to choose"
7029 $top.cdisp configure -font $uifont
7030 grid $top.cdisp - -sticky w -pady 10
7031 label $top.bg -padx 40 -relief sunk -background $bgcolor
7032 button $top.bgbut -text "Background" -font optionfont \
7033 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7034 grid x $top.bgbut $top.bg -sticky w
7035 label $top.fg -padx 40 -relief sunk -background $fgcolor
7036 button $top.fgbut -text "Foreground" -font optionfont \
7037 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7038 grid x $top.fgbut $top.fg -sticky w
7039 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7040 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7041 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7042 [list $ctext tag conf d0 -foreground]]
7043 grid x $top.diffoldbut $top.diffold -sticky w
7044 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7045 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7046 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7047 [list $ctext tag conf d1 -foreground]]
7048 grid x $top.diffnewbut $top.diffnew -sticky w
7049 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7050 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7051 -command [list choosecolor diffcolors 2 $top.hunksep \
7052 "diff hunk header" \
7053 [list $ctext tag conf hunksep -foreground]]
7054 grid x $top.hunksepbut $top.hunksep -sticky w
7055 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7056 button $top.selbgbut -text "Select bg" -font optionfont \
7057 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7058 grid x $top.selbgbut $top.selbgsep -sticky w
7061 button $top.buts.ok -text "OK" -command prefsok -default active
7062 $top.buts.ok configure -font $uifont
7063 button $top.buts.can -text "Cancel" -command prefscan -default normal
7064 $top.buts.can configure -font $uifont
7065 grid $top.buts.ok $top.buts.can
7066 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7067 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7068 grid $top.buts - - -pady 10 -sticky ew
7069 bind $top <Visibility> "focus $top.buts.ok"
7072 proc choosecolor {v vi w x cmd} {
7075 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7076 -title "Gitk: choose color for $x"]
7077 if {$c eq {}} return
7078 $w conf -background $c
7084 global bglist cflist
7086 $w configure -selectbackground $c
7088 $cflist tag configure highlight \
7089 -background [$cflist cget -selectbackground]
7090 allcanvs itemconf secsel -fill $c
7097 $w conf -background $c
7105 $w conf -foreground $c
7107 allcanvs itemconf text -fill $c
7108 $canv itemconf circle -outline $c
7112 global maxwidth maxgraphpct diffopts
7113 global oldprefs prefstop showneartags showlocalchanges
7115 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7116 set $v $oldprefs($v)
7118 catch {destroy $prefstop}
7123 global maxwidth maxgraphpct
7124 global oldprefs prefstop showneartags showlocalchanges
7125 global charspc ctext tabstop
7127 catch {destroy $prefstop}
7129 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7130 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7131 if {$showlocalchanges} {
7137 if {$maxwidth != $oldprefs(maxwidth)
7138 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7140 } elseif {$showneartags != $oldprefs(showneartags)} {
7145 proc formatdate {d} {
7147 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7152 # This list of encoding names and aliases is distilled from
7153 # http://www.iana.org/assignments/character-sets.
7154 # Not all of them are supported by Tcl.
7155 set encoding_aliases {
7156 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7157 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7158 { ISO-10646-UTF-1 csISO10646UTF1 }
7159 { ISO_646.basic:1983 ref csISO646basic1983 }
7160 { INVARIANT csINVARIANT }
7161 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7162 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7163 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7164 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7165 { NATS-DANO iso-ir-9-1 csNATSDANO }
7166 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7167 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7168 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7169 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7170 { ISO-2022-KR csISO2022KR }
7172 { ISO-2022-JP csISO2022JP }
7173 { ISO-2022-JP-2 csISO2022JP2 }
7174 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7176 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7177 { IT iso-ir-15 ISO646-IT csISO15Italian }
7178 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7179 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7180 { greek7-old iso-ir-18 csISO18Greek7Old }
7181 { latin-greek iso-ir-19 csISO19LatinGreek }
7182 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7183 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7184 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7185 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7186 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7187 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7188 { INIS iso-ir-49 csISO49INIS }
7189 { INIS-8 iso-ir-50 csISO50INIS8 }
7190 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7191 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7192 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7193 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7194 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7195 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7197 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7198 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7199 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7200 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7201 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7202 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7203 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7204 { greek7 iso-ir-88 csISO88Greek7 }
7205 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7206 { iso-ir-90 csISO90 }
7207 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7208 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7209 csISO92JISC62991984b }
7210 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7211 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7212 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7213 csISO95JIS62291984handadd }
7214 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7215 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7216 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7217 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7219 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7220 { T.61-7bit iso-ir-102 csISO102T617bit }
7221 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7222 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7223 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7224 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7225 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7226 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7227 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7228 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7229 arabic csISOLatinArabic }
7230 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7231 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7232 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7233 greek greek8 csISOLatinGreek }
7234 { T.101-G2 iso-ir-128 csISO128T101G2 }
7235 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7237 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7238 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7239 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7240 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7241 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7242 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7243 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7244 csISOLatinCyrillic }
7245 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7246 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7247 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7248 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7249 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7250 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7251 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7252 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7253 { ISO_10367-box iso-ir-155 csISO10367Box }
7254 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7255 { latin-lap lap iso-ir-158 csISO158Lap }
7256 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7257 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7260 { JIS_X0201 X0201 csHalfWidthKatakana }
7261 { KSC5636 ISO646-KR csKSC5636 }
7262 { ISO-10646-UCS-2 csUnicode }
7263 { ISO-10646-UCS-4 csUCS4 }
7264 { DEC-MCS dec csDECMCS }
7265 { hp-roman8 roman8 r8 csHPRoman8 }
7266 { macintosh mac csMacintosh }
7267 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7269 { IBM038 EBCDIC-INT cp038 csIBM038 }
7270 { IBM273 CP273 csIBM273 }
7271 { IBM274 EBCDIC-BE CP274 csIBM274 }
7272 { IBM275 EBCDIC-BR cp275 csIBM275 }
7273 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7274 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7275 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7276 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7277 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7278 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7279 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7280 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7281 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7282 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7283 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7284 { IBM437 cp437 437 csPC8CodePage437 }
7285 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7286 { IBM775 cp775 csPC775Baltic }
7287 { IBM850 cp850 850 csPC850Multilingual }
7288 { IBM851 cp851 851 csIBM851 }
7289 { IBM852 cp852 852 csPCp852 }
7290 { IBM855 cp855 855 csIBM855 }
7291 { IBM857 cp857 857 csIBM857 }
7292 { IBM860 cp860 860 csIBM860 }
7293 { IBM861 cp861 861 cp-is csIBM861 }
7294 { IBM862 cp862 862 csPC862LatinHebrew }
7295 { IBM863 cp863 863 csIBM863 }
7296 { IBM864 cp864 csIBM864 }
7297 { IBM865 cp865 865 csIBM865 }
7298 { IBM866 cp866 866 csIBM866 }
7299 { IBM868 CP868 cp-ar csIBM868 }
7300 { IBM869 cp869 869 cp-gr csIBM869 }
7301 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7302 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7303 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7304 { IBM891 cp891 csIBM891 }
7305 { IBM903 cp903 csIBM903 }
7306 { IBM904 cp904 904 csIBBM904 }
7307 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7308 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7309 { IBM1026 CP1026 csIBM1026 }
7310 { EBCDIC-AT-DE csIBMEBCDICATDE }
7311 { EBCDIC-AT-DE-A csEBCDICATDEA }
7312 { EBCDIC-CA-FR csEBCDICCAFR }
7313 { EBCDIC-DK-NO csEBCDICDKNO }
7314 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7315 { EBCDIC-FI-SE csEBCDICFISE }
7316 { EBCDIC-FI-SE-A csEBCDICFISEA }
7317 { EBCDIC-FR csEBCDICFR }
7318 { EBCDIC-IT csEBCDICIT }
7319 { EBCDIC-PT csEBCDICPT }
7320 { EBCDIC-ES csEBCDICES }
7321 { EBCDIC-ES-A csEBCDICESA }
7322 { EBCDIC-ES-S csEBCDICESS }
7323 { EBCDIC-UK csEBCDICUK }
7324 { EBCDIC-US csEBCDICUS }
7325 { UNKNOWN-8BIT csUnknown8BiT }
7326 { MNEMONIC csMnemonic }
7331 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7332 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7333 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7334 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7335 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7336 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7337 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7338 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7339 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7340 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7341 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7342 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7343 { IBM1047 IBM-1047 }
7344 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7345 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7346 { UNICODE-1-1 csUnicode11 }
7349 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7350 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7352 { ISO-8859-15 ISO_8859-15 Latin-9 }
7353 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7354 { GBK CP936 MS936 windows-936 }
7355 { JIS_Encoding csJISEncoding }
7356 { Shift_JIS MS_Kanji csShiftJIS }
7357 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7359 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7360 { ISO-10646-UCS-Basic csUnicodeASCII }
7361 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7362 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7363 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7364 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7365 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7366 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7367 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7368 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7369 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7370 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7371 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7372 { Ventura-US csVenturaUS }
7373 { Ventura-International csVenturaInternational }
7374 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7375 { PC8-Turkish csPC8Turkish }
7376 { IBM-Symbols csIBMSymbols }
7377 { IBM-Thai csIBMThai }
7378 { HP-Legal csHPLegal }
7379 { HP-Pi-font csHPPiFont }
7380 { HP-Math8 csHPMath8 }
7381 { Adobe-Symbol-Encoding csHPPSMath }
7382 { HP-DeskTop csHPDesktop }
7383 { Ventura-Math csVenturaMath }
7384 { Microsoft-Publishing csMicrosoftPublishing }
7385 { Windows-31J csWindows31J }
7390 proc tcl_encoding {enc} {
7391 global encoding_aliases
7392 set names [encoding names]
7393 set lcnames [string tolower $names]
7394 set enc [string tolower $enc]
7395 set i [lsearch -exact $lcnames $enc]
7397 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7398 if {[regsub {^iso[-_]} $enc iso encx]} {
7399 set i [lsearch -exact $lcnames $encx]
7403 foreach l $encoding_aliases {
7404 set ll [string tolower $l]
7405 if {[lsearch -exact $ll $enc] < 0} continue
7406 # look through the aliases for one that tcl knows about
7408 set i [lsearch -exact $lcnames $e]
7410 if {[regsub {^iso[-_]} $e iso ex]} {
7411 set i [lsearch -exact $lcnames $ex]
7420 return [lindex $names $i]
7427 set diffopts "-U 5 -p"
7428 set wrcomcmd "git diff-tree --stdin -p --pretty"
7432 set gitencoding [exec git config --get i18n.commitencoding]
7434 if {$gitencoding == ""} {
7435 set gitencoding "utf-8"
7437 set tclencoding [tcl_encoding $gitencoding]
7438 if {$tclencoding == {}} {
7439 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7442 set mainfont {Helvetica 9}
7443 set textfont {Courier 9}
7444 set uifont {Helvetica 9 bold}
7446 set findmergefiles 0
7454 set cmitmode "patch"
7455 set wrapcomment "none"
7459 set showlocalchanges 1
7461 set colors {green red blue magenta darkgrey brown orange}
7464 set diffcolors {red "#00a000" blue}
7465 set selectbgcolor gray85
7467 catch {source ~/.gitk}
7469 font create optionfont -family sans-serif -size -12
7471 # check that we can find a .git directory somewhere...
7473 if {![file isdirectory $gitdir]} {
7474 show_error {} . "Cannot find the git directory \"$gitdir\"."
7479 set cmdline_files {}
7484 "-d" { set datemode 1 }
7486 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7490 lappend revtreeargs $arg
7496 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7497 # no -- on command line, but some arguments (other than -d)
7499 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7500 set cmdline_files [split $f "\n"]
7501 set n [llength $cmdline_files]
7502 set revtreeargs [lrange $revtreeargs 0 end-$n]
7503 # Unfortunately git rev-parse doesn't produce an error when
7504 # something is both a revision and a filename. To be consistent
7505 # with git log and git rev-list, check revtreeargs for filenames.
7506 foreach arg $revtreeargs {
7507 if {[file exists $arg]} {
7508 show_error {} . "Ambiguous argument '$arg': both revision\
7514 # unfortunately we get both stdout and stderr in $err,
7515 # so look for "fatal:".
7516 set i [string first "fatal:" $err]
7518 set err [string range $err [expr {$i + 6}] end]
7520 show_error {} . "Bad arguments to gitk:\n$err"
7525 set nullid "0000000000000000000000000000000000000000"
7532 set highlight_paths {}
7533 set searchdirn -forwards
7537 set markingmatches 0
7544 set selectedhlview None
7553 set lookingforhead 0
7558 wm title . "[file tail $argv0]: [file tail [pwd]]"
7561 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7562 # create a view for the files/dirs specified on the command line
7566 set viewname(1) "Command line"
7567 set viewfiles(1) $cmdline_files
7568 set viewargs(1) $revtreeargs
7571 .bar.view entryconf Edit* -state normal
7572 .bar.view entryconf Delete* -state normal
7575 if {[info exists permviews]} {
7576 foreach v $permviews {
7579 set viewname($n) [lindex $v 0]
7580 set viewfiles($n) [lindex $v 1]
7581 set viewargs($n) [lindex $v 2]