2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
56 set fd
[lindex
$runq 0 0]
57 set script [lindex
$runq 0 1]
58 set repeat
[eval $script]
59 set t1
[clock clicks
-milliseconds]
60 set t
[expr {$t1 - $t0}]
61 set runq
[lrange
$runq 1 end
]
62 if {$repeat ne
{} && $repeat} {
63 if {$fd eq
{} ||
$repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq
[list
$fd $script]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx
86 global lookingforhead showlocalchanges
88 set startmsecs
[clock clicks
-milliseconds]
89 set commitidx
($view) 0
90 set args
$viewargs($view)
91 if {$viewfiles($view) ne
{}} {
92 set args
[concat
$args "--" $viewfiles($view)]
94 set order
"--topo-order"
96 set order
"--date-order"
99 set fd
[open
[concat | git rev-list
--header $order \
100 --parents --boundary --default HEAD
$args] r
]
102 puts stderr
"Error executing git rev-list: $err"
105 set commfd
($view) $fd
106 set leftover
($view) {}
107 set lookingforhead
$showlocalchanges
108 fconfigure
$fd -blocking 0 -translation lf
109 if {$tclencoding != {}} {
110 fconfigure
$fd -encoding $tclencoding
112 filerun
$fd [list getcommitlines
$fd $view]
116 proc stop_rev_list
{} {
117 global commfd curview
119 if {![info exists commfd
($curview)]} return
120 set fd
$commfd($curview)
126 unset commfd
($curview)
130 global phase canv mainfont curview
134 start_rev_list
$curview
135 show_status
"Reading commits..."
138 proc getcommitlines
{fd view
} {
140 global leftover commfd
141 global displayorder commitidx commitrow commitdata
142 global parentlist children curview hlview
143 global vparentlist vdisporder vcmitlisted
145 set stuff
[read $fd 500000]
153 # set it blocking so we wait for the process to terminate
154 fconfigure
$fd -blocking 1
155 if {[catch
{close
$fd} err
]} {
157 if {$view != $curview} {
158 set fv
" for the \"$viewname($view)\" view"
160 if {[string range
$err 0 4] == "usage"} {
161 set err
"Gitk: error reading commits$fv:\
162 bad arguments to git rev-list."
163 if {$viewname($view) eq
"Command line"} {
165 " (Note: arguments to gitk are passed to git rev-list\
166 to allow selection of commits to be displayed.)"
169 set err
"Error reading commits$fv: $err"
173 if {$view == $curview} {
174 run chewcommits
$view
181 set i
[string first
"\0" $stuff $start]
183 append leftover
($view) [string range
$stuff $start end
]
187 set cmit
$leftover($view)
188 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
189 set leftover
($view) {}
191 set cmit
[string range
$stuff $start [expr {$i - 1}]]
193 set start
[expr {$i + 1}]
194 set j
[string first
"\n" $cmit]
198 set ids
[string range
$cmit 0 [expr {$j - 1}]]
199 if {[string range
$ids 0 0] == "-"} {
201 set ids
[string range
$ids 1 end
]
205 if {[string length
$id] != 40} {
213 if {[string length
$shortcmit] > 80} {
214 set shortcmit
"[string range $shortcmit 0 80]..."
216 error_popup
"Can't parse git rev-list output: {$shortcmit}"
219 set id
[lindex
$ids 0]
221 set olds
[lrange
$ids 1 end
]
224 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
225 lappend children
($view,$p) $id
232 if {![info exists children
($view,$id)]} {
233 set children
($view,$id) {}
235 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
236 set commitrow
($view,$id) $commitidx($view)
237 incr commitidx
($view)
238 if {$view == $curview} {
239 lappend parentlist
$olds
240 lappend displayorder
$id
241 lappend commitlisted
$listed
243 lappend vparentlist
($view) $olds
244 lappend vdisporder
($view) $id
245 lappend vcmitlisted
($view) $listed
250 run chewcommits
$view
255 proc chewcommits
{view
} {
256 global curview hlview commfd
257 global selectedline pending_select
260 if {$view == $curview} {
261 set allread
[expr {![info exists commfd
($view)]}]
262 set tlimit
[expr {[clock clicks
-milliseconds] + 50}]
263 set more [layoutmore
$tlimit $allread]
264 if {$allread && !$more} {
265 global displayorder nullid commitidx phase
266 global numcommits startmsecs
268 if {[info exists pending_select
]} {
269 set row
[expr {[lindex
$displayorder 0] eq
$nullid}]
272 if {$commitidx($curview) > 0} {
273 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
274 #puts "overall $ms ms for $numcommits commits"
276 show_status
"No commits selected"
282 if {[info exists hlview
] && $view == $hlview} {
288 proc readcommit
{id
} {
289 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
290 parsecommit
$id $contents 0
293 proc updatecommits
{} {
294 global viewdata curview phase displayorder
295 global children commitrow selectedline thickerline
302 foreach id
$displayorder {
303 catch
{unset children
($n,$id)}
304 catch
{unset commitrow
($n,$id)}
307 catch
{unset selectedline
}
308 catch
{unset thickerline
}
309 catch
{unset viewdata
($n)}
316 proc parsecommit
{id contents listed
} {
317 global commitinfo cdate
326 set hdrend
[string first
"\n\n" $contents]
328 # should never happen...
329 set hdrend
[string length
$contents]
331 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
332 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
333 foreach line
[split $header "\n"] {
334 set tag
[lindex
$line 0]
335 if {$tag == "author"} {
336 set audate
[lindex
$line end-1
]
337 set auname
[lrange
$line 1 end-2
]
338 } elseif
{$tag == "committer"} {
339 set comdate
[lindex
$line end-1
]
340 set comname
[lrange
$line 1 end-2
]
344 # take the first non-blank line of the comment as the headline
345 set headline
[string trimleft
$comment]
346 set i
[string first
"\n" $headline]
348 set headline
[string range
$headline 0 $i]
350 set headline
[string trimright
$headline]
351 set i
[string first
"\r" $headline]
353 set headline
[string trimright
[string range
$headline 0 $i]]
356 # git rev-list indents the comment by 4 spaces;
357 # if we got this via git cat-file, add the indentation
359 foreach line
[split $comment "\n"] {
360 append newcomment
" "
361 append newcomment
$line
362 append newcomment
"\n"
364 set comment
$newcomment
366 if {$comdate != {}} {
367 set cdate
($id) $comdate
369 set commitinfo
($id) [list
$headline $auname $audate \
370 $comname $comdate $comment]
373 proc getcommit
{id
} {
374 global commitdata commitinfo
376 if {[info exists commitdata
($id)]} {
377 parsecommit
$id $commitdata($id) 1
380 if {![info exists commitinfo
($id)]} {
381 set commitinfo
($id) {"No commit information available"}
388 global tagids idtags headids idheads tagobjid
389 global otherrefids idotherrefs mainhead mainheadid
391 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
394 set refd
[open
[list | git show-ref
-d] r
]
395 while {[gets
$refd line
] >= 0} {
396 if {[string index
$line 40] ne
" "} continue
397 set id
[string range
$line 0 39]
398 set ref
[string range
$line 41 end
]
399 if {![string match
"refs/*" $ref]} continue
400 set name
[string range
$ref 5 end
]
401 if {[string match
"remotes/*" $name]} {
402 if {![string match
"*/HEAD" $name]} {
403 set headids
($name) $id
404 lappend idheads
($id) $name
406 } elseif
{[string match
"heads/*" $name]} {
407 set name
[string range
$name 6 end
]
408 set headids
($name) $id
409 lappend idheads
($id) $name
410 } elseif
{[string match
"tags/*" $name]} {
411 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
412 # which is what we want since the former is the commit ID
413 set name
[string range
$name 5 end
]
414 if {[string match
"*^{}" $name]} {
415 set name
[string range
$name 0 end-3
]
417 set tagobjid
($name) $id
419 set tagids
($name) $id
420 lappend idtags
($id) $name
422 set otherrefids
($name) $id
423 lappend idotherrefs
($id) $name
430 set thehead
[exec git symbolic-ref HEAD
]
431 if {[string match
"refs/heads/*" $thehead]} {
432 set mainhead
[string range
$thehead 11 end
]
433 if {[info exists headids
($mainhead)]} {
434 set mainheadid
$headids($mainhead)
440 # update things for a head moved to a child of its previous location
441 proc movehead
{id name
} {
442 global headids idheads
444 removehead
$headids($name) $name
445 set headids
($name) $id
446 lappend idheads
($id) $name
449 # update things when a head has been removed
450 proc removehead
{id name
} {
451 global headids idheads
453 if {$idheads($id) eq
$name} {
456 set i
[lsearch
-exact $idheads($id) $name]
458 set idheads
($id) [lreplace
$idheads($id) $i $i]
464 proc show_error
{w top msg
} {
465 message
$w.m
-text $msg -justify center
-aspect 400
466 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
467 button
$w.ok
-text OK
-command "destroy $top"
468 pack
$w.ok
-side bottom
-fill x
469 bind $top <Visibility
> "grab $top; focus $top"
470 bind $top <Key-Return
> "destroy $top"
474 proc error_popup msg
{
478 show_error
$w $w $msg
481 proc confirm_popup msg
{
487 message
$w.m
-text $msg -justify center
-aspect 400
488 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
489 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
490 pack
$w.ok
-side left
-fill x
491 button
$w.cancel
-text Cancel
-command "destroy $w"
492 pack
$w.cancel
-side right
-fill x
493 bind $w <Visibility
> "grab $w; focus $w"
499 global canv canv2 canv3 linespc charspc ctext cflist
500 global textfont mainfont uifont tabstop
501 global findtype findtypemenu findloc findstring fstring geometry
502 global entries sha1entry sha1string sha1but
503 global maincursor textcursor curtextcursor
504 global rowctxmenu fakerowmenu mergemax wrapcomment
505 global highlight_files gdttype
506 global searchstring sstring
507 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
511 .bar add cascade
-label "File" -menu .bar.
file
512 .bar configure
-font $uifont
514 .bar.
file add
command -label "Update" -command updatecommits
515 .bar.
file add
command -label "Reread references" -command rereadrefs
516 .bar.
file add
command -label "Quit" -command doquit
517 .bar.
file configure
-font $uifont
519 .bar add cascade
-label "Edit" -menu .bar.edit
520 .bar.edit add
command -label "Preferences" -command doprefs
521 .bar.edit configure
-font $uifont
523 menu .bar.view
-font $uifont
524 .bar add cascade
-label "View" -menu .bar.view
525 .bar.view add
command -label "New view..." -command {newview
0}
526 .bar.view add
command -label "Edit view..." -command editview \
528 .bar.view add
command -label "Delete view" -command delview
-state disabled
529 .bar.view add separator
530 .bar.view add radiobutton
-label "All files" -command {showview
0} \
531 -variable selectedview
-value 0
534 .bar add cascade
-label "Help" -menu .bar.
help
535 .bar.
help add
command -label "About gitk" -command about
536 .bar.
help add
command -label "Key bindings" -command keys
537 .bar.
help configure
-font $uifont
538 . configure
-menu .bar
540 # the gui has upper and lower half, parts of a paned window.
541 panedwindow .ctop
-orient vertical
543 # possibly use assumed geometry
544 if {![info exists geometry
(pwsash0
)]} {
545 set geometry
(topheight
) [expr {15 * $linespc}]
546 set geometry
(topwidth
) [expr {80 * $charspc}]
547 set geometry
(botheight
) [expr {15 * $linespc}]
548 set geometry
(botwidth
) [expr {50 * $charspc}]
549 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
550 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
553 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
554 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
556 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
558 # create three canvases
559 set cscroll .tf.histframe.csb
560 set canv .tf.histframe.pwclist.canv
562 -selectbackground $selectbgcolor \
563 -background $bgcolor -bd 0 \
564 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
565 .tf.histframe.pwclist add
$canv
566 set canv2 .tf.histframe.pwclist.canv2
568 -selectbackground $selectbgcolor \
569 -background $bgcolor -bd 0 -yscrollincr $linespc
570 .tf.histframe.pwclist add
$canv2
571 set canv3 .tf.histframe.pwclist.canv3
573 -selectbackground $selectbgcolor \
574 -background $bgcolor -bd 0 -yscrollincr $linespc
575 .tf.histframe.pwclist add
$canv3
576 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
577 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
579 # a scroll bar to rule them
580 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
581 pack
$cscroll -side right
-fill y
582 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
583 lappend bglist
$canv $canv2 $canv3
584 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
586 # we have two button bars at bottom of top frame. Bar 1
588 frame .tf.lbar
-height 15
590 set sha1entry .tf.bar.sha1
591 set entries
$sha1entry
592 set sha1but .tf.bar.sha1label
593 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
594 -command gotocommit
-width 8 -font $uifont
595 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
596 pack .tf.bar.sha1label
-side left
597 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
598 trace add variable sha1string
write sha1change
599 pack
$sha1entry -side left
-pady 2
601 image create bitmap bm-left
-data {
602 #define left_width 16
603 #define left_height 16
604 static unsigned char left_bits
[] = {
605 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
606 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
607 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
609 image create bitmap bm-right
-data {
610 #define right_width 16
611 #define right_height 16
612 static unsigned char right_bits
[] = {
613 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
614 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
615 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
617 button .tf.bar.leftbut
-image bm-left
-command goback \
618 -state disabled
-width 26
619 pack .tf.bar.leftbut
-side left
-fill y
620 button .tf.bar.rightbut
-image bm-right
-command goforw \
621 -state disabled
-width 26
622 pack .tf.bar.rightbut
-side left
-fill y
624 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
625 pack .tf.bar.findbut
-side left
627 set fstring .tf.bar.findstring
628 lappend entries
$fstring
629 entry
$fstring -width 30 -font $textfont -textvariable findstring
630 trace add variable findstring
write find_change
631 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
633 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
634 findtype Exact IgnCase Regexp
]
635 trace add variable findtype
write find_change
636 .tf.bar.findtype configure
-font $uifont
637 .tf.bar.findtype.menu configure
-font $uifont
638 set findloc
"All fields"
639 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
640 Comments Author Committer
641 trace add variable findloc
write find_change
642 .tf.bar.findloc configure
-font $uifont
643 .tf.bar.findloc.menu configure
-font $uifont
644 pack .tf.bar.findloc
-side right
645 pack .tf.bar.findtype
-side right
647 # build up the bottom bar of upper window
648 label .tf.lbar.flabel
-text "Highlight: Commits " \
650 pack .tf.lbar.flabel
-side left
-fill y
651 set gdttype
"touching paths:"
652 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
653 "adding/removing string:"]
654 trace add variable gdttype
write hfiles_change
655 $gm conf
-font $uifont
656 .tf.lbar.gdttype conf
-font $uifont
657 pack .tf.lbar.gdttype
-side left
-fill y
658 entry .tf.lbar.fent
-width 25 -font $textfont \
659 -textvariable highlight_files
660 trace add variable highlight_files
write hfiles_change
661 lappend entries .tf.lbar.fent
662 pack .tf.lbar.fent
-side left
-fill x
-expand 1
663 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
664 pack .tf.lbar.vlabel
-side left
-fill y
665 global viewhlmenu selectedhlview
666 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
667 $viewhlmenu entryconf None
-command delvhighlight
668 $viewhlmenu conf
-font $uifont
669 .tf.lbar.vhl conf
-font $uifont
670 pack .tf.lbar.vhl
-side left
-fill y
671 label .tf.lbar.rlabel
-text " OR " -font $uifont
672 pack .tf.lbar.rlabel
-side left
-fill y
673 global highlight_related
674 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
675 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
676 $m conf
-font $uifont
677 .tf.lbar.relm conf
-font $uifont
678 trace add variable highlight_related
write vrel_change
679 pack .tf.lbar.relm
-side left
-fill y
681 # Finish putting the upper half of the viewer together
682 pack .tf.lbar
-in .tf
-side bottom
-fill x
683 pack .tf.bar
-in .tf
-side bottom
-fill x
684 pack .tf.histframe
-fill both
-side top
-expand 1
686 .ctop paneconfigure .tf
-height $geometry(topheight
)
687 .ctop paneconfigure .tf
-width $geometry(topwidth
)
689 # now build up the bottom
690 panedwindow .pwbottom
-orient horizontal
692 # lower left, a text box over search bar, scroll bar to the right
693 # if we know window height, then that will set the lower text height, otherwise
694 # we set lower text height which will drive window height
695 if {[info exists geometry
(main
)]} {
696 frame .bleft
-width $geometry(botwidth
)
698 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
703 button .bleft.top.search
-text "Search" -command dosearch \
705 pack .bleft.top.search
-side left
-padx 5
706 set sstring .bleft.top.sstring
707 entry
$sstring -width 20 -font $textfont -textvariable searchstring
708 lappend entries
$sstring
709 trace add variable searchstring
write incrsearch
710 pack
$sstring -side left
-expand 1 -fill x
711 radiobutton .bleft.mid.
diff -text "Diff" \
712 -command changediffdisp
-variable diffelide
-value {0 0}
713 radiobutton .bleft.mid.old
-text "Old version" \
714 -command changediffdisp
-variable diffelide
-value {0 1}
715 radiobutton .bleft.mid.new
-text "New version" \
716 -command changediffdisp
-variable diffelide
-value {1 0}
717 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
718 set ctext .bleft.ctext
719 text
$ctext -background $bgcolor -foreground $fgcolor \
720 -tabs "[expr {$tabstop * $charspc}]" \
721 -state disabled
-font $textfont \
722 -yscrollcommand scrolltext
-wrap none
723 scrollbar .bleft.sb
-command "$ctext yview"
724 pack .bleft.top
-side top
-fill x
725 pack .bleft.mid
-side top
-fill x
726 pack .bleft.sb
-side right
-fill y
727 pack
$ctext -side left
-fill both
-expand 1
728 lappend bglist
$ctext
729 lappend fglist
$ctext
731 $ctext tag conf comment
-wrap $wrapcomment
732 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
733 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
734 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
735 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
736 $ctext tag conf m0
-fore red
737 $ctext tag conf m1
-fore blue
738 $ctext tag conf m2
-fore green
739 $ctext tag conf m3
-fore purple
740 $ctext tag conf
m4 -fore brown
741 $ctext tag conf m5
-fore "#009090"
742 $ctext tag conf m6
-fore magenta
743 $ctext tag conf m7
-fore "#808000"
744 $ctext tag conf m8
-fore "#009000"
745 $ctext tag conf m9
-fore "#ff0080"
746 $ctext tag conf m10
-fore cyan
747 $ctext tag conf m11
-fore "#b07070"
748 $ctext tag conf m12
-fore "#70b0f0"
749 $ctext tag conf m13
-fore "#70f0b0"
750 $ctext tag conf m14
-fore "#f0b070"
751 $ctext tag conf m15
-fore "#ff70b0"
752 $ctext tag conf mmax
-fore darkgrey
754 $ctext tag conf mresult
-font [concat
$textfont bold
]
755 $ctext tag conf msep
-font [concat
$textfont bold
]
756 $ctext tag conf found
-back yellow
759 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
764 radiobutton .bright.mode.
patch -text "Patch" \
765 -command reselectline
-variable cmitmode
-value "patch"
766 .bright.mode.
patch configure
-font $uifont
767 radiobutton .bright.mode.tree
-text "Tree" \
768 -command reselectline
-variable cmitmode
-value "tree"
769 .bright.mode.tree configure
-font $uifont
770 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
771 pack .bright.mode
-side top
-fill x
772 set cflist .bright.cfiles
773 set indent
[font measure
$mainfont "nn"]
775 -selectbackground $selectbgcolor \
776 -background $bgcolor -foreground $fgcolor \
778 -tabs [list
$indent [expr {2 * $indent}]] \
779 -yscrollcommand ".bright.sb set" \
780 -cursor [. cget
-cursor] \
781 -spacing1 1 -spacing3 1
782 lappend bglist
$cflist
783 lappend fglist
$cflist
784 scrollbar .bright.sb
-command "$cflist yview"
785 pack .bright.sb
-side right
-fill y
786 pack
$cflist -side left
-fill both
-expand 1
787 $cflist tag configure highlight \
788 -background [$cflist cget
-selectbackground]
789 $cflist tag configure bold
-font [concat
$mainfont bold
]
791 .pwbottom add .bright
794 # restore window position if known
795 if {[info exists geometry
(main
)]} {
796 wm geometry .
"$geometry(main)"
799 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
800 pack .ctop
-fill both
-expand 1
801 bindall
<1> {selcanvline
%W
%x
%y
}
802 #bindall <B1-Motion> {selcanvline %W %x %y}
803 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
804 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
805 bindall
<2> "canvscan mark %W %x %y"
806 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
807 bindkey
<Home
> selfirstline
808 bindkey
<End
> sellastline
809 bind .
<Key-Up
> "selnextline -1"
810 bind .
<Key-Down
> "selnextline 1"
811 bind .
<Shift-Key-Up
> "next_highlight -1"
812 bind .
<Shift-Key-Down
> "next_highlight 1"
813 bindkey
<Key-Right
> "goforw"
814 bindkey
<Key-Left
> "goback"
815 bind .
<Key-Prior
> "selnextpage -1"
816 bind .
<Key-Next
> "selnextpage 1"
817 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
818 bind .
<Control-End
> "allcanvs yview moveto 1.0"
819 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
820 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
821 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
822 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
823 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
824 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
825 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
826 bindkey p
"selnextline -1"
827 bindkey n
"selnextline 1"
830 bindkey i
"selnextline -1"
831 bindkey k
"selnextline 1"
834 bindkey b
"$ctext yview scroll -1 pages"
835 bindkey d
"$ctext yview scroll 18 units"
836 bindkey u
"$ctext yview scroll -18 units"
837 bindkey
/ {findnext
1}
838 bindkey
<Key-Return
> {findnext
0}
841 bindkey
<F5
> updatecommits
842 bind .
<Control-q
> doquit
843 bind .
<Control-f
> dofind
844 bind .
<Control-g
> {findnext
0}
845 bind .
<Control-r
> dosearchback
846 bind .
<Control-s
> dosearch
847 bind .
<Control-equal
> {incrfont
1}
848 bind .
<Control-KP_Add
> {incrfont
1}
849 bind .
<Control-minus
> {incrfont
-1}
850 bind .
<Control-KP_Subtract
> {incrfont
-1}
851 wm protocol . WM_DELETE_WINDOW doquit
852 bind .
<Button-1
> "click %W"
853 bind $fstring <Key-Return
> dofind
854 bind $sha1entry <Key-Return
> gotocommit
855 bind $sha1entry <<PasteSelection>> clearsha1
856 bind $cflist <1> {sel_flist %W %x %y; break}
857 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
858 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
860 set maincursor [. cget -cursor]
861 set textcursor [$ctext cget -cursor]
862 set curtextcursor $textcursor
864 set rowctxmenu .rowctxmenu
865 menu $rowctxmenu -tearoff 0
866 $rowctxmenu add command -label "Diff this -> selected" \
867 -command {diffvssel 0}
868 $rowctxmenu add command -label "Diff selected -> this" \
869 -command {diffvssel 1}
870 $rowctxmenu add command -label "Make patch" -command mkpatch
871 $rowctxmenu add command -label "Create tag" -command mktag
872 $rowctxmenu add command -label "Write commit to file" -command writecommit
873 $rowctxmenu add command -label "Create new branch" -command mkbranch
874 $rowctxmenu add command -label "Cherry-pick this commit" \
876 $rowctxmenu add command -label "Reset HEAD branch to here" \
879 set fakerowmenu .fakerowmenu
880 menu $fakerowmenu -tearoff 0
881 $fakerowmenu add command -label "Diff this -> selected" \
882 -command {diffvssel 0}
883 $fakerowmenu add command -label "Diff selected -> this" \
884 -command {diffvssel 1}
885 $fakerowmenu add command -label "Make patch" -command mkpatch
886 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
887 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
888 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
890 set headctxmenu .headctxmenu
891 menu $headctxmenu -tearoff 0
892 $headctxmenu add command -label "Check out this branch" \
894 $headctxmenu add command -label "Remove this branch" \
898 # mouse-2 makes all windows scan vertically, but only the one
899 # the cursor is in scans horizontally
900 proc canvscan {op w x y} {
901 global canv canv2 canv3
902 foreach c [list $canv $canv2 $canv3] {
911 proc scrollcanv {cscroll f0 f1} {
917 # when we make a key binding for the toplevel, make sure
918 # it doesn't get triggered when that key is pressed in the
919 # find string entry widget.
920 proc bindkey {ev script} {
923 set escript [bind Entry $ev]
924 if {$escript == {}} {
925 set escript [bind Entry <Key>]
928 bind $e $ev "$escript; break"
932 # set the focus back to the toplevel for any click outside
943 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
944 global stuffsaved findmergefiles maxgraphpct
945 global maxwidth showneartags showlocalchanges
946 global viewname viewfiles viewargs viewperm nextviewnum
947 global cmitmode wrapcomment
948 global colors bgcolor fgcolor diffcolors selectbgcolor
950 if {$stuffsaved} return
951 if {![winfo viewable .]} return
953 set f [open "~/.gitk-new" w]
954 puts $f [list set mainfont $mainfont]
955 puts $f [list set textfont $textfont]
956 puts $f [list set uifont $uifont]
957 puts $f [list set tabstop $tabstop]
958 puts $f [list set findmergefiles $findmergefiles]
959 puts $f [list set maxgraphpct $maxgraphpct]
960 puts $f [list set maxwidth $maxwidth]
961 puts $f [list set cmitmode $cmitmode]
962 puts $f [list set wrapcomment $wrapcomment]
963 puts $f [list set showneartags $showneartags]
964 puts $f [list set showlocalchanges $showlocalchanges]
965 puts $f [list set bgcolor $bgcolor]
966 puts $f [list set fgcolor $fgcolor]
967 puts $f [list set colors $colors]
968 puts $f [list set diffcolors $diffcolors]
969 puts $f [list set selectbgcolor $selectbgcolor]
971 puts $f "set geometry(main) [wm geometry .]"
972 puts $f "set geometry(topwidth) [winfo width .tf]"
973 puts $f "set geometry(topheight) [winfo height .tf]"
974 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
975 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
976 puts $f "set geometry(botwidth) [winfo width .bleft]"
977 puts $f "set geometry(botheight) [winfo height .bleft]"
979 puts -nonewline $f "set permviews {"
980 for {set v 0} {$v < $nextviewnum} {incr v} {
982 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
987 file rename -force "~/.gitk-new" "~/.gitk"
992 proc resizeclistpanes {win w} {
994 if {[info exists oldwidth($win)]} {
995 set s0 [$win sash coord 0]
996 set s1 [$win sash coord 1]
998 set sash0 [expr {int($w/2 - 2)}]
999 set sash1 [expr {int($w*5/6 - 2)}]
1001 set factor [expr {1.0 * $w / $oldwidth($win)}]
1002 set sash0 [expr {int($factor * [lindex $s0 0])}]
1003 set sash1 [expr {int($factor * [lindex $s1 0])}]
1007 if {$sash1 < $sash0 + 20} {
1008 set sash1 [expr {$sash0 + 20}]
1010 if {$sash1 > $w - 10} {
1011 set sash1 [expr {$w - 10}]
1012 if {$sash0 > $sash1 - 20} {
1013 set sash0 [expr {$sash1 - 20}]
1017 $win sash place 0 $sash0 [lindex $s0 1]
1018 $win sash place 1 $sash1 [lindex $s1 1]
1020 set oldwidth($win) $w
1023 proc resizecdetpanes {win w} {
1025 if {[info exists oldwidth($win)]} {
1026 set s0 [$win sash coord 0]
1028 set sash0 [expr {int($w*3/4 - 2)}]
1030 set factor [expr {1.0 * $w / $oldwidth($win)}]
1031 set sash0 [expr {int($factor * [lindex $s0 0])}]
1035 if {$sash0 > $w - 15} {
1036 set sash0 [expr {$w - 15}]
1039 $win sash place 0 $sash0 [lindex $s0 1]
1041 set oldwidth($win) $w
1044 proc allcanvs args {
1045 global canv canv2 canv3
1051 proc bindall {event action} {
1052 global canv canv2 canv3
1053 bind $canv $event $action
1054 bind $canv2 $event $action
1055 bind $canv3 $event $action
1061 if {[winfo exists $w]} {
1066 wm title $w "About gitk"
1067 message $w.m -text {
1068 Gitk - a commit viewer for git
1070 Copyright © 2005-2006 Paul Mackerras
1072 Use and redistribute under the terms of the GNU General Public License} \
1073 -justify center -aspect 400 -border 2 -bg white -relief groove
1074 pack $w.m -side top -fill x -padx 2 -pady 2
1075 $w.m configure -font $uifont
1076 button $w.ok -text Close -command "destroy $w" -default active
1077 pack $w.ok -side bottom
1078 $w.ok configure -font $uifont
1079 bind $w <Visibility> "focus $w.ok"
1080 bind $w <Key-Escape> "destroy $w"
1081 bind $w <Key-Return> "destroy $w"
1087 if {[winfo exists $w]} {
1092 wm title $w "Gitk key bindings"
1093 message $w.m -text {
1097 <Home> Move to first commit
1098 <End> Move to last commit
1099 <Up>, p, i Move up one commit
1100 <Down>, n, k Move down one commit
1101 <Left>, z, j Go back in history list
1102 <Right>, x, l Go forward in history list
1103 <PageUp> Move up one page in commit list
1104 <PageDown> Move down one page in commit list
1105 <Ctrl-Home> Scroll to top of commit list
1106 <Ctrl-End> Scroll to bottom of commit list
1107 <Ctrl-Up> Scroll commit list up one line
1108 <Ctrl-Down> Scroll commit list down one line
1109 <Ctrl-PageUp> Scroll commit list up one page
1110 <Ctrl-PageDown> Scroll commit list down one page
1111 <Shift-Up> Move to previous highlighted line
1112 <Shift-Down> Move to next highlighted line
1113 <Delete>, b Scroll diff view up one page
1114 <Backspace> Scroll diff view up one page
1115 <Space> Scroll diff view down one page
1116 u Scroll diff view up 18 lines
1117 d Scroll diff view down 18 lines
1119 <Ctrl-G> Move to next find hit
1120 <Return> Move to next find hit
1121 / Move to next find hit, or redo find
1122 ? Move to previous find hit
1123 f Scroll diff view to next file
1124 <Ctrl-S> Search for next hit in diff view
1125 <Ctrl-R> Search for previous hit in diff view
1126 <Ctrl-KP+> Increase font size
1127 <Ctrl-plus> Increase font size
1128 <Ctrl-KP-> Decrease font size
1129 <Ctrl-minus> Decrease font size
1132 -justify left -bg white -border 2 -relief groove
1133 pack $w.m -side top -fill both -padx 2 -pady 2
1134 $w.m configure -font $uifont
1135 button $w.ok -text Close -command "destroy $w" -default active
1136 pack $w.ok -side bottom
1137 $w.ok configure -font $uifont
1138 bind $w <Visibility> "focus $w.ok"
1139 bind $w <Key-Escape> "destroy $w"
1140 bind $w <Key-Return> "destroy $w"
1143 # Procedures for manipulating the file list window at the
1144 # bottom right of the overall window.
1146 proc treeview {w l openlevs} {
1147 global treecontents treediropen treeheight treeparent treeindex
1157 set treecontents() {}
1158 $w conf -state normal
1160 while {[string range $f 0 $prefixend] ne $prefix} {
1161 if {$lev <= $openlevs} {
1162 $w mark set e:$treeindex($prefix) "end -1c"
1163 $w mark gravity e:$treeindex($prefix) left
1165 set treeheight($prefix) $ht
1166 incr ht [lindex $htstack end]
1167 set htstack [lreplace $htstack end end]
1168 set prefixend [lindex $prefendstack end]
1169 set prefendstack [lreplace $prefendstack end end]
1170 set prefix [string range $prefix 0 $prefixend]
1173 set tail [string range $f [expr {$prefixend+1}] end]
1174 while {[set slash [string first "/" $tail]] >= 0} {
1177 lappend prefendstack $prefixend
1178 incr prefixend [expr {$slash + 1}]
1179 set d [string range $tail 0 $slash]
1180 lappend treecontents($prefix) $d
1181 set oldprefix $prefix
1183 set treecontents($prefix) {}
1184 set treeindex($prefix) [incr ix]
1185 set treeparent($prefix) $oldprefix
1186 set tail [string range $tail [expr {$slash+1}] end]
1187 if {$lev <= $openlevs} {
1189 set treediropen($prefix) [expr {$lev < $openlevs}]
1190 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1191 $w mark set d:$ix "end -1c"
1192 $w mark gravity d:$ix left
1194 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1196 $w image create end -align center -image $bm -padx 1 \
1198 $w insert end $d [highlight_tag $prefix]
1199 $w mark set s:$ix "end -1c"
1200 $w mark gravity s:$ix left
1205 if {$lev <= $openlevs} {
1208 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1210 $w insert end $tail [highlight_tag $f]
1212 lappend treecontents($prefix) $tail
1215 while {$htstack ne {}} {
1216 set treeheight($prefix) $ht
1217 incr ht [lindex $htstack end]
1218 set htstack [lreplace $htstack end end]
1220 $w conf -state disabled
1223 proc linetoelt {l} {
1224 global treeheight treecontents
1229 foreach e $treecontents($prefix) {
1234 if {[string index $e end] eq "/"} {
1235 set n $treeheight($prefix$e)
1247 proc highlight_tree {y prefix} {
1248 global treeheight treecontents cflist
1250 foreach e $treecontents($prefix) {
1252 if {[highlight_tag $path] ne {}} {
1253 $cflist tag add bold $y.0 "$y.0 lineend"
1256 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1257 set y [highlight_tree $y $path]
1263 proc treeclosedir {w dir} {
1264 global treediropen treeheight treeparent treeindex
1266 set ix $treeindex($dir)
1267 $w conf -state normal
1268 $w delete s:$ix e:$ix
1269 set treediropen($dir) 0
1270 $w image configure a:$ix -image tri-rt
1271 $w conf -state disabled
1272 set n [expr {1 - $treeheight($dir)}]
1273 while {$dir ne {}} {
1274 incr treeheight($dir) $n
1275 set dir $treeparent($dir)
1279 proc treeopendir {w dir} {
1280 global treediropen treeheight treeparent treecontents treeindex
1282 set ix $treeindex($dir)
1283 $w conf -state normal
1284 $w image configure a:$ix -image tri-dn
1285 $w mark set e:$ix s:$ix
1286 $w mark gravity e:$ix right
1289 set n [llength $treecontents($dir)]
1290 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1293 incr treeheight($x) $n
1295 foreach e $treecontents($dir) {
1297 if {[string index $e end] eq "/"} {
1298 set iy $treeindex($de)
1299 $w mark set d:$iy e:$ix
1300 $w mark gravity d:$iy left
1301 $w insert e:$ix $str
1302 set treediropen($de) 0
1303 $w image create e:$ix -align center -image tri-rt -padx 1 \
1305 $w insert e:$ix $e [highlight_tag $de]
1306 $w mark set s:$iy e:$ix
1307 $w mark gravity s:$iy left
1308 set treeheight($de) 1
1310 $w insert e:$ix $str
1311 $w insert e:$ix $e [highlight_tag $de]
1314 $w mark gravity e:$ix left
1315 $w conf -state disabled
1316 set treediropen($dir) 1
1317 set top [lindex [split [$w index @0,0] .] 0]
1318 set ht [$w cget -height]
1319 set l [lindex [split [$w index s:$ix] .] 0]
1322 } elseif {$l + $n + 1 > $top + $ht} {
1323 set top [expr {$l + $n + 2 - $ht}]
1331 proc treeclick {w x y} {
1332 global treediropen cmitmode ctext cflist cflist_top
1334 if {$cmitmode ne "tree"} return
1335 if {![info exists cflist_top]} return
1336 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1337 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1338 $cflist tag add highlight $l.0 "$l.0 lineend"
1344 set e [linetoelt $l]
1345 if {[string index $e end] ne "/"} {
1347 } elseif {$treediropen($e)} {
1354 proc setfilelist {id} {
1355 global treefilelist cflist
1357 treeview $cflist $treefilelist($id) 0
1360 image create bitmap tri-rt -background black -foreground blue -data {
1361 #define tri-rt_width 13
1362 #define tri-rt_height 13
1363 static unsigned char tri-rt_bits[] = {
1364 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1365 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1368 #define tri-rt-mask_width 13
1369 #define tri-rt-mask_height 13
1370 static unsigned char tri-rt-mask_bits[] = {
1371 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1372 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1375 image create bitmap tri-dn -background black -foreground blue -data {
1376 #define tri-dn_width 13
1377 #define tri-dn_height 13
1378 static unsigned char tri-dn_bits[] = {
1379 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1380 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1383 #define tri-dn-mask_width 13
1384 #define tri-dn-mask_height 13
1385 static unsigned char tri-dn-mask_bits[] = {
1386 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1387 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1391 proc init_flist {first} {
1392 global cflist cflist_top selectedline difffilestart
1394 $cflist conf -state normal
1395 $cflist delete 0.0 end
1397 $cflist insert end $first
1399 $cflist tag add highlight 1.0 "1.0 lineend"
1401 catch {unset cflist_top}
1403 $cflist conf -state disabled
1404 set difffilestart {}
1407 proc highlight_tag {f} {
1408 global highlight_paths
1410 foreach p $highlight_paths {
1411 if {[string match $p $f]} {
1418 proc highlight_filelist {} {
1419 global cmitmode cflist
1421 $cflist conf -state normal
1422 if {$cmitmode ne "tree"} {
1423 set end [lindex [split [$cflist index end] .] 0]
1424 for {set l 2} {$l < $end} {incr l} {
1425 set line [$cflist get $l.0 "$l.0 lineend"]
1426 if {[highlight_tag $line] ne {}} {
1427 $cflist tag add bold $l.0 "$l.0 lineend"
1433 $cflist conf -state disabled
1436 proc unhighlight_filelist {} {
1439 $cflist conf -state normal
1440 $cflist tag remove bold 1.0 end
1441 $cflist conf -state disabled
1444 proc add_flist {fl} {
1447 $cflist conf -state normal
1449 $cflist insert end "\n"
1450 $cflist insert end $f [highlight_tag $f]
1452 $cflist conf -state disabled
1455 proc sel_flist {w x y} {
1456 global ctext difffilestart cflist cflist_top cmitmode
1458 if {$cmitmode eq "tree"} return
1459 if {![info exists cflist_top]} return
1460 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1461 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1462 $cflist tag add highlight $l.0 "$l.0 lineend"
1467 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1471 # Functions for adding and removing shell-type quoting
1473 proc shellquote {str} {
1474 if {![string match "*\['\"\\ \t]*" $str]} {
1477 if {![string match "*\['\"\\]*" $str]} {
1480 if {![string match "*'*" $str]} {
1483 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1486 proc shellarglist {l} {
1492 append str [shellquote $a]
1497 proc shelldequote {str} {
1502 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1503 append ret [string range $str $used end]
1504 set used [string length $str]
1507 set first [lindex $first 0]
1508 set ch [string index $str $first]
1509 if {$first > $used} {
1510 append ret [string range $str $used [expr {$first - 1}]]
1513 if {$ch eq " " || $ch eq "\t"} break
1516 set first [string first "'" $str $used]
1518 error "unmatched single-quote"
1520 append ret [string range $str $used [expr {$first - 1}]]
1525 if {$used >= [string length $str]} {
1526 error "trailing backslash"
1528 append ret [string index $str $used]
1533 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1534 error "unmatched double-quote"
1536 set first [lindex $first 0]
1537 set ch [string index $str $first]
1538 if {$first > $used} {
1539 append ret [string range $str $used [expr {$first - 1}]]
1542 if {$ch eq "\""} break
1544 append ret [string index $str $used]
1548 return [list $used $ret]
1551 proc shellsplit {str} {
1554 set str [string trimleft $str]
1555 if {$str eq {}} break
1556 set dq [shelldequote $str]
1557 set n [lindex $dq 0]
1558 set word [lindex $dq 1]
1559 set str [string range $str $n end]
1565 # Code to implement multiple views
1567 proc newview {ishighlight} {
1568 global nextviewnum newviewname newviewperm uifont newishighlight
1569 global newviewargs revtreeargs
1571 set newishighlight $ishighlight
1573 if {[winfo exists $top]} {
1577 set newviewname($nextviewnum) "View $nextviewnum"
1578 set newviewperm($nextviewnum) 0
1579 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1580 vieweditor $top $nextviewnum "Gitk view definition"
1585 global viewname viewperm newviewname newviewperm
1586 global viewargs newviewargs
1588 set top .gitkvedit-$curview
1589 if {[winfo exists $top]} {
1593 set newviewname($curview) $viewname($curview)
1594 set newviewperm($curview) $viewperm($curview)
1595 set newviewargs($curview) [shellarglist $viewargs($curview)]
1596 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1599 proc vieweditor {top n title} {
1600 global newviewname newviewperm viewfiles
1604 wm title $top $title
1605 label $top.nl -text "Name" -font $uifont
1606 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1607 grid $top.nl $top.name -sticky w -pady 5
1608 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1610 grid $top.perm - -pady 5 -sticky w
1611 message $top.al -aspect 1000 -font $uifont \
1612 -text "Commits to include (arguments to git rev-list):"
1613 grid $top.al - -sticky w -pady 5
1614 entry $top.args -width 50 -textvariable newviewargs($n) \
1615 -background white -font $uifont
1616 grid $top.args - -sticky ew -padx 5
1617 message $top.l -aspect 1000 -font $uifont \
1618 -text "Enter files and directories to include, one per line:"
1619 grid $top.l - -sticky w
1620 text $top.t -width 40 -height 10 -background white -font $uifont
1621 if {[info exists viewfiles($n)]} {
1622 foreach f $viewfiles($n) {
1623 $top.t insert end $f
1624 $top.t insert end "\n"
1626 $top.t delete {end - 1c} end
1627 $top.t mark set insert 0.0
1629 grid $top.t - -sticky ew -padx 5
1631 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1633 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1635 grid $top.buts.ok $top.buts.can
1636 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1637 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1638 grid $top.buts - -pady 10 -sticky ew
1642 proc doviewmenu {m first cmd op argv} {
1643 set nmenu [$m index end]
1644 for {set i $first} {$i <= $nmenu} {incr i} {
1645 if {[$m entrycget $i -command] eq $cmd} {
1646 eval $m $op $i $argv
1652 proc allviewmenus {n op args} {
1655 doviewmenu .bar.view 5 [list showview $n] $op $args
1656 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1659 proc newviewok {top n} {
1660 global nextviewnum newviewperm newviewname newishighlight
1661 global viewname viewfiles viewperm selectedview curview
1662 global viewargs newviewargs viewhlmenu
1665 set newargs [shellsplit $newviewargs($n)]
1667 error_popup "Error in commit selection arguments: $err"
1673 foreach f [split [$top.t get 0.0 end] "\n"] {
1674 set ft [string trim $f]
1679 if {![info exists viewfiles($n)]} {
1680 # creating a new view
1682 set viewname($n) $newviewname($n)
1683 set viewperm($n) $newviewperm($n)
1684 set viewfiles($n) $files
1685 set viewargs($n) $newargs
1687 if {!$newishighlight} {
1690 run addvhighlight $n
1693 # editing an existing view
1694 set viewperm($n) $newviewperm($n)
1695 if {$newviewname($n) ne $viewname($n)} {
1696 set viewname($n) $newviewname($n)
1697 doviewmenu .bar.view 5 [list showview $n] \
1698 entryconf [list -label $viewname($n)]
1699 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1700 entryconf [list -label $viewname($n) -value $viewname($n)]
1702 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1703 set viewfiles($n) $files
1704 set viewargs($n) $newargs
1705 if {$curview == $n} {
1710 catch {destroy $top}
1714 global curview viewdata viewperm hlview selectedhlview
1716 if {$curview == 0} return
1717 if {[info exists hlview] && $hlview == $curview} {
1718 set selectedhlview None
1721 allviewmenus $curview delete
1722 set viewdata($curview) {}
1723 set viewperm($curview) 0
1727 proc addviewmenu {n} {
1728 global viewname viewhlmenu
1730 .bar.view add radiobutton -label $viewname($n) \
1731 -command [list showview $n] -variable selectedview -value $n
1732 $viewhlmenu add radiobutton -label $viewname($n) \
1733 -command [list addvhighlight $n] -variable selectedhlview
1736 proc flatten {var} {
1740 foreach i [array names $var] {
1741 lappend ret $i [set $var\($i\)]
1746 proc unflatten {var l} {
1756 global curview viewdata viewfiles
1757 global displayorder parentlist rowidlist rowoffsets
1758 global colormap rowtextx commitrow nextcolor canvxmax
1759 global numcommits rowrangelist commitlisted idrowranges rowchk
1760 global selectedline currentid canv canvy0
1761 global matchinglines treediffs
1762 global pending_select phase
1763 global commitidx rowlaidout rowoptim
1765 global selectedview selectfirst
1766 global vparentlist vdisporder vcmitlisted
1767 global hlview selectedhlview
1769 if {$n == $curview} return
1771 if {[info exists selectedline]} {
1772 set selid $currentid
1773 set y [yc $selectedline]
1774 set ymax [lindex [$canv cget -scrollregion] 3]
1775 set span [$canv yview]
1776 set ytop [expr {[lindex $span 0] * $ymax}]
1777 set ybot [expr {[lindex $span 1] * $ymax}]
1778 if {$ytop < $y && $y < $ybot} {
1779 set yscreen [expr {$y - $ytop}]
1781 set yscreen [expr {($ybot - $ytop) / 2}]
1783 } elseif {[info exists pending_select]} {
1784 set selid $pending_select
1785 unset pending_select
1790 if {$curview >= 0} {
1791 set vparentlist($curview) $parentlist
1792 set vdisporder($curview) $displayorder
1793 set vcmitlisted($curview) $commitlisted
1795 set viewdata($curview) \
1796 [list $phase $rowidlist $rowoffsets $rowrangelist \
1797 [flatten idrowranges] [flatten idinlist] \
1798 $rowlaidout $rowoptim $numcommits]
1799 } elseif {![info exists viewdata($curview)]
1800 || [lindex $viewdata($curview) 0] ne {}} {
1801 set viewdata($curview) \
1802 [list {} $rowidlist $rowoffsets $rowrangelist]
1805 catch {unset matchinglines}
1806 catch {unset treediffs}
1808 if {[info exists hlview] && $hlview == $n} {
1810 set selectedhlview None
1815 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1816 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1818 if {![info exists viewdata($n)]} {
1820 set pending_select $selid
1827 set phase [lindex $v 0]
1828 set displayorder $vdisporder($n)
1829 set parentlist $vparentlist($n)
1830 set commitlisted $vcmitlisted($n)
1831 set rowidlist [lindex $v 1]
1832 set rowoffsets [lindex $v 2]
1833 set rowrangelist [lindex $v 3]
1835 set numcommits [llength $displayorder]
1836 catch {unset idrowranges}
1838 unflatten idrowranges [lindex $v 4]
1839 unflatten idinlist [lindex $v 5]
1840 set rowlaidout [lindex $v 6]
1841 set rowoptim [lindex $v 7]
1842 set numcommits [lindex $v 8]
1843 catch {unset rowchk}
1846 catch {unset colormap}
1847 catch {unset rowtextx}
1849 set canvxmax [$canv cget -width]
1856 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1857 set row $commitrow($n,$selid)
1858 # try to get the selected row in the same position on the screen
1859 set ymax [lindex [$canv cget -scrollregion] 3]
1860 set ytop [expr {[yc $row] - $yscreen}]
1864 set yf [expr {$ytop * 1.0 / $ymax}]
1866 allcanvs yview moveto $yf
1870 } elseif {$selid ne {}} {
1871 set pending_select $selid
1873 set row [expr {[lindex $displayorder 0] eq $nullid}]
1874 if {$row < $numcommits} {
1881 if {$phase eq "getcommits"} {
1882 show_status "Reading commits..."
1885 } elseif {$numcommits == 0} {
1886 show_status "No commits selected"
1890 # Stuff relating to the highlighting facility
1892 proc ishighlighted {row} {
1893 global vhighlights fhighlights nhighlights rhighlights
1895 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1896 return $nhighlights($row)
1898 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1899 return $vhighlights($row)
1901 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1902 return $fhighlights($row)
1904 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1905 return $rhighlights($row)
1910 proc bolden {row font} {
1911 global canv linehtag selectedline boldrows
1913 lappend boldrows $row
1914 $canv itemconf $linehtag($row) -font $font
1915 if {[info exists selectedline] && $row == $selectedline} {
1917 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1918 -outline {{}} -tags secsel \
1919 -fill [$canv cget -selectbackground]]
1924 proc bolden_name {row font} {
1925 global canv2 linentag selectedline boldnamerows
1927 lappend boldnamerows $row
1928 $canv2 itemconf $linentag($row) -font $font
1929 if {[info exists selectedline] && $row == $selectedline} {
1930 $canv2 delete secsel
1931 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1932 -outline {{}} -tags secsel \
1933 -fill [$canv2 cget -selectbackground]]
1939 global mainfont boldrows
1942 foreach row $boldrows {
1943 if {![ishighlighted $row]} {
1944 bolden $row $mainfont
1946 lappend stillbold $row
1949 set boldrows $stillbold
1952 proc addvhighlight {n} {
1953 global hlview curview viewdata vhl_done vhighlights commitidx
1955 if {[info exists hlview]} {
1959 if {$n != $curview && ![info exists viewdata($n)]} {
1960 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1961 set vparentlist($n) {}
1962 set vdisporder($n) {}
1963 set vcmitlisted($n) {}
1966 set vhl_done $commitidx($hlview)
1967 if {$vhl_done > 0} {
1972 proc delvhighlight {} {
1973 global hlview vhighlights
1975 if {![info exists hlview]} return
1977 catch {unset vhighlights}
1981 proc vhighlightmore {} {
1982 global hlview vhl_done commitidx vhighlights
1983 global displayorder vdisporder curview mainfont
1985 set font [concat $mainfont bold]
1986 set max $commitidx($hlview)
1987 if {$hlview == $curview} {
1988 set disp $displayorder
1990 set disp $vdisporder($hlview)
1992 set vr [visiblerows]
1993 set r0 [lindex $vr 0]
1994 set r1 [lindex $vr 1]
1995 for {set i $vhl_done} {$i < $max} {incr i} {
1996 set id [lindex $disp $i]
1997 if {[info exists commitrow($curview,$id)]} {
1998 set row $commitrow($curview,$id)
1999 if {$r0 <= $row && $row <= $r1} {
2000 if {![highlighted $row]} {
2003 set vhighlights($row) 1
2010 proc askvhighlight {row id} {
2011 global hlview vhighlights commitrow iddrawn mainfont
2013 if {[info exists commitrow($hlview,$id)]} {
2014 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2015 bolden $row [concat $mainfont bold]
2017 set vhighlights($row) 1
2019 set vhighlights($row) 0
2023 proc hfiles_change {name ix op} {
2024 global highlight_files filehighlight fhighlights fh_serial
2025 global mainfont highlight_paths
2027 if {[info exists filehighlight]} {
2028 # delete previous highlights
2029 catch {close $filehighlight}
2031 catch {unset fhighlights}
2033 unhighlight_filelist
2035 set highlight_paths {}
2036 after cancel do_file_hl $fh_serial
2038 if {$highlight_files ne {}} {
2039 after 300 do_file_hl $fh_serial
2043 proc makepatterns {l} {
2046 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2047 if {[string index $ee end] eq "/"} {
2057 proc do_file_hl {serial} {
2058 global highlight_files filehighlight highlight_paths gdttype fhl_list
2060 if {$gdttype eq "touching paths:"} {
2061 if {[catch {set paths [shellsplit $highlight_files]}]} return
2062 set highlight_paths [makepatterns $paths]
2064 set gdtargs [concat -- $paths]
2066 set gdtargs [list "-S$highlight_files"]
2068 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2069 set filehighlight [open $cmd r+]
2070 fconfigure $filehighlight -blocking 0
2071 filerun $filehighlight readfhighlight
2077 proc flushhighlights {} {
2078 global filehighlight fhl_list
2080 if {[info exists filehighlight]} {
2082 puts $filehighlight ""
2083 flush $filehighlight
2087 proc askfilehighlight {row id} {
2088 global filehighlight fhighlights fhl_list
2090 lappend fhl_list $id
2091 set fhighlights($row) -1
2092 puts $filehighlight $id
2095 proc readfhighlight {} {
2096 global filehighlight fhighlights commitrow curview mainfont iddrawn
2099 if {![info exists filehighlight]} {
2103 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2104 set line [string trim $line]
2105 set i [lsearch -exact $fhl_list $line]
2106 if {$i < 0} continue
2107 for {set j 0} {$j < $i} {incr j} {
2108 set id [lindex $fhl_list $j]
2109 if {[info exists commitrow($curview,$id)]} {
2110 set fhighlights($commitrow($curview,$id)) 0
2113 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2114 if {$line eq {}} continue
2115 if {![info exists commitrow($curview,$line)]} continue
2116 set row $commitrow($curview,$line)
2117 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2118 bolden $row [concat $mainfont bold]
2120 set fhighlights($row) 1
2122 if {[eof $filehighlight]} {
2124 puts "oops, git diff-tree died"
2125 catch {close $filehighlight}
2133 proc find_change {name ix op} {
2134 global nhighlights mainfont boldnamerows
2135 global findstring findpattern findtype
2137 # delete previous highlights, if any
2138 foreach row $boldnamerows {
2139 bolden_name $row $mainfont
2142 catch {unset nhighlights}
2144 if {$findtype ne "Regexp"} {
2145 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2147 set findpattern "*$e*"
2152 proc askfindhighlight {row id} {
2153 global nhighlights commitinfo iddrawn mainfont
2154 global findstring findtype findloc findpattern
2156 if {![info exists commitinfo($id)]} {
2159 set info $commitinfo($id)
2161 set fldtypes {Headline Author Date Committer CDate Comments}
2162 foreach f $info ty $fldtypes {
2163 if {$findloc ne "All fields" && $findloc ne $ty} {
2166 if {$findtype eq "Regexp"} {
2167 set doesmatch [regexp $findstring $f]
2168 } elseif {$findtype eq "IgnCase"} {
2169 set doesmatch [string match -nocase $findpattern $f]
2171 set doesmatch [string match $findpattern $f]
2174 if {$ty eq "Author"} {
2181 if {[info exists iddrawn($id)]} {
2182 if {$isbold && ![ishighlighted $row]} {
2183 bolden $row [concat $mainfont bold]
2186 bolden_name $row [concat $mainfont bold]
2189 set nhighlights($row) $isbold
2192 proc vrel_change {name ix op} {
2193 global highlight_related
2196 if {$highlight_related ne "None"} {
2201 # prepare for testing whether commits are descendents or ancestors of a
2202 proc rhighlight_sel {a} {
2203 global descendent desc_todo ancestor anc_todo
2204 global highlight_related rhighlights
2206 catch {unset descendent}
2207 set desc_todo [list $a]
2208 catch {unset ancestor}
2209 set anc_todo [list $a]
2210 if {$highlight_related ne "None"} {
2216 proc rhighlight_none {} {
2219 catch {unset rhighlights}
2223 proc is_descendent {a} {
2224 global curview children commitrow descendent desc_todo
2227 set la $commitrow($v,$a)
2231 for {set i 0} {$i < [llength $todo]} {incr i} {
2232 set do [lindex $todo $i]
2233 if {$commitrow($v,$do) < $la} {
2234 lappend leftover $do
2237 foreach nk $children($v,$do) {
2238 if {![info exists descendent($nk)]} {
2239 set descendent($nk) 1
2247 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2251 set descendent($a) 0
2252 set desc_todo $leftover
2255 proc is_ancestor {a} {
2256 global curview parentlist commitrow ancestor anc_todo
2259 set la $commitrow($v,$a)
2263 for {set i 0} {$i < [llength $todo]} {incr i} {
2264 set do [lindex $todo $i]
2265 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2266 lappend leftover $do
2269 foreach np [lindex $parentlist $commitrow($v,$do)] {
2270 if {![info exists ancestor($np)]} {
2279 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2284 set anc_todo $leftover
2287 proc askrelhighlight {row id} {
2288 global descendent highlight_related iddrawn mainfont rhighlights
2289 global selectedline ancestor
2291 if {![info exists selectedline]} return
2293 if {$highlight_related eq "Descendent" ||
2294 $highlight_related eq "Not descendent"} {
2295 if {![info exists descendent($id)]} {
2298 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2301 } elseif {$highlight_related eq "Ancestor" ||
2302 $highlight_related eq "Not ancestor"} {
2303 if {![info exists ancestor($id)]} {
2306 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2310 if {[info exists iddrawn($id)]} {
2311 if {$isbold && ![ishighlighted $row]} {
2312 bolden $row [concat $mainfont bold]
2315 set rhighlights($row) $isbold
2318 proc next_hlcont {} {
2319 global fhl_row fhl_dirn displayorder numcommits
2320 global vhighlights fhighlights nhighlights rhighlights
2321 global hlview filehighlight findstring highlight_related
2323 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2326 if {$row < 0 || $row >= $numcommits} {
2331 set id [lindex $displayorder $row]
2332 if {[info exists hlview]} {
2333 if {![info exists vhighlights($row)]} {
2334 askvhighlight $row $id
2336 if {$vhighlights($row) > 0} break
2338 if {$findstring ne {}} {
2339 if {![info exists nhighlights($row)]} {
2340 askfindhighlight $row $id
2342 if {$nhighlights($row) > 0} break
2344 if {$highlight_related ne "None"} {
2345 if {![info exists rhighlights($row)]} {
2346 askrelhighlight $row $id
2348 if {$rhighlights($row) > 0} break
2350 if {[info exists filehighlight]} {
2351 if {![info exists fhighlights($row)]} {
2352 # ask for a few more while we're at it...
2354 for {set n 0} {$n < 100} {incr n} {
2355 if {![info exists fhighlights($r)]} {
2356 askfilehighlight $r [lindex $displayorder $r]
2359 if {$r < 0 || $r >= $numcommits} break
2363 if {$fhighlights($row) < 0} {
2367 if {$fhighlights($row) > 0} break
2375 proc next_highlight {dirn} {
2376 global selectedline fhl_row fhl_dirn
2377 global hlview filehighlight findstring highlight_related
2379 if {![info exists selectedline]} return
2380 if {!([info exists hlview] || $findstring ne {} ||
2381 $highlight_related ne "None" || [info exists filehighlight])} return
2382 set fhl_row [expr {$selectedline + $dirn}]
2387 proc cancel_next_highlight {} {
2393 # Graph layout functions
2395 proc shortids {ids} {
2398 if {[llength $id] > 1} {
2399 lappend res [shortids $id]
2400 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2401 lappend res [string range $id 0 7]
2409 proc incrange {l x o} {
2412 set e [lindex $l $x]
2414 lset l $x [expr {$e + $o}]
2423 for {} {$n > 0} {incr n -1} {
2429 proc usedinrange {id l1 l2} {
2430 global children commitrow curview
2432 if {[info exists commitrow($curview,$id)]} {
2433 set r $commitrow($curview,$id)
2434 if {$l1 <= $r && $r <= $l2} {
2435 return [expr {$r - $l1 + 1}]
2438 set kids $children($curview,$id)
2440 set r $commitrow($curview,$c)
2441 if {$l1 <= $r && $r <= $l2} {
2442 return [expr {$r - $l1 + 1}]
2448 proc sanity {row {full 0}} {
2449 global rowidlist rowoffsets
2452 set ids [lindex $rowidlist $row]
2455 if {$id eq {}} continue
2456 if {$col < [llength $ids] - 1 &&
2457 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2458 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2460 set o [lindex $rowoffsets $row $col]
2466 if {[lindex $rowidlist $y $x] != $id} {
2467 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2468 puts " id=[shortids $id] check started at row $row"
2469 for {set i $row} {$i >= $y} {incr i -1} {
2470 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2475 set o [lindex $rowoffsets $y $x]
2480 proc makeuparrow {oid x y z} {
2481 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2483 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2486 set off0 [lindex $rowoffsets $y]
2487 for {set x0 $x} {1} {incr x0} {
2488 if {$x0 >= [llength $off0]} {
2489 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2492 set z [lindex $off0 $x0]
2498 set z [expr {$x0 - $x}]
2499 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2500 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2502 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2503 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2504 lappend idrowranges($oid) [lindex $displayorder $y]
2507 proc initlayout {} {
2508 global rowidlist rowoffsets displayorder commitlisted
2509 global rowlaidout rowoptim
2510 global idinlist rowchk rowrangelist idrowranges
2511 global numcommits canvxmax canv
2514 global colormap rowtextx
2525 catch {unset idinlist}
2526 catch {unset rowchk}
2529 set canvxmax [$canv cget -width]
2530 catch {unset colormap}
2531 catch {unset rowtextx}
2532 catch {unset idrowranges}
2536 proc setcanvscroll {} {
2537 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2539 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2540 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2541 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2542 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2545 proc visiblerows {} {
2546 global canv numcommits linespc
2548 set ymax [lindex [$canv cget -scrollregion] 3]
2549 if {$ymax eq {} || $ymax == 0} return
2551 set y0 [expr {int([lindex $f 0] * $ymax)}]
2552 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2556 set y1 [expr {int([lindex $f 1] * $ymax)}]
2557 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2558 if {$r1 >= $numcommits} {
2559 set r1 [expr {$numcommits - 1}]
2561 return [list $r0 $r1]
2564 proc layoutmore {tmax allread} {
2565 global rowlaidout rowoptim commitidx numcommits optim_delay
2566 global uparrowlen curview rowidlist idinlist
2569 set showdelay $optim_delay
2570 set optdelay [expr {$uparrowlen + 1}]
2572 if {$rowoptim - $showdelay > $numcommits} {
2573 showstuff [expr {$rowoptim - $showdelay}] $showlast
2574 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2575 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2579 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2581 } elseif {$commitidx($curview) > $rowlaidout} {
2582 set nr [expr {$commitidx($curview) - $rowlaidout}]
2583 # may need to increase this threshold if uparrowlen or
2584 # mingaplen are increased...
2589 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2590 if {$rowlaidout == $row} {
2593 } elseif {$allread} {
2595 set nrows $commitidx($curview)
2596 if {[lindex $rowidlist $nrows] ne {} ||
2597 [array names idinlist] ne {}} {
2599 set rowlaidout $commitidx($curview)
2600 } elseif {$rowoptim == $nrows} {
2603 if {$numcommits == $nrows} {
2610 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2616 proc showstuff {canshow last} {
2617 global numcommits commitrow pending_select selectedline curview
2618 global lookingforhead mainheadid displayorder nullid selectfirst
2619 global lastscrollset
2621 if {$numcommits == 0} {
2623 set phase "incrdraw"
2627 set prev $numcommits
2628 set numcommits $canshow
2629 set t [clock clicks -milliseconds]
2630 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2631 set lastscrollset $t
2634 set rows [visiblerows]
2635 set r1 [lindex $rows 1]
2636 if {$r1 >= $canshow} {
2637 set r1 [expr {$canshow - 1}]
2642 if {[info exists pending_select] &&
2643 [info exists commitrow($curview,$pending_select)] &&
2644 $commitrow($curview,$pending_select) < $numcommits} {
2645 selectline $commitrow($curview,$pending_select) 1
2648 if {[info exists selectedline] || [info exists pending_select]} {
2651 set l [expr {[lindex $displayorder 0] eq $nullid}]
2656 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2657 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2658 set lookingforhead 0
2663 proc doshowlocalchanges {} {
2664 global lookingforhead curview mainheadid phase commitrow
2666 if {[info exists commitrow($curview,$mainheadid)] &&
2667 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2669 } elseif {$phase ne {}} {
2670 set lookingforhead 1
2674 proc dohidelocalchanges {} {
2675 global lookingforhead localrow lserial
2677 set lookingforhead 0
2678 if {$localrow >= 0} {
2685 # spawn off a process to do git diff-index HEAD
2686 proc dodiffindex {} {
2687 global localrow lserial
2691 set fd [open "|git diff-index HEAD" r]
2692 fconfigure $fd -blocking 0
2693 filerun $fd [list readdiffindex $fd $lserial]
2696 proc readdiffindex {fd serial} {
2697 global localrow commitrow mainheadid nullid curview
2698 global commitinfo commitdata lserial
2700 if {[gets $fd line] < 0} {
2707 # we only need to see one line and we don't really care what it says...
2710 if {$serial == $lserial && $localrow == -1} {
2711 # add the line for the local diff to the graph
2712 set localrow $commitrow($curview,$mainheadid)
2713 set hl "Local uncommitted changes"
2714 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2715 set commitdata($nullid) "\n $hl\n"
2716 insertrow $localrow $nullid
2721 proc layoutrows {row endrow last} {
2722 global rowidlist rowoffsets displayorder
2723 global uparrowlen downarrowlen maxwidth mingaplen
2724 global children parentlist
2726 global commitidx curview
2727 global idinlist rowchk rowrangelist
2729 set idlist [lindex $rowidlist $row]
2730 set offs [lindex $rowoffsets $row]
2731 while {$row < $endrow} {
2732 set id [lindex $displayorder $row]
2735 foreach p [lindex $parentlist $row] {
2736 if {![info exists idinlist($p)]} {
2738 } elseif {!$idinlist($p)} {
2742 set nev [expr {[llength $idlist] + [llength $newolds]
2743 + [llength $oldolds] - $maxwidth + 1}]
2746 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2747 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2748 set i [lindex $idlist $x]
2749 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2750 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2751 [expr {$row + $uparrowlen + $mingaplen}]]
2753 set idlist [lreplace $idlist $x $x]
2754 set offs [lreplace $offs $x $x]
2755 set offs [incrange $offs $x 1]
2757 set rm1 [expr {$row - 1}]
2758 lappend idrowranges($i) [lindex $displayorder $rm1]
2759 if {[incr nev -1] <= 0} break
2762 set rowchk($id) [expr {$row + $r}]
2765 lset rowidlist $row $idlist
2766 lset rowoffsets $row $offs
2768 set col [lsearch -exact $idlist $id]
2770 set col [llength $idlist]
2772 lset rowidlist $row $idlist
2774 if {$children($curview,$id) ne {}} {
2775 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2779 lset rowoffsets $row $offs
2781 makeuparrow $id $col $row $z
2787 if {[info exists idrowranges($id)]} {
2788 set ranges $idrowranges($id)
2790 unset idrowranges($id)
2792 lappend rowrangelist $ranges
2794 set offs [ntimes [llength $idlist] 0]
2795 set l [llength $newolds]
2796 set idlist [eval lreplace \$idlist $col $col $newolds]
2799 set offs [lrange $offs 0 [expr {$col - 1}]]
2800 foreach x $newolds {
2805 set tmp [expr {[llength $idlist] - [llength $offs]}]
2807 set offs [concat $offs [ntimes $tmp $o]]
2812 foreach i $newolds {
2814 set idrowranges($i) $id
2817 foreach oid $oldolds {
2818 set idinlist($oid) 1
2819 set idlist [linsert $idlist $col $oid]
2820 set offs [linsert $offs $col $o]
2821 makeuparrow $oid $col $row $o
2824 lappend rowidlist $idlist
2825 lappend rowoffsets $offs
2830 proc addextraid {id row} {
2831 global displayorder commitrow commitinfo
2832 global commitidx commitlisted
2833 global parentlist children curview
2835 incr commitidx($curview)
2836 lappend displayorder $id
2837 lappend commitlisted 0
2838 lappend parentlist {}
2839 set commitrow($curview,$id) $row
2841 if {![info exists commitinfo($id)]} {
2842 set commitinfo($id) {"No commit information available"}
2844 if {![info exists children($curview,$id)]} {
2845 set children($curview,$id) {}
2849 proc layouttail {} {
2850 global rowidlist rowoffsets idinlist commitidx curview
2851 global idrowranges rowrangelist
2853 set row $commitidx($curview)
2854 set idlist [lindex $rowidlist $row]
2855 while {$idlist ne {}} {
2856 set col [expr {[llength $idlist] - 1}]
2857 set id [lindex $idlist $col]
2860 lappend idrowranges($id) $row
2861 lappend rowrangelist $idrowranges($id)
2862 unset idrowranges($id)
2864 set offs [ntimes $col 0]
2865 set idlist [lreplace $idlist $col $col]
2866 lappend rowidlist $idlist
2867 lappend rowoffsets $offs
2870 foreach id [array names idinlist] {
2873 lset rowidlist $row [list $id]
2874 lset rowoffsets $row 0
2875 makeuparrow $id 0 $row 0
2876 lappend idrowranges($id) $row
2877 lappend rowrangelist $idrowranges($id)
2878 unset idrowranges($id)
2880 lappend rowidlist {}
2881 lappend rowoffsets {}
2885 proc insert_pad {row col npad} {
2886 global rowidlist rowoffsets
2888 set pad [ntimes $npad {}]
2889 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2890 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2891 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2894 proc optimize_rows {row col endrow} {
2895 global rowidlist rowoffsets displayorder
2897 for {} {$row < $endrow} {incr row} {
2898 set idlist [lindex $rowidlist $row]
2899 set offs [lindex $rowoffsets $row]
2901 for {} {$col < [llength $offs]} {incr col} {
2902 if {[lindex $idlist $col] eq {}} {
2906 set z [lindex $offs $col]
2907 if {$z eq {}} continue
2909 set x0 [expr {$col + $z}]
2910 set y0 [expr {$row - 1}]
2911 set z0 [lindex $rowoffsets $y0 $x0]
2913 set id [lindex $idlist $col]
2914 set ranges [rowranges $id]
2915 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2919 # Looking at lines from this row to the previous row,
2920 # make them go straight up if they end in an arrow on
2921 # the previous row; otherwise make them go straight up
2923 if {$z < -1 || ($z < 0 && $isarrow)} {
2924 # Line currently goes left too much;
2925 # insert pads in the previous row, then optimize it
2926 set npad [expr {-1 - $z + $isarrow}]
2927 set offs [incrange $offs $col $npad]
2928 insert_pad $y0 $x0 $npad
2930 optimize_rows $y0 $x0 $row
2932 set z [lindex $offs $col]
2933 set x0 [expr {$col + $z}]
2934 set z0 [lindex $rowoffsets $y0 $x0]
2935 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2936 # Line currently goes right too much;
2937 # insert pads in this line and adjust the next's rowoffsets
2938 set npad [expr {$z - 1 + $isarrow}]
2939 set y1 [expr {$row + 1}]
2940 set offs2 [lindex $rowoffsets $y1]
2944 if {$z eq {} || $x1 + $z < $col} continue
2945 if {$x1 + $z > $col} {
2948 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2951 set pad [ntimes $npad {}]
2952 set idlist [eval linsert \$idlist $col $pad]
2953 set tmp [eval linsert \$offs $col $pad]
2955 set offs [incrange $tmp $col [expr {-$npad}]]
2956 set z [lindex $offs $col]
2959 if {$z0 eq {} && !$isarrow} {
2960 # this line links to its first child on row $row-2
2961 set rm2 [expr {$row - 2}]
2962 set id [lindex $displayorder $rm2]
2963 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2965 set z0 [expr {$xc - $x0}]
2968 # avoid lines jigging left then immediately right
2969 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2970 insert_pad $y0 $x0 1
2971 set offs [incrange $offs $col 1]
2972 optimize_rows $y0 [expr {$x0 + 1}] $row
2977 # Find the first column that doesn't have a line going right
2978 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2979 set o [lindex $offs $col]
2981 # check if this is the link to the first child
2982 set id [lindex $idlist $col]
2983 set ranges [rowranges $id]
2984 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2985 # it is, work out offset to child
2986 set y0 [expr {$row - 1}]
2987 set id [lindex $displayorder $y0]
2988 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2990 set o [expr {$x0 - $col}]
2994 if {$o eq {} || $o <= 0} break
2996 # Insert a pad at that column as long as it has a line and
2997 # isn't the last column, and adjust the next row' offsets
2998 if {$o ne {} && [incr col] < [llength $idlist]} {
2999 set y1 [expr {$row + 1}]
3000 set offs2 [lindex $rowoffsets $y1]
3004 if {$z eq {} || $x1 + $z < $col} continue
3005 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3008 set idlist [linsert $idlist $col {}]
3009 set tmp [linsert $offs $col {}]
3011 set offs [incrange $tmp $col -1]
3014 lset rowidlist $row $idlist
3015 lset rowoffsets $row $offs
3021 global canvx0 linespc
3022 return [expr {$canvx0 + $col * $linespc}]
3026 global canvy0 linespc
3027 return [expr {$canvy0 + $row * $linespc}]
3030 proc linewidth {id} {
3031 global thickerline lthickness
3034 if {[info exists thickerline] && $id eq $thickerline} {
3035 set wid [expr {2 * $lthickness}]
3040 proc rowranges {id} {
3041 global phase idrowranges commitrow rowlaidout rowrangelist curview
3045 ([info exists commitrow($curview,$id)]
3046 && $commitrow($curview,$id) < $rowlaidout)} {
3047 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3048 } elseif {[info exists idrowranges($id)]} {
3049 set ranges $idrowranges($id)
3052 foreach rid $ranges {
3053 lappend linenos $commitrow($curview,$rid)
3055 if {$linenos ne {}} {
3056 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3061 # work around tk8.4 refusal to draw arrows on diagonal segments
3062 proc adjarrowhigh {coords} {
3065 set x0 [lindex $coords 0]
3066 set x1 [lindex $coords 2]
3068 set y0 [lindex $coords 1]
3069 set y1 [lindex $coords 3]
3070 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3071 # we have a nearby vertical segment, just trim off the diag bit
3072 set coords [lrange $coords 2 end]
3074 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3075 set xi [expr {$x0 - $slope * $linespc / 2}]
3076 set yi [expr {$y0 - $linespc / 2}]
3077 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3083 proc drawlineseg {id row endrow arrowlow} {
3084 global rowidlist displayorder iddrawn linesegs
3085 global canv colormap linespc curview maxlinelen
3087 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3088 set le [expr {$row + 1}]
3091 set c [lsearch -exact [lindex $rowidlist $le] $id]
3097 set x [lindex $displayorder $le]
3102 if {[info exists iddrawn($x)] || $le == $endrow} {
3103 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3119 if {[info exists linesegs($id)]} {
3120 set lines $linesegs($id)
3122 set r0 [lindex $li 0]
3124 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3134 set li [lindex $lines [expr {$i-1}]]
3135 set r1 [lindex $li 1]
3136 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3141 set x [lindex $cols [expr {$le - $row}]]
3142 set xp [lindex $cols [expr {$le - 1 - $row}]]
3143 set dir [expr {$xp - $x}]
3145 set ith [lindex $lines $i 2]
3146 set coords [$canv coords $ith]
3147 set ah [$canv itemcget $ith -arrow]
3148 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3149 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3150 if {$x2 ne {} && $x - $x2 == $dir} {
3151 set coords [lrange $coords 0 end-2]
3154 set coords [list [xc $le $x] [yc $le]]
3157 set itl [lindex $lines [expr {$i-1}] 2]
3158 set al [$canv itemcget $itl -arrow]
3159 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3160 } elseif {$arrowlow &&
3161 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3164 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3165 for {set y $le} {[incr y -1] > $row} {} {
3167 set xp [lindex $cols [expr {$y - 1 - $row}]]
3168 set ndir [expr {$xp - $x}]
3169 if {$dir != $ndir || $xp < 0} {
3170 lappend coords [xc $y $x] [yc $y]
3176 # join parent line to first child
3177 set ch [lindex $displayorder $row]
3178 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3180 puts "oops: drawlineseg: child $ch not on row $row"
3183 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3184 } elseif {$xc > $x + 1} {
3185 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3189 lappend coords [xc $row $x] [yc $row]
3191 set xn [xc $row $xp]
3193 # work around tk8.4 refusal to draw arrows on diagonal segments
3194 if {$arrowlow && $xn != [lindex $coords end-1]} {
3195 if {[llength $coords] < 4 ||
3196 [lindex $coords end-3] != [lindex $coords end-1] ||
3197 [lindex $coords end] - $yn > 2 * $linespc} {
3198 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3199 set yo [yc [expr {$row + 0.5}]]
3200 lappend coords $xn $yo $xn $yn
3203 lappend coords $xn $yn
3208 set coords [adjarrowhigh $coords]
3211 set t [$canv create line $coords -width [linewidth $id] \
3212 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3215 set lines [linsert $lines $i [list $row $le $t]]
3217 $canv coords $ith $coords
3218 if {$arrow ne $ah} {
3219 $canv itemconf $ith -arrow $arrow
3221 lset lines $i 0 $row
3224 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3225 set ndir [expr {$xo - $xp}]
3226 set clow [$canv coords $itl]
3227 if {$dir == $ndir} {
3228 set clow [lrange $clow 2 end]
3230 set coords [concat $coords $clow]
3232 lset lines [expr {$i-1}] 1 $le
3234 set coords [adjarrowhigh $coords]
3237 # coalesce two pieces
3239 set b [lindex $lines [expr {$i-1}] 0]
3240 set e [lindex $lines $i 1]
3241 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3243 $canv coords $itl $coords
3244 if {$arrow ne $al} {
3245 $canv itemconf $itl -arrow $arrow
3249 set linesegs($id) $lines
3253 proc drawparentlinks {id row} {
3254 global rowidlist canv colormap curview parentlist
3257 set rowids [lindex $rowidlist $row]
3258 set col [lsearch -exact $rowids $id]
3259 if {$col < 0} return
3260 set olds [lindex $parentlist $row]
3261 set row2 [expr {$row + 1}]
3262 set x [xc $row $col]
3265 set ids [lindex $rowidlist $row2]
3266 # rmx = right-most X coord used
3269 set i [lsearch -exact $ids $p]
3271 puts "oops, parent $p of $id not in list"
3274 set x2 [xc $row2 $i]
3278 if {[lsearch -exact $rowids $p] < 0} {
3279 # drawlineseg will do this one for us
3283 # should handle duplicated parents here...
3284 set coords [list $x $y]
3285 if {$i < $col - 1} {
3286 lappend coords [xc $row [expr {$i + 1}]] $y
3287 } elseif {$i > $col + 1} {
3288 lappend coords [xc $row [expr {$i - 1}]] $y
3290 lappend coords $x2 $y2
3291 set t [$canv create line $coords -width [linewidth $p] \
3292 -fill $colormap($p) -tags lines.$p]
3296 if {$rmx > [lindex $idpos($id) 1]} {
3297 lset idpos($id) 1 $rmx
3302 proc drawlines {id} {
3305 $canv itemconf lines.$id -width [linewidth $id]
3308 proc drawcmittext {id row col} {
3309 global linespc canv canv2 canv3 canvy0 fgcolor
3310 global commitlisted commitinfo rowidlist parentlist
3311 global rowtextx idpos idtags idheads idotherrefs
3312 global linehtag linentag linedtag
3313 global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3315 if {$id eq $nullid} {
3318 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3320 set x [xc $row $col]
3322 set orad [expr {$linespc / 3}]
3323 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3324 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3325 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3327 $canv bind $t <1> {selcanvline {} %x %y}
3328 set rmx [llength [lindex $rowidlist $row]]
3329 set olds [lindex $parentlist $row]
3331 set nextids [lindex $rowidlist [expr {$row + 1}]]
3333 set i [lsearch -exact $nextids $p]
3339 set xt [xc $row $rmx]
3340 set rowtextx($row) $xt
3341 set idpos($id) [list $x $xt $y]
3342 if {[info exists idtags($id)] || [info exists idheads($id)]
3343 || [info exists idotherrefs($id)]} {
3344 set xt [drawtags $id $x $xt $y]
3346 set headline [lindex $commitinfo($id) 0]
3347 set name [lindex $commitinfo($id) 1]
3348 set date [lindex $commitinfo($id) 2]
3349 set date [formatdate $date]
3352 set isbold [ishighlighted $row]
3354 lappend boldrows $row
3357 lappend boldnamerows $row
3361 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3362 -text $headline -font $font -tags text]
3363 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3364 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3365 -text $name -font $nfont -tags text]
3366 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3367 -text $date -font $mainfont -tags text]
3368 set xr [expr {$xt + [font measure $mainfont $headline]}]
3369 if {$xr > $canvxmax} {
3375 proc drawcmitrow {row} {
3376 global displayorder rowidlist
3378 global commitinfo parentlist numcommits
3379 global filehighlight fhighlights findstring nhighlights
3380 global hlview vhighlights
3381 global highlight_related rhighlights
3383 if {$row >= $numcommits} return
3385 set id [lindex $displayorder $row]
3386 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3387 askvhighlight $row $id
3389 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3390 askfilehighlight $row $id
3392 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3393 askfindhighlight $row $id
3395 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3396 askrelhighlight $row $id
3398 if {[info exists iddrawn($id)]} return
3399 set col [lsearch -exact [lindex $rowidlist $row] $id]
3401 puts "oops, row $row id $id not in list"
3404 if {![info exists commitinfo($id)]} {
3408 drawcmittext $id $row $col
3412 proc drawcommits {row {endrow {}}} {
3413 global numcommits iddrawn displayorder curview
3414 global parentlist rowidlist
3419 if {$endrow eq {}} {
3422 if {$endrow >= $numcommits} {
3423 set endrow [expr {$numcommits - 1}]
3426 # make the lines join to already-drawn rows either side
3427 set r [expr {$row - 1}]
3428 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3431 set er [expr {$endrow + 1}]
3432 if {$er >= $numcommits ||
3433 ![info exists iddrawn([lindex $displayorder $er])]} {
3436 for {} {$r <= $er} {incr r} {
3437 set id [lindex $displayorder $r]
3438 set wasdrawn [info exists iddrawn($id)]
3442 if {$r == $er} break
3443 set nextid [lindex $displayorder [expr {$r + 1}]]
3444 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3445 catch {unset prevlines}
3448 drawparentlinks $id $r
3450 if {[info exists lineends($r)]} {
3451 foreach lid $lineends($r) {
3452 unset prevlines($lid)
3455 set rowids [lindex $rowidlist $r]
3456 foreach lid $rowids {
3457 if {$lid eq {}} continue
3459 # see if this is the first child of any of its parents
3460 foreach p [lindex $parentlist $r] {
3461 if {[lsearch -exact $rowids $p] < 0} {
3462 # make this line extend up to the child
3463 set le [drawlineseg $p $r $er 0]
3464 lappend lineends($le) $p
3468 } elseif {![info exists prevlines($lid)]} {
3469 set le [drawlineseg $lid $r $er 1]
3470 lappend lineends($le) $lid
3471 set prevlines($lid) 1
3477 proc drawfrac {f0 f1} {
3480 set ymax [lindex [$canv cget -scrollregion] 3]
3481 if {$ymax eq {} || $ymax == 0} return
3482 set y0 [expr {int($f0 * $ymax)}]
3483 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3484 set y1 [expr {int($f1 * $ymax)}]
3485 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3486 drawcommits $row $endrow
3489 proc drawvisible {} {
3491 eval drawfrac [$canv yview]
3494 proc clear_display {} {
3495 global iddrawn linesegs
3496 global vhighlights fhighlights nhighlights rhighlights
3499 catch {unset iddrawn}
3500 catch {unset linesegs}
3501 catch {unset vhighlights}
3502 catch {unset fhighlights}
3503 catch {unset nhighlights}
3504 catch {unset rhighlights}
3507 proc findcrossings {id} {
3508 global rowidlist parentlist numcommits rowoffsets displayorder
3512 foreach {s e} [rowranges $id] {
3513 if {$e >= $numcommits} {
3514 set e [expr {$numcommits - 1}]
3516 if {$e <= $s} continue
3517 set x [lsearch -exact [lindex $rowidlist $e] $id]
3519 puts "findcrossings: oops, no [shortids $id] in row $e"
3522 for {set row $e} {[incr row -1] >= $s} {} {
3523 set olds [lindex $parentlist $row]
3524 set kid [lindex $displayorder $row]
3525 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3526 if {$kidx < 0} continue
3527 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3529 set px [lsearch -exact $nextrow $p]
3530 if {$px < 0} continue
3531 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3532 if {[lsearch -exact $ccross $p] >= 0} continue
3533 if {$x == $px + ($kidx < $px? -1: 1)} {
3535 } elseif {[lsearch -exact $cross $p] < 0} {
3540 set inc [lindex $rowoffsets $row $x]
3541 if {$inc eq {}} break
3545 return [concat $ccross {{}} $cross]
3548 proc assigncolor {id} {
3549 global colormap colors nextcolor
3550 global commitrow parentlist children children curview
3552 if {[info exists colormap($id)]} return
3553 set ncolors [llength $colors]
3554 if {[info exists children($curview,$id)]} {
3555 set kids $children($curview,$id)
3559 if {[llength $kids] == 1} {
3560 set child [lindex $kids 0]
3561 if {[info exists colormap($child)]
3562 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3563 set colormap($id) $colormap($child)
3569 foreach x [findcrossings $id] {
3571 # delimiter between corner crossings and other crossings
3572 if {[llength $badcolors] >= $ncolors - 1} break
3573 set origbad $badcolors
3575 if {[info exists colormap($x)]
3576 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3577 lappend badcolors $colormap($x)
3580 if {[llength $badcolors] >= $ncolors} {
3581 set badcolors $origbad
3583 set origbad $badcolors
3584 if {[llength $badcolors] < $ncolors - 1} {
3585 foreach child $kids {
3586 if {[info exists colormap($child)]
3587 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3588 lappend badcolors $colormap($child)
3590 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3591 if {[info exists colormap($p)]
3592 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3593 lappend badcolors $colormap($p)
3597 if {[llength $badcolors] >= $ncolors} {
3598 set badcolors $origbad
3601 for {set i 0} {$i <= $ncolors} {incr i} {
3602 set c [lindex $colors $nextcolor]
3603 if {[incr nextcolor] >= $ncolors} {
3606 if {[lsearch -exact $badcolors $c]} break
3608 set colormap($id) $c
3611 proc bindline {t id} {
3614 $canv bind $t <Enter> "lineenter %x %y $id"
3615 $canv bind $t <Motion> "linemotion %x %y $id"
3616 $canv bind $t <Leave> "lineleave $id"
3617 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3620 proc drawtags {id x xt y1} {
3621 global idtags idheads idotherrefs mainhead
3622 global linespc lthickness
3623 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3628 if {[info exists idtags($id)]} {
3629 set marks $idtags($id)
3630 set ntags [llength $marks]
3632 if {[info exists idheads($id)]} {
3633 set marks [concat $marks $idheads($id)]
3634 set nheads [llength $idheads($id)]
3636 if {[info exists idotherrefs($id)]} {
3637 set marks [concat $marks $idotherrefs($id)]
3643 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3644 set yt [expr {$y1 - 0.5 * $linespc}]
3645 set yb [expr {$yt + $linespc - 1}]
3649 foreach tag $marks {
3651 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3652 set wid [font measure [concat $mainfont bold] $tag]
3654 set wid [font measure $mainfont $tag]
3658 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3660 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3661 -width $lthickness -fill black -tags tag.$id]
3663 foreach tag $marks x $xvals wid $wvals {
3664 set xl [expr {$x + $delta}]
3665 set xr [expr {$x + $delta + $wid + $lthickness}]
3667 if {[incr ntags -1] >= 0} {
3669 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3670 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3671 -width 1 -outline black -fill yellow -tags tag.$id]
3672 $canv bind $t <1> [list showtag $tag 1]
3673 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3675 # draw a head or other ref
3676 if {[incr nheads -1] >= 0} {
3678 if {$tag eq $mainhead} {
3684 set xl [expr {$xl - $delta/2}]
3685 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3686 -width 1 -outline black -fill $col -tags tag.$id
3687 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3688 set rwid [font measure $mainfont $remoteprefix]
3689 set xi [expr {$x + 1}]
3690 set yti [expr {$yt + 1}]
3691 set xri [expr {$x + $rwid}]
3692 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3693 -width 0 -fill "#ffddaa" -tags tag.$id
3696 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3697 -font $font -tags [list tag.$id text]]
3699 $canv bind $t <1> [list showtag $tag 1]
3700 } elseif {$nheads >= 0} {
3701 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3707 proc xcoord {i level ln} {
3708 global canvx0 xspc1 xspc2
3710 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3711 if {$i > 0 && $i == $level} {
3712 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3713 } elseif {$i > $level} {
3714 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3719 proc show_status {msg} {
3720 global canv mainfont fgcolor
3723 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3724 -tags text -fill $fgcolor
3727 # Insert a new commit as the child of the commit on row $row.
3728 # The new commit will be displayed on row $row and the commits
3729 # on that row and below will move down one row.
3730 proc insertrow {row newcmit} {
3731 global displayorder parentlist commitlisted children
3732 global commitrow curview rowidlist rowoffsets numcommits
3733 global rowrangelist rowlaidout rowoptim numcommits
3734 global selectedline rowchk commitidx
3736 if {$row >= $numcommits} {
3737 puts "oops, inserting new row $row but only have $numcommits rows"
3740 set p [lindex $displayorder $row]
3741 set displayorder [linsert $displayorder $row $newcmit]
3742 set parentlist [linsert $parentlist $row $p]
3743 set kids $children($curview,$p)
3744 lappend kids $newcmit
3745 set children($curview,$p) $kids
3746 set children($curview,$newcmit) {}
3747 set commitlisted [linsert $commitlisted $row 1]
3748 set l [llength $displayorder]
3749 for {set r $row} {$r < $l} {incr r} {
3750 set id [lindex $displayorder $r]
3751 set commitrow($curview,$id) $r
3753 incr commitidx($curview)
3755 set idlist [lindex $rowidlist $row]
3756 set offs [lindex $rowoffsets $row]
3759 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3765 if {[llength $kids] == 1} {
3766 set col [lsearch -exact $idlist $p]
3767 lset idlist $col $newcmit
3769 set col [llength $idlist]
3770 lappend idlist $newcmit
3772 lset rowoffsets $row $offs
3774 set rowidlist [linsert $rowidlist $row $idlist]
3775 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3777 set rowrangelist [linsert $rowrangelist $row {}]
3778 if {[llength $kids] > 1} {
3779 set rp1 [expr {$row + 1}]
3780 set ranges [lindex $rowrangelist $rp1]
3781 if {$ranges eq {}} {
3782 set ranges [list $newcmit $p]
3783 } elseif {[lindex $ranges end-1] eq $p} {
3784 lset ranges end-1 $newcmit
3786 lset rowrangelist $rp1 $ranges
3789 catch {unset rowchk}
3795 if {[info exists selectedline] && $selectedline >= $row} {
3801 # Remove a commit that was inserted with insertrow on row $row.
3802 proc removerow {row} {
3803 global displayorder parentlist commitlisted children
3804 global commitrow curview rowidlist rowoffsets numcommits
3805 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3806 global linesegends selectedline rowchk commitidx
3808 if {$row >= $numcommits} {
3809 puts "oops, removing row $row but only have $numcommits rows"
3812 set rp1 [expr {$row + 1}]
3813 set id [lindex $displayorder $row]
3814 set p [lindex $parentlist $row]
3815 set displayorder [lreplace $displayorder $row $row]
3816 set parentlist [lreplace $parentlist $row $row]
3817 set commitlisted [lreplace $commitlisted $row $row]
3818 set kids $children($curview,$p)
3819 set i [lsearch -exact $kids $id]
3821 set kids [lreplace $kids $i $i]
3822 set children($curview,$p) $kids
3824 set l [llength $displayorder]
3825 for {set r $row} {$r < $l} {incr r} {
3826 set id [lindex $displayorder $r]
3827 set commitrow($curview,$id) $r
3829 incr commitidx($curview) -1
3831 set rowidlist [lreplace $rowidlist $row $row]
3832 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3834 set offs [lindex $rowoffsets $row]
3835 set offs [lreplace $offs end end]
3836 lset rowoffsets $row $offs
3839 set rowrangelist [lreplace $rowrangelist $row $row]
3840 if {[llength $kids] > 0} {
3841 set ranges [lindex $rowrangelist $row]
3842 if {[lindex $ranges end-1] eq $id} {
3843 set ranges [lreplace $ranges end-1 end]
3844 lset rowrangelist $row $ranges
3848 catch {unset rowchk}
3854 if {[info exists selectedline] && $selectedline > $row} {
3855 incr selectedline -1
3860 # Don't change the text pane cursor if it is currently the hand cursor,
3861 # showing that we are over a sha1 ID link.
3862 proc settextcursor {c} {
3863 global ctext curtextcursor
3865 if {[$ctext cget -cursor] == $curtextcursor} {
3866 $ctext config -cursor $c
3868 set curtextcursor $c
3871 proc nowbusy {what} {
3874 if {[array names isbusy] eq {}} {
3875 . config -cursor watch
3881 proc notbusy {what} {
3882 global isbusy maincursor textcursor
3884 catch {unset isbusy($what)}
3885 if {[array names isbusy] eq {}} {
3886 . config -cursor $maincursor
3887 settextcursor $textcursor
3891 proc findmatches {f} {
3892 global findtype foundstring foundstrlen
3893 if {$findtype == "Regexp"} {
3894 set matches [regexp -indices -all -inline $foundstring $f]
3896 if {$findtype == "IgnCase"} {
3897 set str [string tolower $f]
3903 while {[set j [string first $foundstring $str $i]] >= 0} {
3904 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3905 set i [expr {$j + $foundstrlen}]
3912 global findtype findloc findstring markedmatches commitinfo
3913 global numcommits displayorder linehtag linentag linedtag
3914 global mainfont canv canv2 canv3 selectedline
3915 global matchinglines foundstring foundstrlen matchstring
3920 cancel_next_highlight
3922 set matchinglines {}
3923 if {$findtype == "IgnCase"} {
3924 set foundstring [string tolower $findstring]
3926 set foundstring $findstring
3928 set foundstrlen [string length $findstring]
3929 if {$foundstrlen == 0} return
3930 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3931 set matchstring "*$matchstring*"
3932 if {![info exists selectedline]} {
3935 set oldsel $selectedline
3938 set fldtypes {Headline Author Date Committer CDate Comments}
3940 foreach id $displayorder {
3941 set d $commitdata($id)
3943 if {$findtype == "Regexp"} {
3944 set doesmatch [regexp $foundstring $d]
3945 } elseif {$findtype == "IgnCase"} {
3946 set doesmatch [string match -nocase $matchstring $d]
3948 set doesmatch [string match $matchstring $d]
3950 if {!$doesmatch} continue
3951 if {![info exists commitinfo($id)]} {
3954 set info $commitinfo($id)
3956 foreach f $info ty $fldtypes {
3957 if {$findloc != "All fields" && $findloc != $ty} {
3960 set matches [findmatches $f]
3961 if {$matches == {}} continue
3963 if {$ty == "Headline"} {
3965 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3966 } elseif {$ty == "Author"} {
3968 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3969 } elseif {$ty == "Date"} {
3971 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3975 lappend matchinglines $l
3976 if {!$didsel && $l > $oldsel} {
3982 if {$matchinglines == {}} {
3984 } elseif {!$didsel} {
3985 findselectline [lindex $matchinglines 0]
3989 proc findselectline {l} {
3990 global findloc commentend ctext
3992 if {$findloc == "All fields" || $findloc == "Comments"} {
3993 # highlight the matches in the comments
3994 set f [$ctext get 1.0 $commentend]
3995 set matches [findmatches $f]
3996 foreach match $matches {
3997 set start [lindex $match 0]
3998 set end [expr {[lindex $match 1] + 1}]
3999 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4004 proc findnext {restart} {
4005 global matchinglines selectedline
4006 if {![info exists matchinglines]} {
4012 if {![info exists selectedline]} return
4013 foreach l $matchinglines {
4014 if {$l > $selectedline} {
4023 global matchinglines selectedline
4024 if {![info exists matchinglines]} {
4028 if {![info exists selectedline]} return
4030 foreach l $matchinglines {
4031 if {$l >= $selectedline} break
4035 findselectline $prev
4041 proc stopfindproc {{done 0}} {
4042 global findprocpid findprocfile findids
4043 global ctext findoldcursor phase maincursor textcursor
4044 global findinprogress
4046 catch {unset findids}
4047 if {[info exists findprocpid]} {
4049 catch {exec kill $findprocpid}
4051 catch {close $findprocfile}
4054 catch {unset findinprogress}
4058 # mark a commit as matching by putting a yellow background
4059 # behind the headline
4060 proc markheadline {l id} {
4061 global canv mainfont linehtag
4064 set bbox [$canv bbox $linehtag($l)]
4065 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
4069 # mark the bits of a headline, author or date that match a find string
4070 proc markmatches {canv l str tag matches font} {
4071 set bbox [$canv bbox $tag]
4072 set x0 [lindex $bbox 0]
4073 set y0 [lindex $bbox 1]
4074 set y1 [lindex $bbox 3]
4075 foreach match $matches {
4076 set start [lindex $match 0]
4077 set end [lindex $match 1]
4078 if {$start > $end} continue
4079 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4080 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4081 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4082 [expr {$x0+$xlen+2}] $y1 \
4083 -outline {} -tags matches -fill yellow]
4088 proc unmarkmatches {} {
4089 global matchinglines findids
4090 allcanvs delete matches
4091 catch {unset matchinglines}
4092 catch {unset findids}
4095 proc selcanvline {w x y} {
4096 global canv canvy0 ctext linespc
4098 set ymax [lindex [$canv cget -scrollregion] 3]
4099 if {$ymax == {}} return
4100 set yfrac [lindex [$canv yview] 0]
4101 set y [expr {$y + $yfrac * $ymax}]
4102 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4107 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4113 proc commit_descriptor {p} {
4115 if {![info exists commitinfo($p)]} {
4119 if {[llength $commitinfo($p)] > 1} {
4120 set l [lindex $commitinfo($p) 0]
4125 # append some text to the ctext widget, and make any SHA1 ID
4126 # that we know about be a clickable link.
4127 proc appendwithlinks {text tags} {
4128 global ctext commitrow linknum curview
4130 set start [$ctext index "end - 1c"]
4131 $ctext insert end $text $tags
4132 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4136 set linkid [string range $text $s $e]
4137 if {![info exists commitrow($curview,$linkid)]} continue
4139 $ctext tag add link "$start + $s c" "$start + $e c"
4140 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4141 $ctext tag bind link$linknum <1> \
4142 [list selectline $commitrow($curview,$linkid) 1]
4145 $ctext tag conf link -foreground blue -underline 1
4146 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4147 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4150 proc viewnextline {dir} {
4154 set ymax [lindex [$canv cget -scrollregion] 3]
4155 set wnow [$canv yview]
4156 set wtop [expr {[lindex $wnow 0] * $ymax}]
4157 set newtop [expr {$wtop + $dir * $linespc}]
4160 } elseif {$newtop > $ymax} {
4163 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4166 # add a list of tag or branch names at position pos
4167 # returns the number of names inserted
4168 proc appendrefs {pos ids var} {
4169 global ctext commitrow linknum curview $var maxrefs
4171 if {[catch {$ctext index $pos}]} {
4174 $ctext conf -state normal
4175 $ctext delete $pos "$pos lineend"
4178 foreach tag [set $var\($id\)] {
4179 lappend tags [list $tag $id]
4182 if {[llength $tags] > $maxrefs} {
4183 $ctext insert $pos "many ([llength $tags])"
4185 set tags [lsort -index 0 -decreasing $tags]
4188 set id [lindex $ti 1]
4191 $ctext tag delete $lk
4192 $ctext insert $pos $sep
4193 $ctext insert $pos [lindex $ti 0] $lk
4194 if {[info exists commitrow($curview,$id)]} {
4195 $ctext tag conf $lk -foreground blue
4196 $ctext tag bind $lk <1> \
4197 [list selectline $commitrow($curview,$id) 1]
4198 $ctext tag conf $lk -underline 1
4199 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4200 $ctext tag bind $lk <Leave> \
4201 { %W configure -cursor $curtextcursor }
4206 $ctext conf -state disabled
4207 return [llength $tags]
4210 # called when we have finished computing the nearby tags
4211 proc dispneartags {delay} {
4212 global selectedline currentid showneartags tagphase
4214 if {![info exists selectedline] || !$showneartags} return
4215 after cancel dispnexttag
4217 after 200 dispnexttag
4220 after idle dispnexttag
4225 proc dispnexttag {} {
4226 global selectedline currentid showneartags tagphase ctext
4228 if {![info exists selectedline] || !$showneartags} return
4229 switch -- $tagphase {
4231 set dtags [desctags $currentid]
4233 appendrefs precedes $dtags idtags
4237 set atags [anctags $currentid]
4239 appendrefs follows $atags idtags
4243 set dheads [descheads $currentid]
4244 if {$dheads ne {}} {
4245 if {[appendrefs branch $dheads idheads] > 1
4246 && [$ctext get "branch -3c"] eq "h"} {
4247 # turn "Branch" into "Branches"
4248 $ctext conf -state normal
4249 $ctext insert "branch -2c" "es"
4250 $ctext conf -state disabled
4255 if {[incr tagphase] <= 2} {
4256 after idle dispnexttag
4260 proc selectline {l isnew} {
4261 global canv canv2 canv3 ctext commitinfo selectedline
4262 global displayorder linehtag linentag linedtag
4263 global canvy0 linespc parentlist children curview
4264 global currentid sha1entry
4265 global commentend idtags linknum
4266 global mergemax numcommits pending_select
4267 global cmitmode showneartags allcommits
4269 catch {unset pending_select}
4272 cancel_next_highlight
4273 if {$l < 0 || $l >= $numcommits} return
4274 set y [expr {$canvy0 + $l * $linespc}]
4275 set ymax [lindex [$canv cget -scrollregion] 3]
4276 set ytop [expr {$y - $linespc - 1}]
4277 set ybot [expr {$y + $linespc + 1}]
4278 set wnow [$canv yview]
4279 set wtop [expr {[lindex $wnow 0] * $ymax}]
4280 set wbot [expr {[lindex $wnow 1] * $ymax}]
4281 set wh [expr {$wbot - $wtop}]
4283 if {$ytop < $wtop} {
4284 if {$ybot < $wtop} {
4285 set newtop [expr {$y - $wh / 2.0}]
4288 if {$newtop > $wtop - $linespc} {
4289 set newtop [expr {$wtop - $linespc}]
4292 } elseif {$ybot > $wbot} {
4293 if {$ytop > $wbot} {
4294 set newtop [expr {$y - $wh / 2.0}]
4296 set newtop [expr {$ybot - $wh}]
4297 if {$newtop < $wtop + $linespc} {
4298 set newtop [expr {$wtop + $linespc}]
4302 if {$newtop != $wtop} {
4306 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4310 if {![info exists linehtag($l)]} return
4312 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4313 -tags secsel -fill [$canv cget -selectbackground]]
4315 $canv2 delete secsel
4316 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4317 -tags secsel -fill [$canv2 cget -selectbackground]]
4319 $canv3 delete secsel
4320 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4321 -tags secsel -fill [$canv3 cget -selectbackground]]
4325 addtohistory [list selectline $l 0]
4330 set id [lindex $displayorder $l]
4332 $sha1entry delete 0 end
4333 $sha1entry insert 0 $id
4334 $sha1entry selection from 0
4335 $sha1entry selection to end
4338 $ctext conf -state normal
4341 set info $commitinfo($id)
4342 set date [formatdate [lindex $info 2]]
4343 $ctext insert end "Author: [lindex $info 1] $date\n"
4344 set date [formatdate [lindex $info 4]]
4345 $ctext insert end "Committer: [lindex $info 3] $date\n"
4346 if {[info exists idtags($id)]} {
4347 $ctext insert end "Tags:"
4348 foreach tag $idtags($id) {
4349 $ctext insert end " $tag"
4351 $ctext insert end "\n"
4355 set olds [lindex $parentlist $l]
4356 if {[llength $olds] > 1} {
4359 if {$np >= $mergemax} {
4364 $ctext insert end "Parent: " $tag
4365 appendwithlinks [commit_descriptor $p] {}
4370 append headers "Parent: [commit_descriptor $p]"
4374 foreach c $children($curview,$id) {
4375 append headers "Child: [commit_descriptor $c]"
4378 # make anything that looks like a SHA1 ID be a clickable link
4379 appendwithlinks $headers {}
4380 if {$showneartags} {
4381 if {![info exists allcommits]} {
4384 $ctext insert end "Branch: "
4385 $ctext mark set branch "end -1c"
4386 $ctext mark gravity branch left
4387 $ctext insert end "\nFollows: "
4388 $ctext mark set follows "end -1c"
4389 $ctext mark gravity follows left
4390 $ctext insert end "\nPrecedes: "
4391 $ctext mark set precedes "end -1c"
4392 $ctext mark gravity precedes left
4393 $ctext insert end "\n"
4396 $ctext insert end "\n"
4397 set comment [lindex $info 5]
4398 if {[string first "\r" $comment] >= 0} {
4399 set comment [string map {"\r" "\n "} $comment]
4401 appendwithlinks $comment {comment}
4403 $ctext tag delete Comments
4404 $ctext tag remove found 1.0 end
4405 $ctext conf -state disabled
4406 set commentend [$ctext index "end - 1c"]
4408 init_flist "Comments"
4409 if {$cmitmode eq "tree"} {
4411 } elseif {[llength $olds] <= 1} {
4418 proc selfirstline {} {
4423 proc sellastline {} {
4426 set l [expr {$numcommits - 1}]
4430 proc selnextline {dir} {
4432 if {![info exists selectedline]} return
4433 set l [expr {$selectedline + $dir}]
4438 proc selnextpage {dir} {
4439 global canv linespc selectedline numcommits
4441 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4445 allcanvs yview scroll [expr {$dir * $lpp}] units
4447 if {![info exists selectedline]} return
4448 set l [expr {$selectedline + $dir * $lpp}]
4451 } elseif {$l >= $numcommits} {
4452 set l [expr $numcommits - 1]
4458 proc unselectline {} {
4459 global selectedline currentid
4461 catch {unset selectedline}
4462 catch {unset currentid}
4463 allcanvs delete secsel
4465 cancel_next_highlight
4468 proc reselectline {} {
4471 if {[info exists selectedline]} {
4472 selectline $selectedline 0
4476 proc addtohistory {cmd} {
4477 global history historyindex curview
4479 set elt [list $curview $cmd]
4480 if {$historyindex > 0
4481 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4485 if {$historyindex < [llength $history]} {
4486 set history [lreplace $history $historyindex end $elt]
4488 lappend history $elt
4491 if {$historyindex > 1} {
4492 .tf.bar.leftbut conf -state normal
4494 .tf.bar.leftbut conf -state disabled
4496 .tf.bar.rightbut conf -state disabled
4502 set view [lindex $elt 0]
4503 set cmd [lindex $elt 1]
4504 if {$curview != $view} {
4511 global history historyindex
4513 if {$historyindex > 1} {
4514 incr historyindex -1
4515 godo [lindex $history [expr {$historyindex - 1}]]
4516 .tf.bar.rightbut conf -state normal
4518 if {$historyindex <= 1} {
4519 .tf.bar.leftbut conf -state disabled
4524 global history historyindex
4526 if {$historyindex < [llength $history]} {
4527 set cmd [lindex $history $historyindex]
4530 .tf.bar.leftbut conf -state normal
4532 if {$historyindex >= [llength $history]} {
4533 .tf.bar.rightbut conf -state disabled
4538 global treefilelist treeidlist diffids diffmergeid treepending nullid
4541 catch {unset diffmergeid}
4542 if {![info exists treefilelist($id)]} {
4543 if {![info exists treepending]} {
4544 if {$id ne $nullid} {
4545 set cmd [concat | git ls-tree -r $id]
4547 set cmd [concat | git ls-files]
4549 if {[catch {set gtf [open $cmd r]}]} {
4553 set treefilelist($id) {}
4554 set treeidlist($id) {}
4555 fconfigure $gtf -blocking 0
4556 filerun $gtf [list gettreeline $gtf $id]
4563 proc gettreeline {gtf id} {
4564 global treefilelist treeidlist treepending cmitmode diffids nullid
4567 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4568 if {$diffids ne $nullid} {
4569 set tl [split $line "\t"]
4570 if {[lindex $tl 0 1] ne "blob"} continue
4571 set sha1 [lindex $tl 0 2]
4572 set fname [lindex $tl 1]
4573 if {[string index $fname 0] eq "\""} {
4574 set fname [lindex $fname 0]
4576 lappend treeidlist($id) $sha1
4580 lappend treefilelist($id) $fname
4583 return [expr {$nl >= 1000? 2: 1}]
4587 if {$cmitmode ne "tree"} {
4588 if {![info exists diffmergeid]} {
4589 gettreediffs $diffids
4591 } elseif {$id ne $diffids} {
4600 global treefilelist treeidlist diffids nullid
4601 global ctext commentend
4603 set i [lsearch -exact $treefilelist($diffids) $f]
4605 puts "oops, $f not in list for id $diffids"
4608 if {$diffids ne $nullid} {
4609 set blob [lindex $treeidlist($diffids) $i]
4610 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4611 puts "oops, error reading blob $blob: $err"
4615 if {[catch {set bf [open $f r]} err]} {
4616 puts "oops, can't read $f: $err"
4620 fconfigure $bf -blocking 0
4621 filerun $bf [list getblobline $bf $diffids]
4622 $ctext config -state normal
4623 clear_ctext $commentend
4624 $ctext insert end "\n"
4625 $ctext insert end "$f\n" filesep
4626 $ctext config -state disabled
4627 $ctext yview $commentend
4630 proc getblobline {bf id} {
4631 global diffids cmitmode ctext
4633 if {$id ne $diffids || $cmitmode ne "tree"} {
4637 $ctext config -state normal
4639 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4640 $ctext insert end "$line\n"
4643 # delete last newline
4644 $ctext delete "end - 2c" "end - 1c"
4648 $ctext config -state disabled
4649 return [expr {$nl >= 1000? 2: 1}]
4652 proc mergediff {id l} {
4653 global diffmergeid diffopts mdifffd
4659 # this doesn't seem to actually affect anything...
4660 set env(GIT_DIFF_OPTS) $diffopts
4661 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4662 if {[catch {set mdf [open $cmd r]} err]} {
4663 error_popup "Error getting merge diffs: $err"
4666 fconfigure $mdf -blocking 0
4667 set mdifffd($id) $mdf
4668 set np [llength [lindex $parentlist $l]]
4669 filerun $mdf [list getmergediffline $mdf $id $np]
4672 proc getmergediffline {mdf id np} {
4673 global diffmergeid ctext cflist mergemax
4674 global difffilestart mdifffd
4676 $ctext conf -state normal
4678 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4679 if {![info exists diffmergeid] || $id != $diffmergeid
4680 || $mdf != $mdifffd($id)} {
4684 if {[regexp {^diff --cc (.*)} $line match fname]} {
4685 # start of a new file
4686 $ctext insert end "\n"
4687 set here [$ctext index "end - 1c"]
4688 lappend difffilestart $here
4689 add_flist [list $fname]
4690 set l [expr {(78 - [string length $fname]) / 2}]
4691 set pad [string range "----------------------------------------" 1 $l]
4692 $ctext insert end "$pad $fname $pad\n" filesep
4693 } elseif {[regexp {^@@} $line]} {
4694 $ctext insert end "$line\n" hunksep
4695 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4698 # parse the prefix - one ' ', '-' or '+' for each parent
4703 for {set j 0} {$j < $np} {incr j} {
4704 set c [string range $line $j $j]
4707 } elseif {$c == "-"} {
4709 } elseif {$c == "+"} {
4718 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4719 # line doesn't appear in result, parents in $minuses have the line
4720 set num [lindex $minuses 0]
4721 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4722 # line appears in result, parents in $pluses don't have the line
4723 lappend tags mresult
4724 set num [lindex $spaces 0]
4727 if {$num >= $mergemax} {
4732 $ctext insert end "$line\n" $tags
4735 $ctext conf -state disabled
4740 return [expr {$nr >= 1000? 2: 1}]
4743 proc startdiff {ids} {
4744 global treediffs diffids treepending diffmergeid nullid
4747 catch {unset diffmergeid}
4748 if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4749 if {![info exists treepending]} {
4757 proc addtocflist {ids} {
4758 global treediffs cflist
4759 add_flist $treediffs($ids)
4763 proc diffcmd {ids flags} {
4766 set i [lsearch -exact $ids $nullid]
4768 set cmd [concat | git diff-index $flags]
4769 if {[llength $ids] > 1} {
4771 lappend cmd -R [lindex $ids 1]
4773 lappend cmd [lindex $ids 0]
4779 set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4784 proc gettreediffs {ids} {
4785 global treediff treepending
4787 set treepending $ids
4789 if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4790 fconfigure $gdtf -blocking 0
4791 filerun $gdtf [list gettreediffline $gdtf $ids]
4794 proc gettreediffline {gdtf ids} {
4795 global treediff treediffs treepending diffids diffmergeid
4799 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4800 set file [lindex $line 5]
4801 lappend treediff $file
4804 return [expr {$nr >= 1000? 2: 1}]
4807 set treediffs($ids) $treediff
4809 if {$cmitmode eq "tree"} {
4811 } elseif {$ids != $diffids} {
4812 if {![info exists diffmergeid]} {
4813 gettreediffs $diffids
4821 proc getblobdiffs {ids} {
4822 global diffopts blobdifffd diffids env curdifftag curtagstart
4823 global diffinhdr treediffs
4825 set env(GIT_DIFF_OPTS) $diffopts
4826 if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4827 puts "error getting diffs: $err"
4831 fconfigure $bdf -blocking 0
4832 set blobdifffd($ids) $bdf
4833 set curdifftag Comments
4835 filerun $bdf [list getblobdiffline $bdf $diffids]
4838 proc setinlist {var i val} {
4841 while {[llength [set $var]] < $i} {
4844 if {[llength [set $var]] == $i} {
4851 proc getblobdiffline {bdf ids} {
4852 global diffids blobdifffd ctext curdifftag curtagstart
4853 global diffnexthead diffnextnote difffilestart
4854 global diffinhdr treediffs
4857 $ctext conf -state normal
4858 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4859 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4863 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4864 # start of a new file
4865 $ctext insert end "\n"
4866 $ctext tag add $curdifftag $curtagstart end
4867 set here [$ctext index "end - 1c"]
4868 set curtagstart $here
4870 set i [lsearch -exact $treediffs($ids) $fname]
4872 setinlist difffilestart $i $here
4874 if {$newname ne $fname} {
4875 set i [lsearch -exact $treediffs($ids) $newname]
4877 setinlist difffilestart $i $here
4880 set curdifftag "f:$fname"
4881 $ctext tag delete $curdifftag
4882 set l [expr {(78 - [string length $header]) / 2}]
4883 set pad [string range "----------------------------------------" \
4885 $ctext insert end "$pad $header $pad\n" filesep
4887 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4889 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4891 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4892 $line match f1l f1c f2l f2c rest]} {
4893 $ctext insert end "$line\n" hunksep
4896 set x [string range $line 0 0]
4897 if {$x == "-" || $x == "+"} {
4898 set tag [expr {$x == "+"}]
4899 $ctext insert end "$line\n" d$tag
4900 } elseif {$x == " "} {
4901 $ctext insert end "$line\n"
4902 } elseif {$diffinhdr || $x == "\\"} {
4903 # e.g. "\ No newline at end of file"
4904 $ctext insert end "$line\n" filesep
4906 # Something else we don't recognize
4907 if {$curdifftag != "Comments"} {
4908 $ctext insert end "\n"
4909 $ctext tag add $curdifftag $curtagstart end
4910 set curtagstart [$ctext index "end - 1c"]
4911 set curdifftag Comments
4913 $ctext insert end "$line\n" filesep
4917 $ctext conf -state disabled
4920 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4921 $ctext tag add $curdifftag $curtagstart end
4925 return [expr {$nr >= 1000? 2: 1}]
4928 proc changediffdisp {} {
4929 global ctext diffelide
4931 $ctext tag conf d0 -elide [lindex $diffelide 0]
4932 $ctext tag conf d1 -elide [lindex $diffelide 1]
4936 global difffilestart ctext
4937 set prev [lindex $difffilestart 0]
4938 set here [$ctext index @0,0]
4939 foreach loc $difffilestart {
4940 if {[$ctext compare $loc >= $here]} {
4950 global difffilestart ctext
4951 set here [$ctext index @0,0]
4952 foreach loc $difffilestart {
4953 if {[$ctext compare $loc > $here]} {
4960 proc clear_ctext {{first 1.0}} {
4961 global ctext smarktop smarkbot
4963 set l [lindex [split $first .] 0]
4964 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4967 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4970 $ctext delete $first end
4973 proc incrsearch {name ix op} {
4974 global ctext searchstring searchdirn
4976 $ctext tag remove found 1.0 end
4977 if {[catch {$ctext index anchor}]} {
4978 # no anchor set, use start of selection, or of visible area
4979 set sel [$ctext tag ranges sel]
4981 $ctext mark set anchor [lindex $sel 0]
4982 } elseif {$searchdirn eq "-forwards"} {
4983 $ctext mark set anchor @0,0
4985 $ctext mark set anchor @0,[winfo height $ctext]
4988 if {$searchstring ne {}} {
4989 set here [$ctext search $searchdirn -- $searchstring anchor]
4998 global sstring ctext searchstring searchdirn
5001 $sstring icursor end
5002 set searchdirn -forwards
5003 if {$searchstring ne {}} {
5004 set sel [$ctext tag ranges sel]
5006 set start "[lindex $sel 0] + 1c"
5007 } elseif {[catch {set start [$ctext index anchor]}]} {
5010 set match [$ctext search -count mlen -- $searchstring $start]
5011 $ctext tag remove sel 1.0 end
5017 set mend "$match + $mlen c"
5018 $ctext tag add sel $match $mend
5019 $ctext mark unset anchor
5023 proc dosearchback {} {
5024 global sstring ctext searchstring searchdirn
5027 $sstring icursor end
5028 set searchdirn -backwards
5029 if {$searchstring ne {}} {
5030 set sel [$ctext tag ranges sel]
5032 set start [lindex $sel 0]
5033 } elseif {[catch {set start [$ctext index anchor]}]} {
5034 set start @0,[winfo height $ctext]
5036 set match [$ctext search -backwards -count ml -- $searchstring $start]
5037 $ctext tag remove sel 1.0 end
5043 set mend "$match + $ml c"
5044 $ctext tag add sel $match $mend
5045 $ctext mark unset anchor
5049 proc searchmark {first last} {
5050 global ctext searchstring
5054 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5055 if {$match eq {}} break
5056 set mend "$match + $mlen c"
5057 $ctext tag add found $match $mend
5061 proc searchmarkvisible {doall} {
5062 global ctext smarktop smarkbot
5064 set topline [lindex [split [$ctext index @0,0] .] 0]
5065 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5066 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5067 # no overlap with previous
5068 searchmark $topline $botline
5069 set smarktop $topline
5070 set smarkbot $botline
5072 if {$topline < $smarktop} {
5073 searchmark $topline [expr {$smarktop-1}]
5074 set smarktop $topline
5076 if {$botline > $smarkbot} {
5077 searchmark [expr {$smarkbot+1}] $botline
5078 set smarkbot $botline
5083 proc scrolltext {f0 f1} {
5086 .bleft.sb set $f0 $f1
5087 if {$searchstring ne {}} {
5093 global linespc charspc canvx0 canvy0 mainfont
5094 global xspc1 xspc2 lthickness
5096 set linespc [font metrics $mainfont -linespace]
5097 set charspc [font measure $mainfont "m"]
5098 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5099 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5100 set lthickness [expr {int($linespc / 9) + 1}]
5101 set xspc1(0) $linespc
5109 set ymax [lindex [$canv cget -scrollregion] 3]
5110 if {$ymax eq {} || $ymax == 0} return
5111 set span [$canv yview]
5114 allcanvs yview moveto [lindex $span 0]
5116 if {[info exists selectedline]} {
5117 selectline $selectedline 0
5118 allcanvs yview moveto [lindex $span 0]
5122 proc incrfont {inc} {
5123 global mainfont textfont ctext canv phase cflist
5124 global charspc tabstop
5125 global stopped entries
5127 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5128 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5130 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5131 $cflist conf -font $textfont
5132 $ctext tag conf filesep -font [concat $textfont bold]
5133 foreach e $entries {
5134 $e conf -font $mainfont
5136 if {$phase eq "getcommits"} {
5137 $canv itemconf textitems -font $mainfont
5143 global sha1entry sha1string
5144 if {[string length $sha1string] == 40} {
5145 $sha1entry delete 0 end
5149 proc sha1change {n1 n2 op} {
5150 global sha1string currentid sha1but
5151 if {$sha1string == {}
5152 || ([info exists currentid] && $sha1string == $currentid)} {
5157 if {[$sha1but cget -state] == $state} return
5158 if {$state == "normal"} {
5159 $sha1but conf -state normal -relief raised -text "Goto: "
5161 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5165 proc gotocommit {} {
5166 global sha1string currentid commitrow tagids headids
5167 global displayorder numcommits curview
5169 if {$sha1string == {}
5170 || ([info exists currentid] && $sha1string == $currentid)} return
5171 if {[info exists tagids($sha1string)]} {
5172 set id $tagids($sha1string)
5173 } elseif {[info exists headids($sha1string)]} {
5174 set id $headids($sha1string)
5176 set id [string tolower $sha1string]
5177 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5179 foreach i $displayorder {
5180 if {[string match $id* $i]} {
5184 if {$matches ne {}} {
5185 if {[llength $matches] > 1} {
5186 error_popup "Short SHA1 id $id is ambiguous"
5189 set id [lindex $matches 0]
5193 if {[info exists commitrow($curview,$id)]} {
5194 selectline $commitrow($curview,$id) 1
5197 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5202 error_popup "$type $sha1string is not known"
5205 proc lineenter {x y id} {
5206 global hoverx hovery hoverid hovertimer
5207 global commitinfo canv
5209 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5213 if {[info exists hovertimer]} {
5214 after cancel $hovertimer
5216 set hovertimer [after 500 linehover]
5220 proc linemotion {x y id} {
5221 global hoverx hovery hoverid hovertimer
5223 if {[info exists hoverid] && $id == $hoverid} {
5226 if {[info exists hovertimer]} {
5227 after cancel $hovertimer
5229 set hovertimer [after 500 linehover]
5233 proc lineleave {id} {
5234 global hoverid hovertimer canv
5236 if {[info exists hoverid] && $id == $hoverid} {
5238 if {[info exists hovertimer]} {
5239 after cancel $hovertimer
5247 global hoverx hovery hoverid hovertimer
5248 global canv linespc lthickness
5249 global commitinfo mainfont
5251 set text [lindex $commitinfo($hoverid) 0]
5252 set ymax [lindex [$canv cget -scrollregion] 3]
5253 if {$ymax == {}} return
5254 set yfrac [lindex [$canv yview] 0]
5255 set x [expr {$hoverx + 2 * $linespc}]
5256 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5257 set x0 [expr {$x - 2 * $lthickness}]
5258 set y0 [expr {$y - 2 * $lthickness}]
5259 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5260 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5261 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5262 -fill \#ffff80 -outline black -width 1 -tags hover]
5264 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5269 proc clickisonarrow {id y} {
5272 set ranges [rowranges $id]
5273 set thresh [expr {2 * $lthickness + 6}]
5274 set n [expr {[llength $ranges] - 1}]
5275 for {set i 1} {$i < $n} {incr i} {
5276 set row [lindex $ranges $i]
5277 if {abs([yc $row] - $y) < $thresh} {
5284 proc arrowjump {id n y} {
5287 # 1 <-> 2, 3 <-> 4, etc...
5288 set n [expr {(($n - 1) ^ 1) + 1}]
5289 set row [lindex [rowranges $id] $n]
5291 set ymax [lindex [$canv cget -scrollregion] 3]
5292 if {$ymax eq {} || $ymax <= 0} return
5293 set view [$canv yview]
5294 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5295 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5299 allcanvs yview moveto $yfrac
5302 proc lineclick {x y id isnew} {
5303 global ctext commitinfo children canv thickerline curview
5305 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5310 # draw this line thicker than normal
5314 set ymax [lindex [$canv cget -scrollregion] 3]
5315 if {$ymax eq {}} return
5316 set yfrac [lindex [$canv yview] 0]
5317 set y [expr {$y + $yfrac * $ymax}]
5319 set dirn [clickisonarrow $id $y]
5321 arrowjump $id $dirn $y
5326 addtohistory [list lineclick $x $y $id 0]
5328 # fill the details pane with info about this line
5329 $ctext conf -state normal
5331 $ctext tag conf link -foreground blue -underline 1
5332 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5333 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5334 $ctext insert end "Parent:\t"
5335 $ctext insert end $id [list link link0]
5336 $ctext tag bind link0 <1> [list selbyid $id]
5337 set info $commitinfo($id)
5338 $ctext insert end "\n\t[lindex $info 0]\n"
5339 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5340 set date [formatdate [lindex $info 2]]
5341 $ctext insert end "\tDate:\t$date\n"
5342 set kids $children($curview,$id)
5344 $ctext insert end "\nChildren:"
5346 foreach child $kids {
5348 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5349 set info $commitinfo($child)
5350 $ctext insert end "\n\t"
5351 $ctext insert end $child [list link link$i]
5352 $ctext tag bind link$i <1> [list selbyid $child]
5353 $ctext insert end "\n\t[lindex $info 0]"
5354 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5355 set date [formatdate [lindex $info 2]]
5356 $ctext insert end "\n\tDate:\t$date\n"
5359 $ctext conf -state disabled
5363 proc normalline {} {
5365 if {[info exists thickerline]} {
5373 global commitrow curview
5374 if {[info exists commitrow($curview,$id)]} {
5375 selectline $commitrow($curview,$id) 1
5381 if {![info exists startmstime]} {
5382 set startmstime [clock clicks -milliseconds]
5384 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5387 proc rowmenu {x y id} {
5388 global rowctxmenu commitrow selectedline rowmenuid curview
5389 global nullid fakerowmenu mainhead
5392 if {![info exists selectedline]
5393 || $commitrow($curview,$id) eq $selectedline} {
5398 if {$id ne $nullid} {
5399 set menu $rowctxmenu
5400 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5402 set menu $fakerowmenu
5404 $menu entryconfigure "Diff this*" -state $state
5405 $menu entryconfigure "Diff selected*" -state $state
5406 $menu entryconfigure "Make patch" -state $state
5407 tk_popup $menu $x $y
5410 proc diffvssel {dirn} {
5411 global rowmenuid selectedline displayorder
5413 if {![info exists selectedline]} return
5415 set oldid [lindex $displayorder $selectedline]
5416 set newid $rowmenuid
5418 set oldid $rowmenuid
5419 set newid [lindex $displayorder $selectedline]
5421 addtohistory [list doseldiff $oldid $newid]
5422 doseldiff $oldid $newid
5425 proc doseldiff {oldid newid} {
5429 $ctext conf -state normal
5432 $ctext insert end "From "
5433 $ctext tag conf link -foreground blue -underline 1
5434 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5435 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5436 $ctext tag bind link0 <1> [list selbyid $oldid]
5437 $ctext insert end $oldid [list link link0]
5438 $ctext insert end "\n "
5439 $ctext insert end [lindex $commitinfo($oldid) 0]
5440 $ctext insert end "\n\nTo "
5441 $ctext tag bind link1 <1> [list selbyid $newid]
5442 $ctext insert end $newid [list link link1]
5443 $ctext insert end "\n "
5444 $ctext insert end [lindex $commitinfo($newid) 0]
5445 $ctext insert end "\n"
5446 $ctext conf -state disabled
5447 $ctext tag delete Comments
5448 $ctext tag remove found 1.0 end
5449 startdiff [list $oldid $newid]
5453 global rowmenuid currentid commitinfo patchtop patchnum
5455 if {![info exists currentid]} return
5456 set oldid $currentid
5457 set oldhead [lindex $commitinfo($oldid) 0]
5458 set newid $rowmenuid
5459 set newhead [lindex $commitinfo($newid) 0]
5462 catch {destroy $top}
5464 label $top.title -text "Generate patch"
5465 grid $top.title - -pady 10
5466 label $top.from -text "From:"
5467 entry $top.fromsha1 -width 40 -relief flat
5468 $top.fromsha1 insert 0 $oldid
5469 $top.fromsha1 conf -state readonly
5470 grid $top.from $top.fromsha1 -sticky w
5471 entry $top.fromhead -width 60 -relief flat
5472 $top.fromhead insert 0 $oldhead
5473 $top.fromhead conf -state readonly
5474 grid x $top.fromhead -sticky w
5475 label $top.to -text "To:"
5476 entry $top.tosha1 -width 40 -relief flat
5477 $top.tosha1 insert 0 $newid
5478 $top.tosha1 conf -state readonly
5479 grid $top.to $top.tosha1 -sticky w
5480 entry $top.tohead -width 60 -relief flat
5481 $top.tohead insert 0 $newhead
5482 $top.tohead conf -state readonly
5483 grid x $top.tohead -sticky w
5484 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5485 grid $top.rev x -pady 10
5486 label $top.flab -text "Output file:"
5487 entry $top.fname -width 60
5488 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5490 grid $top.flab $top.fname -sticky w
5492 button $top.buts.gen -text "Generate" -command mkpatchgo
5493 button $top.buts.can -text "Cancel" -command mkpatchcan
5494 grid $top.buts.gen $top.buts.can
5495 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5496 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5497 grid $top.buts - -pady 10 -sticky ew
5501 proc mkpatchrev {} {
5504 set oldid [$patchtop.fromsha1 get]
5505 set oldhead [$patchtop.fromhead get]
5506 set newid [$patchtop.tosha1 get]
5507 set newhead [$patchtop.tohead get]
5508 foreach e [list fromsha1 fromhead tosha1 tohead] \
5509 v [list $newid $newhead $oldid $oldhead] {
5510 $patchtop.$e conf -state normal
5511 $patchtop.$e delete 0 end
5512 $patchtop.$e insert 0 $v
5513 $patchtop.$e conf -state readonly
5518 global patchtop nullid
5520 set oldid [$patchtop.fromsha1 get]
5521 set newid [$patchtop.tosha1 get]
5522 set fname [$patchtop.fname get]
5523 if {$newid eq $nullid} {
5524 set cmd [list git diff-index -p $oldid]
5525 } elseif {$oldid eq $nullid} {
5526 set cmd [list git diff-index -p -R $newid]
5528 set cmd [list git diff-tree -p $oldid $newid]
5530 lappend cmd >$fname &
5531 if {[catch {eval exec $cmd} err]} {
5532 error_popup "Error creating patch: $err"
5534 catch {destroy $patchtop}
5538 proc mkpatchcan {} {
5541 catch {destroy $patchtop}
5546 global rowmenuid mktagtop commitinfo
5550 catch {destroy $top}
5552 label $top.title -text "Create tag"
5553 grid $top.title - -pady 10
5554 label $top.id -text "ID:"
5555 entry $top.sha1 -width 40 -relief flat
5556 $top.sha1 insert 0 $rowmenuid
5557 $top.sha1 conf -state readonly
5558 grid $top.id $top.sha1 -sticky w
5559 entry $top.head -width 60 -relief flat
5560 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5561 $top.head conf -state readonly
5562 grid x $top.head -sticky w
5563 label $top.tlab -text "Tag name:"
5564 entry $top.tag -width 60
5565 grid $top.tlab $top.tag -sticky w
5567 button $top.buts.gen -text "Create" -command mktaggo
5568 button $top.buts.can -text "Cancel" -command mktagcan
5569 grid $top.buts.gen $top.buts.can
5570 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5571 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5572 grid $top.buts - -pady 10 -sticky ew
5577 global mktagtop env tagids idtags
5579 set id [$mktagtop.sha1 get]
5580 set tag [$mktagtop.tag get]
5582 error_popup "No tag name specified"
5585 if {[info exists tagids($tag)]} {
5586 error_popup "Tag \"$tag\" already exists"
5591 set fname [file join $dir "refs/tags" $tag]
5592 set f [open $fname w]
5596 error_popup "Error creating tag: $err"
5600 set tagids($tag) $id
5601 lappend idtags($id) $tag
5606 proc redrawtags {id} {
5607 global canv linehtag commitrow idpos selectedline curview
5608 global mainfont canvxmax iddrawn
5610 if {![info exists commitrow($curview,$id)]} return
5611 if {![info exists iddrawn($id)]} return
5612 drawcommits $commitrow($curview,$id)
5613 $canv delete tag.$id
5614 set xt [eval drawtags $id $idpos($id)]
5615 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5616 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5617 set xr [expr {$xt + [font measure $mainfont $text]}]
5618 if {$xr > $canvxmax} {
5622 if {[info exists selectedline]
5623 && $selectedline == $commitrow($curview,$id)} {
5624 selectline $selectedline 0
5631 catch {destroy $mktagtop}
5640 proc writecommit {} {
5641 global rowmenuid wrcomtop commitinfo wrcomcmd
5643 set top .writecommit
5645 catch {destroy $top}
5647 label $top.title -text "Write commit to file"
5648 grid $top.title - -pady 10
5649 label $top.id -text "ID:"
5650 entry $top.sha1 -width 40 -relief flat
5651 $top.sha1 insert 0 $rowmenuid
5652 $top.sha1 conf -state readonly
5653 grid $top.id $top.sha1 -sticky w
5654 entry $top.head -width 60 -relief flat
5655 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5656 $top.head conf -state readonly
5657 grid x $top.head -sticky w
5658 label $top.clab -text "Command:"
5659 entry $top.cmd -width 60 -textvariable wrcomcmd
5660 grid $top.clab $top.cmd -sticky w -pady 10
5661 label $top.flab -text "Output file:"
5662 entry $top.fname -width 60
5663 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5664 grid $top.flab $top.fname -sticky w
5666 button $top.buts.gen -text "Write" -command wrcomgo
5667 button $top.buts.can -text "Cancel" -command wrcomcan
5668 grid $top.buts.gen $top.buts.can
5669 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5670 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5671 grid $top.buts - -pady 10 -sticky ew
5678 set id [$wrcomtop.sha1 get]
5679 set cmd "echo $id | [$wrcomtop.cmd get]"
5680 set fname [$wrcomtop.fname get]
5681 if {[catch {exec sh -c $cmd >$fname &} err]} {
5682 error_popup "Error writing commit: $err"
5684 catch {destroy $wrcomtop}
5691 catch {destroy $wrcomtop}
5696 global rowmenuid mkbrtop
5699 catch {destroy $top}
5701 label $top.title -text "Create new branch"
5702 grid $top.title - -pady 10
5703 label $top.id -text "ID:"
5704 entry $top.sha1 -width 40 -relief flat
5705 $top.sha1 insert 0 $rowmenuid
5706 $top.sha1 conf -state readonly
5707 grid $top.id $top.sha1 -sticky w
5708 label $top.nlab -text "Name:"
5709 entry $top.name -width 40
5710 grid $top.nlab $top.name -sticky w
5712 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5713 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5714 grid $top.buts.go $top.buts.can
5715 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5716 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5717 grid $top.buts - -pady 10 -sticky ew
5722 global headids idheads
5724 set name [$top.name get]
5725 set id [$top.sha1 get]
5727 error_popup "Please specify a name for the new branch"
5730 catch {destroy $top}
5734 exec git branch $name $id
5739 set headids($name) $id
5740 lappend idheads($id) $name
5748 proc cherrypick {} {
5749 global rowmenuid curview commitrow
5752 set oldhead [exec git rev-parse HEAD]
5753 set dheads [descheads $rowmenuid]
5754 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5755 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5756 included in branch $mainhead -- really re-apply it?"]
5761 # Unfortunately git-cherry-pick writes stuff to stderr even when
5762 # no error occurs, and exec takes that as an indication of error...
5763 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5768 set newhead [exec git rev-parse HEAD]
5769 if {$newhead eq $oldhead} {
5771 error_popup "No changes committed"
5774 addnewchild $newhead $oldhead
5775 if {[info exists commitrow($curview,$oldhead)]} {
5776 insertrow $commitrow($curview,$oldhead) $newhead
5777 if {$mainhead ne {}} {
5778 movehead $newhead $mainhead
5779 movedhead $newhead $mainhead
5788 global mainheadid mainhead rowmenuid confirm_ok resettype
5789 global showlocalchanges
5792 set w ".confirmreset"
5795 wm title $w "Confirm reset"
5796 message $w.m -text \
5797 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5798 -justify center -aspect 1000
5799 pack $w.m -side top -fill x -padx 20 -pady 20
5800 frame $w.f -relief sunken -border 2
5801 message $w.f.rt -text "Reset type:" -aspect 1000
5802 grid $w.f.rt -sticky w
5804 radiobutton $w.f.soft -value soft -variable resettype -justify left \
5805 -text "Soft: Leave working tree and index untouched"
5806 grid $w.f.soft -sticky w
5807 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5808 -text "Mixed: Leave working tree untouched, reset index"
5809 grid $w.f.mixed -sticky w
5810 radiobutton $w.f.hard -value hard -variable resettype -justify left \
5811 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5812 grid $w.f.hard -sticky w
5813 pack $w.f -side top -fill x
5814 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5815 pack $w.ok -side left -fill x -padx 20 -pady 20
5816 button $w.cancel -text Cancel -command "destroy $w"
5817 pack $w.cancel -side right -fill x -padx 20 -pady 20
5818 bind $w <Visibility> "grab $w; focus $w"
5820 if {!$confirm_ok} return
5822 if {[catch {exec git reset --$resettype $rowmenuid} err]} {
5825 set oldhead $mainheadid
5826 movedhead $rowmenuid $mainhead
5827 set mainheadid $rowmenuid
5829 redrawtags $rowmenuid
5831 if {$showlocalchanges} {
5836 # context menu for a head
5837 proc headmenu {x y id head} {
5838 global headmenuid headmenuhead headctxmenu mainhead
5841 set headmenuhead $head
5843 if {$head eq $mainhead} {
5846 $headctxmenu entryconfigure 0 -state $state
5847 $headctxmenu entryconfigure 1 -state $state
5848 tk_popup $headctxmenu $x $y
5852 global headmenuid headmenuhead mainhead headids
5853 global showlocalchanges mainheadid
5855 # check the tree is clean first??
5856 set oldmainhead $mainhead
5861 exec git checkout -q $headmenuhead
5867 set mainhead $headmenuhead
5868 set mainheadid $headmenuid
5869 if {[info exists headids($oldmainhead)]} {
5870 redrawtags $headids($oldmainhead)
5872 redrawtags $headmenuid
5874 if {$showlocalchanges} {
5880 global headmenuid headmenuhead mainhead
5881 global headids idheads
5883 set head $headmenuhead
5885 # this check shouldn't be needed any more...
5886 if {$head eq $mainhead} {
5887 error_popup "Cannot delete the currently checked-out branch"
5890 set dheads [descheads $id]
5891 if {$dheads eq $headids($head)} {
5892 # the stuff on this branch isn't on any other branch
5893 if {![confirm_popup "The commits on branch $head aren't on any other\
5894 branch.\nReally delete branch $head?"]} return
5898 if {[catch {exec git branch -D $head} err]} {
5903 removehead $id $head
5904 removedhead $id $head
5910 # Stuff for finding nearby tags
5911 proc getallcommits {} {
5912 global allcommits allids nbmp nextarc seeds
5922 # Called when the graph might have changed
5923 proc regetallcommits {} {
5924 global allcommits seeds
5926 set cmd [concat | git rev-list --all --parents]
5930 set fd [open $cmd r]
5931 fconfigure $fd -blocking 0
5934 filerun $fd [list getallclines $fd]
5937 # Since most commits have 1 parent and 1 child, we group strings of
5938 # such commits into "arcs" joining branch/merge points (BMPs), which
5939 # are commits that either don't have 1 parent or don't have 1 child.
5941 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5942 # arcout(id) - outgoing arcs for BMP
5943 # arcids(a) - list of IDs on arc including end but not start
5944 # arcstart(a) - BMP ID at start of arc
5945 # arcend(a) - BMP ID at end of arc
5946 # growing(a) - arc a is still growing
5947 # arctags(a) - IDs out of arcids (excluding end) that have tags
5948 # archeads(a) - IDs out of arcids (excluding end) that have heads
5949 # The start of an arc is at the descendent end, so "incoming" means
5950 # coming from descendents, and "outgoing" means going towards ancestors.
5952 proc getallclines {fd} {
5953 global allids allparents allchildren idtags nextarc nbmp
5954 global arcnos arcids arctags arcout arcend arcstart archeads growing
5955 global seeds allcommits
5958 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
5959 set id [lindex $line 0]
5960 if {[info exists allparents($id)]} {
5965 set olds [lrange $line 1 end]
5966 set allparents($id) $olds
5967 if {![info exists allchildren($id)]} {
5968 set allchildren($id) {}
5973 if {[llength $olds] == 1 && [llength $a] == 1} {
5974 lappend arcids($a) $id
5975 if {[info exists idtags($id)]} {
5976 lappend arctags($a) $id
5978 if {[info exists idheads($id)]} {
5979 lappend archeads($a) $id
5981 if {[info exists allparents($olds)]} {
5982 # seen parent already
5983 if {![info exists arcout($olds)]} {
5986 lappend arcids($a) $olds
5987 set arcend($a) $olds
5990 lappend allchildren($olds) $id
5991 lappend arcnos($olds) $a
5996 foreach a $arcnos($id) {
5997 lappend arcids($a) $id
6004 lappend allchildren($p) $id
6005 set a [incr nextarc]
6006 set arcstart($a) $id
6013 if {[info exists allparents($p)]} {
6014 # seen it already, may need to make a new branch
6015 if {![info exists arcout($p)]} {
6018 lappend arcids($a) $p
6022 lappend arcnos($p) $a
6027 return [expr {$nid >= 1000? 2: 1}]
6030 if {[incr allcommits -1] == 0} {
6037 proc recalcarc {a} {
6038 global arctags archeads arcids idtags idheads
6042 foreach id [lrange $arcids($a) 0 end-1] {
6043 if {[info exists idtags($id)]} {
6046 if {[info exists idheads($id)]} {
6051 set archeads($a) $ah
6055 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6056 global arcstart arcend arcout allparents growing
6059 if {[llength $a] != 1} {
6060 puts "oops splitarc called but [llength $a] arcs already"
6064 set i [lsearch -exact $arcids($a) $p]
6066 puts "oops splitarc $p not in arc $a"
6069 set na [incr nextarc]
6070 if {[info exists arcend($a)]} {
6071 set arcend($na) $arcend($a)
6073 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6074 set j [lsearch -exact $arcnos($l) $a]
6075 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6077 set tail [lrange $arcids($a) [expr {$i+1}] end]
6078 set arcids($a) [lrange $arcids($a) 0 $i]
6080 set arcstart($na) $p
6082 set arcids($na) $tail
6083 if {[info exists growing($a)]} {
6090 if {[llength $arcnos($id)] == 1} {
6093 set j [lsearch -exact $arcnos($id) $a]
6094 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6098 # reconstruct tags and heads lists
6099 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6104 set archeads($na) {}
6108 # Update things for a new commit added that is a child of one
6109 # existing commit. Used when cherry-picking.
6110 proc addnewchild {id p} {
6111 global allids allparents allchildren idtags nextarc nbmp
6112 global arcnos arcids arctags arcout arcend arcstart archeads growing
6116 set allparents($id) [list $p]
6117 set allchildren($id) {}
6121 lappend allchildren($p) $id
6122 set a [incr nextarc]
6123 set arcstart($a) $id
6126 set arcids($a) [list $p]
6128 if {![info exists arcout($p)]} {
6131 lappend arcnos($p) $a
6132 set arcout($id) [list $a]
6135 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6136 # or 0 if neither is true.
6137 proc anc_or_desc {a b} {
6138 global arcout arcstart arcend arcnos cached_isanc
6140 if {$arcnos($a) eq $arcnos($b)} {
6141 # Both are on the same arc(s); either both are the same BMP,
6142 # or if one is not a BMP, the other is also not a BMP or is
6143 # the BMP at end of the arc (and it only has 1 incoming arc).
6147 # assert {[llength $arcnos($a)] == 1}
6148 set arc [lindex $arcnos($a) 0]
6149 set i [lsearch -exact $arcids($arc) $a]
6150 set j [lsearch -exact $arcids($arc) $b]
6151 if {$i < 0 || $i > $j} {
6158 if {![info exists arcout($a)]} {
6159 set arc [lindex $arcnos($a) 0]
6160 if {[info exists arcend($arc)]} {
6161 set aend $arcend($arc)
6165 set a $arcstart($arc)
6169 if {![info exists arcout($b)]} {
6170 set arc [lindex $arcnos($b) 0]
6171 if {[info exists arcend($arc)]} {
6172 set bend $arcend($arc)
6176 set b $arcstart($arc)
6186 if {[info exists cached_isanc($a,$bend)]} {
6187 if {$cached_isanc($a,$bend)} {
6191 if {[info exists cached_isanc($b,$aend)]} {
6192 if {$cached_isanc($b,$aend)} {
6195 if {[info exists cached_isanc($a,$bend)]} {
6200 set todo [list $a $b]
6203 for {set i 0} {$i < [llength $todo]} {incr i} {
6204 set x [lindex $todo $i]
6205 if {$anc($x) eq {}} {
6208 foreach arc $arcnos($x) {
6209 set xd $arcstart($arc)
6211 set cached_isanc($a,$bend) 1
6212 set cached_isanc($b,$aend) 0
6214 } elseif {$xd eq $aend} {
6215 set cached_isanc($b,$aend) 1
6216 set cached_isanc($a,$bend) 0
6219 if {![info exists anc($xd)]} {
6220 set anc($xd) $anc($x)
6222 } elseif {$anc($xd) ne $anc($x)} {
6227 set cached_isanc($a,$bend) 0
6228 set cached_isanc($b,$aend) 0
6232 # This identifies whether $desc has an ancestor that is
6233 # a growing tip of the graph and which is not an ancestor of $anc
6234 # and returns 0 if so and 1 if not.
6235 # If we subsequently discover a tag on such a growing tip, and that
6236 # turns out to be a descendent of $anc (which it could, since we
6237 # don't necessarily see children before parents), then $desc
6238 # isn't a good choice to display as a descendent tag of
6239 # $anc (since it is the descendent of another tag which is
6240 # a descendent of $anc). Similarly, $anc isn't a good choice to
6241 # display as a ancestor tag of $desc.
6243 proc is_certain {desc anc} {
6244 global arcnos arcout arcstart arcend growing problems
6247 if {[llength $arcnos($anc)] == 1} {
6248 # tags on the same arc are certain
6249 if {$arcnos($desc) eq $arcnos($anc)} {
6252 if {![info exists arcout($anc)]} {
6253 # if $anc is partway along an arc, use the start of the arc instead
6254 set a [lindex $arcnos($anc) 0]
6255 set anc $arcstart($a)
6258 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6261 set a [lindex $arcnos($desc) 0]
6267 set anclist [list $x]
6271 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6272 set x [lindex $anclist $i]
6277 foreach a $arcout($x) {
6278 if {[info exists growing($a)]} {
6279 if {![info exists growanc($x)] && $dl($x)} {
6285 if {[info exists dl($y)]} {
6289 if {![info exists done($y)]} {
6292 if {[info exists growanc($x)]} {
6296 for {set k 0} {$k < [llength $xl]} {incr k} {
6297 set z [lindex $xl $k]
6298 foreach c $arcout($z) {
6299 if {[info exists arcend($c)]} {
6301 if {[info exists dl($v)] && $dl($v)} {
6303 if {![info exists done($v)]} {
6306 if {[info exists growanc($v)]} {
6316 } elseif {$y eq $anc || !$dl($x)} {
6327 foreach x [array names growanc] {
6336 proc validate_arctags {a} {
6337 global arctags idtags
6341 foreach id $arctags($a) {
6343 if {![info exists idtags($id)]} {
6344 set na [lreplace $na $i $i]
6351 proc validate_archeads {a} {
6352 global archeads idheads
6355 set na $archeads($a)
6356 foreach id $archeads($a) {
6358 if {![info exists idheads($id)]} {
6359 set na [lreplace $na $i $i]
6363 set archeads($a) $na
6366 # Return the list of IDs that have tags that are descendents of id,
6367 # ignoring IDs that are descendents of IDs already reported.
6368 proc desctags {id} {
6369 global arcnos arcstart arcids arctags idtags allparents
6370 global growing cached_dtags
6372 if {![info exists allparents($id)]} {
6375 set t1 [clock clicks -milliseconds]
6377 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6378 # part-way along an arc; check that arc first
6379 set a [lindex $arcnos($id) 0]
6380 if {$arctags($a) ne {}} {
6382 set i [lsearch -exact $arcids($a) $id]
6384 foreach t $arctags($a) {
6385 set j [lsearch -exact $arcids($a) $t]
6393 set id $arcstart($a)
6394 if {[info exists idtags($id)]} {
6398 if {[info exists cached_dtags($id)]} {
6399 return $cached_dtags($id)
6406 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6407 set id [lindex $todo $i]
6409 set ta [info exists hastaggedancestor($id)]
6413 # ignore tags on starting node
6414 if {!$ta && $i > 0} {
6415 if {[info exists idtags($id)]} {
6418 } elseif {[info exists cached_dtags($id)]} {
6419 set tagloc($id) $cached_dtags($id)
6423 foreach a $arcnos($id) {
6425 if {!$ta && $arctags($a) ne {}} {
6427 if {$arctags($a) ne {}} {
6428 lappend tagloc($id) [lindex $arctags($a) end]
6431 if {$ta || $arctags($a) ne {}} {
6432 set tomark [list $d]
6433 for {set j 0} {$j < [llength $tomark]} {incr j} {
6434 set dd [lindex $tomark $j]
6435 if {![info exists hastaggedancestor($dd)]} {
6436 if {[info exists done($dd)]} {
6437 foreach b $arcnos($dd) {
6438 lappend tomark $arcstart($b)
6440 if {[info exists tagloc($dd)]} {
6443 } elseif {[info exists queued($dd)]} {
6446 set hastaggedancestor($dd) 1
6450 if {![info exists queued($d)]} {
6453 if {![info exists hastaggedancestor($d)]} {
6460 foreach id [array names tagloc] {
6461 if {![info exists hastaggedancestor($id)]} {
6462 foreach t $tagloc($id) {
6463 if {[lsearch -exact $tags $t] < 0} {
6469 set t2 [clock clicks -milliseconds]
6472 # remove tags that are descendents of other tags
6473 for {set i 0} {$i < [llength $tags]} {incr i} {
6474 set a [lindex $tags $i]
6475 for {set j 0} {$j < $i} {incr j} {
6476 set b [lindex $tags $j]
6477 set r [anc_or_desc $a $b]
6479 set tags [lreplace $tags $j $j]
6482 } elseif {$r == -1} {
6483 set tags [lreplace $tags $i $i]
6490 if {[array names growing] ne {}} {
6491 # graph isn't finished, need to check if any tag could get
6492 # eclipsed by another tag coming later. Simply ignore any
6493 # tags that could later get eclipsed.
6496 if {[is_certain $t $origid]} {
6500 if {$tags eq $ctags} {
6501 set cached_dtags($origid) $tags
6506 set cached_dtags($origid) $tags
6508 set t3 [clock clicks -milliseconds]
6509 if {0 && $t3 - $t1 >= 100} {
6510 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6511 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6517 global arcnos arcids arcout arcend arctags idtags allparents
6518 global growing cached_atags
6520 if {![info exists allparents($id)]} {
6523 set t1 [clock clicks -milliseconds]
6525 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6526 # part-way along an arc; check that arc first
6527 set a [lindex $arcnos($id) 0]
6528 if {$arctags($a) ne {}} {
6530 set i [lsearch -exact $arcids($a) $id]
6531 foreach t $arctags($a) {
6532 set j [lsearch -exact $arcids($a) $t]
6538 if {![info exists arcend($a)]} {
6542 if {[info exists idtags($id)]} {
6546 if {[info exists cached_atags($id)]} {
6547 return $cached_atags($id)
6555 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6556 set id [lindex $todo $i]
6558 set td [info exists hastaggeddescendent($id)]
6562 # ignore tags on starting node
6563 if {!$td && $i > 0} {
6564 if {[info exists idtags($id)]} {
6567 } elseif {[info exists cached_atags($id)]} {
6568 set tagloc($id) $cached_atags($id)
6572 foreach a $arcout($id) {
6573 if {!$td && $arctags($a) ne {}} {
6575 if {$arctags($a) ne {}} {
6576 lappend tagloc($id) [lindex $arctags($a) 0]
6579 if {![info exists arcend($a)]} continue
6581 if {$td || $arctags($a) ne {}} {
6582 set tomark [list $d]
6583 for {set j 0} {$j < [llength $tomark]} {incr j} {
6584 set dd [lindex $tomark $j]
6585 if {![info exists hastaggeddescendent($dd)]} {
6586 if {[info exists done($dd)]} {
6587 foreach b $arcout($dd) {
6588 if {[info exists arcend($b)]} {
6589 lappend tomark $arcend($b)
6592 if {[info exists tagloc($dd)]} {
6595 } elseif {[info exists queued($dd)]} {
6598 set hastaggeddescendent($dd) 1
6602 if {![info exists queued($d)]} {
6605 if {![info exists hastaggeddescendent($d)]} {
6611 set t2 [clock clicks -milliseconds]
6614 foreach id [array names tagloc] {
6615 if {![info exists hastaggeddescendent($id)]} {
6616 foreach t $tagloc($id) {
6617 if {[lsearch -exact $tags $t] < 0} {
6624 # remove tags that are ancestors of other tags
6625 for {set i 0} {$i < [llength $tags]} {incr i} {
6626 set a [lindex $tags $i]
6627 for {set j 0} {$j < $i} {incr j} {
6628 set b [lindex $tags $j]
6629 set r [anc_or_desc $a $b]
6631 set tags [lreplace $tags $j $j]
6634 } elseif {$r == 1} {
6635 set tags [lreplace $tags $i $i]
6642 if {[array names growing] ne {}} {
6643 # graph isn't finished, need to check if any tag could get
6644 # eclipsed by another tag coming later. Simply ignore any
6645 # tags that could later get eclipsed.
6648 if {[is_certain $origid $t]} {
6652 if {$tags eq $ctags} {
6653 set cached_atags($origid) $tags
6658 set cached_atags($origid) $tags
6660 set t3 [clock clicks -milliseconds]
6661 if {0 && $t3 - $t1 >= 100} {
6662 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6663 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6668 # Return the list of IDs that have heads that are descendents of id,
6669 # including id itself if it has a head.
6670 proc descheads {id} {
6671 global arcnos arcstart arcids archeads idheads cached_dheads
6674 if {![info exists allparents($id)]} {
6678 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6679 # part-way along an arc; check it first
6680 set a [lindex $arcnos($id) 0]
6681 if {$archeads($a) ne {}} {
6682 validate_archeads $a
6683 set i [lsearch -exact $arcids($a) $id]
6684 foreach t $archeads($a) {
6685 set j [lsearch -exact $arcids($a) $t]
6690 set id $arcstart($a)
6695 for {set i 0} {$i < [llength $todo]} {incr i} {
6696 set id [lindex $todo $i]
6697 if {[info exists cached_dheads($id)]} {
6698 set ret [concat $ret $cached_dheads($id)]
6700 if {[info exists idheads($id)]} {
6703 foreach a $arcnos($id) {
6704 if {$archeads($a) ne {}} {
6705 set ret [concat $ret $archeads($a)]
6708 if {![info exists seen($d)]} {
6715 set ret [lsort -unique $ret]
6716 set cached_dheads($origid) $ret
6719 proc addedtag {id} {
6720 global arcnos arcout cached_dtags cached_atags
6722 if {![info exists arcnos($id)]} return
6723 if {![info exists arcout($id)]} {
6724 recalcarc [lindex $arcnos($id) 0]
6726 catch {unset cached_dtags}
6727 catch {unset cached_atags}
6730 proc addedhead {hid head} {
6731 global arcnos arcout cached_dheads
6733 if {![info exists arcnos($hid)]} return
6734 if {![info exists arcout($hid)]} {
6735 recalcarc [lindex $arcnos($hid) 0]
6737 catch {unset cached_dheads}
6740 proc removedhead {hid head} {
6741 global cached_dheads
6743 catch {unset cached_dheads}
6746 proc movedhead {hid head} {
6747 global arcnos arcout cached_dheads
6749 if {![info exists arcnos($hid)]} return
6750 if {![info exists arcout($hid)]} {
6751 recalcarc [lindex $arcnos($hid) 0]
6753 catch {unset cached_dheads}
6756 proc changedrefs {} {
6757 global cached_dheads cached_dtags cached_atags
6758 global arctags archeads arcnos arcout idheads idtags
6760 foreach id [concat [array names idheads] [array names idtags]] {
6761 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6762 set a [lindex $arcnos($id) 0]
6763 if {![info exists donearc($a)]} {
6769 catch {unset cached_dtags}
6770 catch {unset cached_atags}
6771 catch {unset cached_dheads}
6774 proc rereadrefs {} {
6775 global idtags idheads idotherrefs mainhead
6777 set refids [concat [array names idtags] \
6778 [array names idheads] [array names idotherrefs]]
6779 foreach id $refids {
6780 if {![info exists ref($id)]} {
6781 set ref($id) [listrefs $id]
6784 set oldmainhead $mainhead
6787 set refids [lsort -unique [concat $refids [array names idtags] \
6788 [array names idheads] [array names idotherrefs]]]
6789 foreach id $refids {
6790 set v [listrefs $id]
6791 if {![info exists ref($id)] || $ref($id) != $v ||
6792 ($id eq $oldmainhead && $id ne $mainhead) ||
6793 ($id eq $mainhead && $id ne $oldmainhead)} {
6799 proc listrefs {id} {
6800 global idtags idheads idotherrefs
6803 if {[info exists idtags($id)]} {
6807 if {[info exists idheads($id)]} {
6811 if {[info exists idotherrefs($id)]} {
6812 set z $idotherrefs($id)
6814 return [list $x $y $z]
6817 proc showtag {tag isnew} {
6818 global ctext tagcontents tagids linknum tagobjid
6821 addtohistory [list showtag $tag 0]
6823 $ctext conf -state normal
6826 if {![info exists tagcontents($tag)]} {
6828 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6831 if {[info exists tagcontents($tag)]} {
6832 set text $tagcontents($tag)
6834 set text "Tag: $tag\nId: $tagids($tag)"
6836 appendwithlinks $text {}
6837 $ctext conf -state disabled
6849 global maxwidth maxgraphpct diffopts
6850 global oldprefs prefstop showneartags showlocalchanges
6851 global bgcolor fgcolor ctext diffcolors selectbgcolor
6852 global uifont tabstop
6856 if {[winfo exists $top]} {
6860 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6861 set oldprefs($v) [set $v]
6864 wm title $top "Gitk preferences"
6865 label $top.ldisp -text "Commit list display options"
6866 $top.ldisp configure -font $uifont
6867 grid $top.ldisp - -sticky w -pady 10
6868 label $top.spacer -text " "
6869 label $top.maxwidthl -text "Maximum graph width (lines)" \
6871 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6872 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6873 label $top.maxpctl -text "Maximum graph width (% of pane)" \
6875 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6876 grid x $top.maxpctl $top.maxpct -sticky w
6877 frame $top.showlocal
6878 label $top.showlocal.l -text "Show local changes" -font optionfont
6879 checkbutton $top.showlocal.b -variable showlocalchanges
6880 pack $top.showlocal.b $top.showlocal.l -side left
6881 grid x $top.showlocal -sticky w
6883 label $top.ddisp -text "Diff display options"
6884 $top.ddisp configure -font $uifont
6885 grid $top.ddisp - -sticky w -pady 10
6886 label $top.diffoptl -text "Options for diff program" \
6888 entry $top.diffopt -width 20 -textvariable diffopts
6889 grid x $top.diffoptl $top.diffopt -sticky w
6891 label $top.ntag.l -text "Display nearby tags" -font optionfont
6892 checkbutton $top.ntag.b -variable showneartags
6893 pack $top.ntag.b $top.ntag.l -side left
6894 grid x $top.ntag -sticky w
6895 label $top.tabstopl -text "tabstop" -font optionfont
6896 entry $top.tabstop -width 10 -textvariable tabstop
6897 grid x $top.tabstopl $top.tabstop -sticky w
6899 label $top.cdisp -text "Colors: press to choose"
6900 $top.cdisp configure -font $uifont
6901 grid $top.cdisp - -sticky w -pady 10
6902 label $top.bg -padx 40 -relief sunk -background $bgcolor
6903 button $top.bgbut -text "Background" -font optionfont \
6904 -command [list choosecolor bgcolor 0 $top.bg background setbg]
6905 grid x $top.bgbut $top.bg -sticky w
6906 label $top.fg -padx 40 -relief sunk -background $fgcolor
6907 button $top.fgbut -text "Foreground" -font optionfont \
6908 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6909 grid x $top.fgbut $top.fg -sticky w
6910 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6911 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6912 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6913 [list $ctext tag conf d0 -foreground]]
6914 grid x $top.diffoldbut $top.diffold -sticky w
6915 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6916 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6917 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6918 [list $ctext tag conf d1 -foreground]]
6919 grid x $top.diffnewbut $top.diffnew -sticky w
6920 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6921 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6922 -command [list choosecolor diffcolors 2 $top.hunksep \
6923 "diff hunk header" \
6924 [list $ctext tag conf hunksep -foreground]]
6925 grid x $top.hunksepbut $top.hunksep -sticky w
6926 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6927 button $top.selbgbut -text "Select bg" -font optionfont \
6928 -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6929 grid x $top.selbgbut $top.selbgsep -sticky w
6932 button $top.buts.ok -text "OK" -command prefsok -default active
6933 $top.buts.ok configure -font $uifont
6934 button $top.buts.can -text "Cancel" -command prefscan -default normal
6935 $top.buts.can configure -font $uifont
6936 grid $top.buts.ok $top.buts.can
6937 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6938 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6939 grid $top.buts - - -pady 10 -sticky ew
6940 bind $top <Visibility> "focus $top.buts.ok"
6943 proc choosecolor {v vi w x cmd} {
6946 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6947 -title "Gitk: choose color for $x"]
6948 if {$c eq {}} return
6949 $w conf -background $c
6955 global bglist cflist
6957 $w configure -selectbackground $c
6959 $cflist tag configure highlight \
6960 -background [$cflist cget -selectbackground]
6961 allcanvs itemconf secsel -fill $c
6968 $w conf -background $c
6976 $w conf -foreground $c
6978 allcanvs itemconf text -fill $c
6979 $canv itemconf circle -outline $c
6983 global maxwidth maxgraphpct diffopts
6984 global oldprefs prefstop showneartags showlocalchanges
6986 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6987 set $v $oldprefs($v)
6989 catch {destroy $prefstop}
6994 global maxwidth maxgraphpct
6995 global oldprefs prefstop showneartags showlocalchanges
6996 global charspc ctext tabstop
6998 catch {destroy $prefstop}
7000 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7001 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7002 if {$showlocalchanges} {
7008 if {$maxwidth != $oldprefs(maxwidth)
7009 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7011 } elseif {$showneartags != $oldprefs(showneartags)} {
7016 proc formatdate {d} {
7018 set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7023 # This list of encoding names and aliases is distilled from
7024 # http://www.iana.org/assignments/character-sets.
7025 # Not all of them are supported by Tcl.
7026 set encoding_aliases {
7027 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7028 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7029 { ISO-10646-UTF-1 csISO10646UTF1 }
7030 { ISO_646.basic:1983 ref csISO646basic1983 }
7031 { INVARIANT csINVARIANT }
7032 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7033 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7034 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7035 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7036 { NATS-DANO iso-ir-9-1 csNATSDANO }
7037 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7038 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7039 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7040 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7041 { ISO-2022-KR csISO2022KR }
7043 { ISO-2022-JP csISO2022JP }
7044 { ISO-2022-JP-2 csISO2022JP2 }
7045 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7047 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7048 { IT iso-ir-15 ISO646-IT csISO15Italian }
7049 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7050 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7051 { greek7-old iso-ir-18 csISO18Greek7Old }
7052 { latin-greek iso-ir-19 csISO19LatinGreek }
7053 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7054 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7055 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7056 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7057 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7058 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7059 { INIS iso-ir-49 csISO49INIS }
7060 { INIS-8 iso-ir-50 csISO50INIS8 }
7061 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7062 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7063 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7064 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7065 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7066 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7068 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7069 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7070 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7071 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7072 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7073 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7074 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7075 { greek7 iso-ir-88 csISO88Greek7 }
7076 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7077 { iso-ir-90 csISO90 }
7078 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7079 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7080 csISO92JISC62991984b }
7081 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7082 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7083 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7084 csISO95JIS62291984handadd }
7085 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7086 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7087 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7088 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7090 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7091 { T.61-7bit iso-ir-102 csISO102T617bit }
7092 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7093 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7094 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7095 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7096 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7097 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7098 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7099 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7100 arabic csISOLatinArabic }
7101 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7102 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7103 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7104 greek greek8 csISOLatinGreek }
7105 { T.101-G2 iso-ir-128 csISO128T101G2 }
7106 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7108 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7109 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7110 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7111 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7112 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7113 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7114 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7115 csISOLatinCyrillic }
7116 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7117 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7118 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7119 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7120 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7121 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7122 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7123 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7124 { ISO_10367-box iso-ir-155 csISO10367Box }
7125 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7126 { latin-lap lap iso-ir-158 csISO158Lap }
7127 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7128 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7131 { JIS_X0201 X0201 csHalfWidthKatakana }
7132 { KSC5636 ISO646-KR csKSC5636 }
7133 { ISO-10646-UCS-2 csUnicode }
7134 { ISO-10646-UCS-4 csUCS4 }
7135 { DEC-MCS dec csDECMCS }
7136 { hp-roman8 roman8 r8 csHPRoman8 }
7137 { macintosh mac csMacintosh }
7138 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7140 { IBM038 EBCDIC-INT cp038 csIBM038 }
7141 { IBM273 CP273 csIBM273 }
7142 { IBM274 EBCDIC-BE CP274 csIBM274 }
7143 { IBM275 EBCDIC-BR cp275 csIBM275 }
7144 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7145 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7146 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7147 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7148 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7149 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7150 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7151 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7152 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7153 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7154 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7155 { IBM437 cp437 437 csPC8CodePage437 }
7156 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7157 { IBM775 cp775 csPC775Baltic }
7158 { IBM850 cp850 850 csPC850Multilingual }
7159 { IBM851 cp851 851 csIBM851 }
7160 { IBM852 cp852 852 csPCp852 }
7161 { IBM855 cp855 855 csIBM855 }
7162 { IBM857 cp857 857 csIBM857 }
7163 { IBM860 cp860 860 csIBM860 }
7164 { IBM861 cp861 861 cp-is csIBM861 }
7165 { IBM862 cp862 862 csPC862LatinHebrew }
7166 { IBM863 cp863 863 csIBM863 }
7167 { IBM864 cp864 csIBM864 }
7168 { IBM865 cp865 865 csIBM865 }
7169 { IBM866 cp866 866 csIBM866 }
7170 { IBM868 CP868 cp-ar csIBM868 }
7171 { IBM869 cp869 869 cp-gr csIBM869 }
7172 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7173 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7174 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7175 { IBM891 cp891 csIBM891 }
7176 { IBM903 cp903 csIBM903 }
7177 { IBM904 cp904 904 csIBBM904 }
7178 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7179 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7180 { IBM1026 CP1026 csIBM1026 }
7181 { EBCDIC-AT-DE csIBMEBCDICATDE }
7182 { EBCDIC-AT-DE-A csEBCDICATDEA }
7183 { EBCDIC-CA-FR csEBCDICCAFR }
7184 { EBCDIC-DK-NO csEBCDICDKNO }
7185 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7186 { EBCDIC-FI-SE csEBCDICFISE }
7187 { EBCDIC-FI-SE-A csEBCDICFISEA }
7188 { EBCDIC-FR csEBCDICFR }
7189 { EBCDIC-IT csEBCDICIT }
7190 { EBCDIC-PT csEBCDICPT }
7191 { EBCDIC-ES csEBCDICES }
7192 { EBCDIC-ES-A csEBCDICESA }
7193 { EBCDIC-ES-S csEBCDICESS }
7194 { EBCDIC-UK csEBCDICUK }
7195 { EBCDIC-US csEBCDICUS }
7196 { UNKNOWN-8BIT csUnknown8BiT }
7197 { MNEMONIC csMnemonic }
7202 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7203 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7204 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7205 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7206 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7207 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7208 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7209 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7210 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7211 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7212 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7213 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7214 { IBM1047 IBM-1047 }
7215 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7216 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7217 { UNICODE-1-1 csUnicode11 }
7220 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7221 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7223 { ISO-8859-15 ISO_8859-15 Latin-9 }
7224 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7225 { GBK CP936 MS936 windows-936 }
7226 { JIS_Encoding csJISEncoding }
7227 { Shift_JIS MS_Kanji csShiftJIS }
7228 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7230 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7231 { ISO-10646-UCS-Basic csUnicodeASCII }
7232 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7233 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7234 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7235 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7236 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7237 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7238 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7239 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7240 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7241 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7242 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7243 { Ventura-US csVenturaUS }
7244 { Ventura-International csVenturaInternational }
7245 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7246 { PC8-Turkish csPC8Turkish }
7247 { IBM-Symbols csIBMSymbols }
7248 { IBM-Thai csIBMThai }
7249 { HP-Legal csHPLegal }
7250 { HP-Pi-font csHPPiFont }
7251 { HP-Math8 csHPMath8 }
7252 { Adobe-Symbol-Encoding csHPPSMath }
7253 { HP-DeskTop csHPDesktop }
7254 { Ventura-Math csVenturaMath }
7255 { Microsoft-Publishing csMicrosoftPublishing }
7256 { Windows-31J csWindows31J }
7261 proc tcl_encoding {enc} {
7262 global encoding_aliases
7263 set names [encoding names]
7264 set lcnames [string tolower $names]
7265 set enc [string tolower $enc]
7266 set i [lsearch -exact $lcnames $enc]
7268 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7269 if {[regsub {^iso[-_]} $enc iso encx]} {
7270 set i [lsearch -exact $lcnames $encx]
7274 foreach l $encoding_aliases {
7275 set ll [string tolower $l]
7276 if {[lsearch -exact $ll $enc] < 0} continue
7277 # look through the aliases for one that tcl knows about
7279 set i [lsearch -exact $lcnames $e]
7281 if {[regsub {^iso[-_]} $e iso ex]} {
7282 set i [lsearch -exact $lcnames $ex]
7291 return [lindex $names $i]
7298 set diffopts "-U 5 -p"
7299 set wrcomcmd "git diff-tree --stdin -p --pretty"
7303 set gitencoding [exec git config --get i18n.commitencoding]
7305 if {$gitencoding == ""} {
7306 set gitencoding "utf-8"
7308 set tclencoding [tcl_encoding $gitencoding]
7309 if {$tclencoding == {}} {
7310 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7313 set mainfont {Helvetica 9}
7314 set textfont {Courier 9}
7315 set uifont {Helvetica 9 bold}
7317 set findmergefiles 0
7325 set cmitmode "patch"
7326 set wrapcomment "none"
7330 set showlocalchanges 1
7332 set colors {green red blue magenta darkgrey brown orange}
7335 set diffcolors {red "#00a000" blue}
7336 set selectbgcolor gray85
7338 catch {source ~/.gitk}
7340 font create optionfont -family sans-serif -size -12
7344 switch -regexp -- $arg {
7346 "^-d" { set datemode 1 }
7348 lappend revtreeargs $arg
7353 # check that we can find a .git directory somewhere...
7355 if {![file isdirectory $gitdir]} {
7356 show_error {} . "Cannot find the git directory \"$gitdir\"."
7360 set cmdline_files {}
7361 set i [lsearch -exact $revtreeargs "--"]
7363 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
7364 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
7365 } elseif {$revtreeargs ne {}} {
7367 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7368 set cmdline_files [split $f "\n"]
7369 set n [llength $cmdline_files]
7370 set revtreeargs [lrange $revtreeargs 0 end-$n]
7372 # unfortunately we get both stdout and stderr in $err,
7373 # so look for "fatal:".
7374 set i [string first "fatal:" $err]
7376 set err [string range $err [expr {$i + 6}] end]
7378 show_error {} . "Bad arguments to gitk:\n$err"
7383 set nullid "0000000000000000000000000000000000000000"
7390 set highlight_paths {}
7391 set searchdirn -forwards
7401 set selectedhlview None
7410 set lookingforhead 0
7415 wm title . "[file tail $argv0]: [file tail [pwd]]"
7418 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7419 # create a view for the files/dirs specified on the command line
7423 set viewname(1) "Command line"
7424 set viewfiles(1) $cmdline_files
7425 set viewargs(1) $revtreeargs
7428 .bar.view entryconf Edit* -state normal
7429 .bar.view entryconf Delete* -state normal
7432 if {[info exists permviews]} {
7433 foreach v $permviews {
7436 set viewname($n) [lindex $v 0]
7437 set viewfiles($n) [lindex $v 1]
7438 set viewargs($n) [lindex $v 2]