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 proc start_rev_list
{view
} {
20 global startmsecs nextupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
26 set commitidx
($view) 0
27 set args
$viewargs($view)
28 if {$viewfiles($view) ne
{}} {
29 set args
[concat
$args "--" $viewfiles($view)]
31 set order
"--topo-order"
33 set order
"--date-order"
36 set fd
[open
[concat | git rev-list
--header $order \
37 --parents --boundary --default HEAD
$args] r
]
39 puts stderr
"Error executing git rev-list: $err"
43 set leftover
($view) {}
44 fconfigure
$fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure
$fd -encoding $tclencoding
48 fileevent
$fd readable
[list getcommitlines
$fd $view]
52 proc stop_rev_list
{} {
55 if {![info exists commfd
($curview)]} return
56 set fd
$commfd($curview)
62 unset commfd
($curview)
66 global phase canv mainfont curview
70 start_rev_list
$curview
71 show_status
"Reading commits..."
74 proc getcommitlines
{fd view
} {
75 global commitlisted nextupdate
76 global leftover commfd
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children curview hlview
79 global vparentlist vchildlist vdisporder vcmitlisted
81 set stuff
[read $fd 500000]
83 if {![eof
$fd]} return
87 # set it blocking so we wait for the process to terminate
88 fconfigure
$fd -blocking 1
89 if {[catch
{close
$fd} err
]} {
91 if {$view != $curview} {
92 set fv
" for the \"$viewname($view)\" view"
94 if {[string range
$err 0 4] == "usage"} {
95 set err
"Gitk: error reading commits$fv:\
96 bad arguments to git rev-list."
97 if {$viewname($view) eq
"Command line"} {
99 " (Note: arguments to gitk are passed to git rev-list\
100 to allow selection of commits to be displayed.)"
103 set err
"Error reading commits$fv: $err"
107 if {$view == $curview} {
108 after idle finishcommits
115 set i
[string first
"\0" $stuff $start]
117 append leftover
($view) [string range
$stuff $start end
]
121 set cmit
$leftover($view)
122 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
123 set leftover
($view) {}
125 set cmit
[string range
$stuff $start [expr {$i - 1}]]
127 set start
[expr {$i + 1}]
128 set j
[string first
"\n" $cmit]
132 set ids
[string range
$cmit 0 [expr {$j - 1}]]
133 if {[string range
$ids 0 0] == "-"} {
135 set ids
[string range
$ids 1 end
]
139 if {[string length
$id] != 40} {
147 if {[string length
$shortcmit] > 80} {
148 set shortcmit
"[string range $shortcmit 0 80]..."
150 error_popup
"Can't parse git rev-list output: {$shortcmit}"
153 set id
[lindex
$ids 0]
155 set olds
[lrange
$ids 1 end
]
158 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
159 lappend children
($view,$p) $id
166 if {![info exists children
($view,$id)]} {
167 set children
($view,$id) {}
169 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
170 set commitrow
($view,$id) $commitidx($view)
171 incr commitidx
($view)
172 if {$view == $curview} {
173 lappend parentlist
$olds
174 lappend childlist
$children($view,$id)
175 lappend displayorder
$id
176 lappend commitlisted
$listed
178 lappend vparentlist
($view) $olds
179 lappend vchildlist
($view) $children($view,$id)
180 lappend vdisporder
($view) $id
181 lappend vcmitlisted
($view) $listed
186 if {$view == $curview} {
187 while {[layoutmore
$nextupdate]} doupdate
188 } elseif
{[info exists hlview
] && $view == $hlview} {
192 if {[clock clicks
-milliseconds] >= $nextupdate} {
198 global commfd nextupdate numcommits
200 foreach v
[array names commfd
] {
201 fileevent
$commfd($v) readable
{}
204 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
205 foreach v
[array names commfd
] {
207 fileevent
$fd readable
[list getcommitlines
$fd $v]
211 proc readcommit
{id
} {
212 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
213 parsecommit
$id $contents 0
216 proc updatecommits
{} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
225 foreach id
$displayorder {
226 catch
{unset children
($n,$id)}
227 catch
{unset commitrow
($n,$id)}
230 catch
{unset selectedline
}
231 catch
{unset thickerline
}
232 catch
{unset viewdata
($n)}
239 proc parsecommit
{id contents listed
} {
240 global commitinfo cdate
249 set hdrend
[string first
"\n\n" $contents]
251 # should never happen...
252 set hdrend
[string length
$contents]
254 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
255 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
256 foreach line
[split $header "\n"] {
257 set tag
[lindex
$line 0]
258 if {$tag == "author"} {
259 set audate
[lindex
$line end-1
]
260 set auname
[lrange
$line 1 end-2
]
261 } elseif
{$tag == "committer"} {
262 set comdate
[lindex
$line end-1
]
263 set comname
[lrange
$line 1 end-2
]
267 # take the first line of the comment as the headline
268 set i
[string first
"\n" $comment]
270 set headline
[string trim
[string range
$comment 0 $i]]
272 set headline
$comment
275 # git rev-list indents the comment by 4 spaces;
276 # if we got this via git cat-file, add the indentation
278 foreach line
[split $comment "\n"] {
279 append newcomment
" "
280 append newcomment
$line
281 append newcomment
"\n"
283 set comment
$newcomment
285 if {$comdate != {}} {
286 set cdate
($id) $comdate
288 set commitinfo
($id) [list
$headline $auname $audate \
289 $comname $comdate $comment]
292 proc getcommit
{id
} {
293 global commitdata commitinfo
295 if {[info exists commitdata
($id)]} {
296 parsecommit
$id $commitdata($id) 1
299 if {![info exists commitinfo
($id)]} {
300 set commitinfo
($id) {"No commit information available"}
307 global tagids idtags headids idheads tagcontents
308 global otherrefids idotherrefs mainhead
310 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
313 set refd
[open
[list | git show-ref
] r
]
314 while {0 <= [set n
[gets
$refd line
]]} {
315 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
319 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
322 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
326 if {[regexp
{^remotes
/} $path match
]} {
329 if {$type == "tags"} {
330 set tagids
($name) $id
331 lappend idtags
($id) $name
336 set commit
[exec git rev-parse
"$id^0"]
337 if {$commit != $id} {
338 set tagids
($name) $commit
339 lappend idtags
($commit) $name
343 set tagcontents
($name) [exec git cat-file tag
$id]
345 } elseif
{ $type == "heads" } {
346 set headids
($name) $id
347 lappend idheads
($id) $name
349 set otherrefids
($name) $id
350 lappend idotherrefs
($id) $name
356 set thehead
[exec git symbolic-ref HEAD
]
357 if {[string match
"refs/heads/*" $thehead]} {
358 set mainhead
[string range
$thehead 11 end
]
363 # update things for a head moved to a child of its previous location
364 proc movehead
{id name
} {
365 global headids idheads
367 removehead
$headids($name) $name
368 set headids
($name) $id
369 lappend idheads
($id) $name
372 # update things when a head has been removed
373 proc removehead
{id name
} {
374 global headids idheads
376 if {$idheads($id) eq
$name} {
379 set i
[lsearch
-exact $idheads($id) $name]
381 set idheads
($id) [lreplace
$idheads($id) $i $i]
387 proc show_error
{w top msg
} {
388 message
$w.m
-text $msg -justify center
-aspect 400
389 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
390 button
$w.ok
-text OK
-command "destroy $top"
391 pack
$w.ok
-side bottom
-fill x
392 bind $top <Visibility
> "grab $top; focus $top"
393 bind $top <Key-Return
> "destroy $top"
397 proc error_popup msg
{
401 show_error
$w $w $msg
404 proc confirm_popup msg
{
410 message
$w.m
-text $msg -justify center
-aspect 400
411 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
412 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
413 pack
$w.ok
-side left
-fill x
414 button
$w.cancel
-text Cancel
-command "destroy $w"
415 pack
$w.cancel
-side right
-fill x
416 bind $w <Visibility
> "grab $w; focus $w"
422 global canv canv2 canv3 linespc charspc ctext cflist
423 global textfont mainfont uifont tabstop
424 global findtype findtypemenu findloc findstring fstring geometry
425 global entries sha1entry sha1string sha1but
426 global maincursor textcursor curtextcursor
427 global rowctxmenu mergemax wrapcomment
428 global highlight_files gdttype
429 global searchstring sstring
430 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
434 .bar add cascade
-label "File" -menu .bar.
file
435 .bar configure
-font $uifont
437 .bar.
file add
command -label "Update" -command updatecommits
438 .bar.
file add
command -label "Reread references" -command rereadrefs
439 .bar.
file add
command -label "Quit" -command doquit
440 .bar.
file configure
-font $uifont
442 .bar add cascade
-label "Edit" -menu .bar.edit
443 .bar.edit add
command -label "Preferences" -command doprefs
444 .bar.edit configure
-font $uifont
446 menu .bar.view
-font $uifont
447 .bar add cascade
-label "View" -menu .bar.view
448 .bar.view add
command -label "New view..." -command {newview
0}
449 .bar.view add
command -label "Edit view..." -command editview \
451 .bar.view add
command -label "Delete view" -command delview
-state disabled
452 .bar.view add separator
453 .bar.view add radiobutton
-label "All files" -command {showview
0} \
454 -variable selectedview
-value 0
457 .bar add cascade
-label "Help" -menu .bar.
help
458 .bar.
help add
command -label "About gitk" -command about
459 .bar.
help add
command -label "Key bindings" -command keys
460 .bar.
help configure
-font $uifont
461 . configure
-menu .bar
463 # the gui has upper and lower half, parts of a paned window.
464 panedwindow .ctop
-orient vertical
466 # possibly use assumed geometry
467 if {![info exists geometry
(pwsash0
)]} {
468 set geometry
(topheight
) [expr {15 * $linespc}]
469 set geometry
(topwidth
) [expr {80 * $charspc}]
470 set geometry
(botheight
) [expr {15 * $linespc}]
471 set geometry
(botwidth
) [expr {50 * $charspc}]
472 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
473 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
476 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
477 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
479 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
481 # create three canvases
482 set cscroll .tf.histframe.csb
483 set canv .tf.histframe.pwclist.canv
485 -selectbackground $selectbgcolor \
486 -background $bgcolor -bd 0 \
487 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
488 .tf.histframe.pwclist add
$canv
489 set canv2 .tf.histframe.pwclist.canv2
491 -selectbackground $selectbgcolor \
492 -background $bgcolor -bd 0 -yscrollincr $linespc
493 .tf.histframe.pwclist add
$canv2
494 set canv3 .tf.histframe.pwclist.canv3
496 -selectbackground $selectbgcolor \
497 -background $bgcolor -bd 0 -yscrollincr $linespc
498 .tf.histframe.pwclist add
$canv3
499 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
500 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
502 # a scroll bar to rule them
503 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
504 pack
$cscroll -side right
-fill y
505 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
506 lappend bglist
$canv $canv2 $canv3
507 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
509 # we have two button bars at bottom of top frame. Bar 1
511 frame .tf.lbar
-height 15
513 set sha1entry .tf.bar.sha1
514 set entries
$sha1entry
515 set sha1but .tf.bar.sha1label
516 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
517 -command gotocommit
-width 8 -font $uifont
518 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
519 pack .tf.bar.sha1label
-side left
520 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
521 trace add variable sha1string
write sha1change
522 pack
$sha1entry -side left
-pady 2
524 image create bitmap bm-left
-data {
525 #define left_width 16
526 #define left_height 16
527 static unsigned char left_bits
[] = {
528 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
529 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
530 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
532 image create bitmap bm-right
-data {
533 #define right_width 16
534 #define right_height 16
535 static unsigned char right_bits
[] = {
536 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
537 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
538 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
540 button .tf.bar.leftbut
-image bm-left
-command goback \
541 -state disabled
-width 26
542 pack .tf.bar.leftbut
-side left
-fill y
543 button .tf.bar.rightbut
-image bm-right
-command goforw \
544 -state disabled
-width 26
545 pack .tf.bar.rightbut
-side left
-fill y
547 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
548 pack .tf.bar.findbut
-side left
550 set fstring .tf.bar.findstring
551 lappend entries
$fstring
552 entry
$fstring -width 30 -font $textfont -textvariable findstring
553 trace add variable findstring
write find_change
554 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
556 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
557 findtype Exact IgnCase Regexp
]
558 trace add variable findtype
write find_change
559 .tf.bar.findtype configure
-font $uifont
560 .tf.bar.findtype.menu configure
-font $uifont
561 set findloc
"All fields"
562 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
563 Comments Author Committer
564 trace add variable findloc
write find_change
565 .tf.bar.findloc configure
-font $uifont
566 .tf.bar.findloc.menu configure
-font $uifont
567 pack .tf.bar.findloc
-side right
568 pack .tf.bar.findtype
-side right
570 # build up the bottom bar of upper window
571 label .tf.lbar.flabel
-text "Highlight: Commits " \
573 pack .tf.lbar.flabel
-side left
-fill y
574 set gdttype
"touching paths:"
575 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
576 "adding/removing string:"]
577 trace add variable gdttype
write hfiles_change
578 $gm conf
-font $uifont
579 .tf.lbar.gdttype conf
-font $uifont
580 pack .tf.lbar.gdttype
-side left
-fill y
581 entry .tf.lbar.fent
-width 25 -font $textfont \
582 -textvariable highlight_files
583 trace add variable highlight_files
write hfiles_change
584 lappend entries .tf.lbar.fent
585 pack .tf.lbar.fent
-side left
-fill x
-expand 1
586 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
587 pack .tf.lbar.vlabel
-side left
-fill y
588 global viewhlmenu selectedhlview
589 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
590 $viewhlmenu entryconf None
-command delvhighlight
591 $viewhlmenu conf
-font $uifont
592 .tf.lbar.vhl conf
-font $uifont
593 pack .tf.lbar.vhl
-side left
-fill y
594 label .tf.lbar.rlabel
-text " OR " -font $uifont
595 pack .tf.lbar.rlabel
-side left
-fill y
596 global highlight_related
597 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
598 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
599 $m conf
-font $uifont
600 .tf.lbar.relm conf
-font $uifont
601 trace add variable highlight_related
write vrel_change
602 pack .tf.lbar.relm
-side left
-fill y
604 # Finish putting the upper half of the viewer together
605 pack .tf.lbar
-in .tf
-side bottom
-fill x
606 pack .tf.bar
-in .tf
-side bottom
-fill x
607 pack .tf.histframe
-fill both
-side top
-expand 1
609 .ctop paneconfigure .tf
-height $geometry(topheight
)
610 .ctop paneconfigure .tf
-width $geometry(topwidth
)
612 # now build up the bottom
613 panedwindow .pwbottom
-orient horizontal
615 # lower left, a text box over search bar, scroll bar to the right
616 # if we know window height, then that will set the lower text height, otherwise
617 # we set lower text height which will drive window height
618 if {[info exists geometry
(main
)]} {
619 frame .bleft
-width $geometry(botwidth
)
621 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
626 button .bleft.top.search
-text "Search" -command dosearch \
628 pack .bleft.top.search
-side left
-padx 5
629 set sstring .bleft.top.sstring
630 entry
$sstring -width 20 -font $textfont -textvariable searchstring
631 lappend entries
$sstring
632 trace add variable searchstring
write incrsearch
633 pack
$sstring -side left
-expand 1 -fill x
634 radiobutton .bleft.mid.
diff -text "Diff" \
635 -command changediffdisp
-variable diffelide
-value {0 0}
636 radiobutton .bleft.mid.old
-text "Old version" \
637 -command changediffdisp
-variable diffelide
-value {0 1}
638 radiobutton .bleft.mid.new
-text "New version" \
639 -command changediffdisp
-variable diffelide
-value {1 0}
640 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
641 set ctext .bleft.ctext
642 text
$ctext -background $bgcolor -foreground $fgcolor \
643 -tabs "[expr {$tabstop * $charspc}]" \
644 -state disabled
-font $textfont \
645 -yscrollcommand scrolltext
-wrap none
646 scrollbar .bleft.sb
-command "$ctext yview"
647 pack .bleft.top
-side top
-fill x
648 pack .bleft.mid
-side top
-fill x
649 pack .bleft.sb
-side right
-fill y
650 pack
$ctext -side left
-fill both
-expand 1
651 lappend bglist
$ctext
652 lappend fglist
$ctext
654 $ctext tag conf comment
-wrap $wrapcomment
655 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
656 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
657 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
658 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
659 $ctext tag conf m0
-fore red
660 $ctext tag conf m1
-fore blue
661 $ctext tag conf m2
-fore green
662 $ctext tag conf m3
-fore purple
663 $ctext tag conf
m4 -fore brown
664 $ctext tag conf m5
-fore "#009090"
665 $ctext tag conf m6
-fore magenta
666 $ctext tag conf m7
-fore "#808000"
667 $ctext tag conf m8
-fore "#009000"
668 $ctext tag conf m9
-fore "#ff0080"
669 $ctext tag conf m10
-fore cyan
670 $ctext tag conf m11
-fore "#b07070"
671 $ctext tag conf m12
-fore "#70b0f0"
672 $ctext tag conf m13
-fore "#70f0b0"
673 $ctext tag conf m14
-fore "#f0b070"
674 $ctext tag conf m15
-fore "#ff70b0"
675 $ctext tag conf mmax
-fore darkgrey
677 $ctext tag conf mresult
-font [concat
$textfont bold
]
678 $ctext tag conf msep
-font [concat
$textfont bold
]
679 $ctext tag conf found
-back yellow
682 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
687 radiobutton .bright.mode.
patch -text "Patch" \
688 -command reselectline
-variable cmitmode
-value "patch"
689 .bright.mode.
patch configure
-font $uifont
690 radiobutton .bright.mode.tree
-text "Tree" \
691 -command reselectline
-variable cmitmode
-value "tree"
692 .bright.mode.tree configure
-font $uifont
693 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
694 pack .bright.mode
-side top
-fill x
695 set cflist .bright.cfiles
696 set indent
[font measure
$mainfont "nn"]
698 -selectbackground $selectbgcolor \
699 -background $bgcolor -foreground $fgcolor \
701 -tabs [list
$indent [expr {2 * $indent}]] \
702 -yscrollcommand ".bright.sb set" \
703 -cursor [. cget
-cursor] \
704 -spacing1 1 -spacing3 1
705 lappend bglist
$cflist
706 lappend fglist
$cflist
707 scrollbar .bright.sb
-command "$cflist yview"
708 pack .bright.sb
-side right
-fill y
709 pack
$cflist -side left
-fill both
-expand 1
710 $cflist tag configure highlight \
711 -background [$cflist cget
-selectbackground]
712 $cflist tag configure bold
-font [concat
$mainfont bold
]
714 .pwbottom add .bright
717 # restore window position if known
718 if {[info exists geometry
(main
)]} {
719 wm geometry .
"$geometry(main)"
722 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
723 pack .ctop
-fill both
-expand 1
724 bindall
<1> {selcanvline
%W
%x
%y
}
725 #bindall <B1-Motion> {selcanvline %W %x %y}
726 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
727 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
728 bindall
<2> "canvscan mark %W %x %y"
729 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
730 bindkey
<Home
> selfirstline
731 bindkey
<End
> sellastline
732 bind .
<Key-Up
> "selnextline -1"
733 bind .
<Key-Down
> "selnextline 1"
734 bind .
<Shift-Key-Up
> "next_highlight -1"
735 bind .
<Shift-Key-Down
> "next_highlight 1"
736 bindkey
<Key-Right
> "goforw"
737 bindkey
<Key-Left
> "goback"
738 bind .
<Key-Prior
> "selnextpage -1"
739 bind .
<Key-Next
> "selnextpage 1"
740 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
741 bind .
<Control-End
> "allcanvs yview moveto 1.0"
742 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
743 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
744 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
745 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
746 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
747 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
748 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
749 bindkey p
"selnextline -1"
750 bindkey n
"selnextline 1"
753 bindkey i
"selnextline -1"
754 bindkey k
"selnextline 1"
757 bindkey b
"$ctext yview scroll -1 pages"
758 bindkey d
"$ctext yview scroll 18 units"
759 bindkey u
"$ctext yview scroll -18 units"
760 bindkey
/ {findnext
1}
761 bindkey
<Key-Return
> {findnext
0}
764 bindkey
<F5
> updatecommits
765 bind .
<Control-q
> doquit
766 bind .
<Control-f
> dofind
767 bind .
<Control-g
> {findnext
0}
768 bind .
<Control-r
> dosearchback
769 bind .
<Control-s
> dosearch
770 bind .
<Control-equal
> {incrfont
1}
771 bind .
<Control-KP_Add
> {incrfont
1}
772 bind .
<Control-minus
> {incrfont
-1}
773 bind .
<Control-KP_Subtract
> {incrfont
-1}
774 wm protocol . WM_DELETE_WINDOW doquit
775 bind .
<Button-1
> "click %W"
776 bind $fstring <Key-Return
> dofind
777 bind $sha1entry <Key-Return
> gotocommit
778 bind $sha1entry <<PasteSelection>> clearsha1
779 bind $cflist <1> {sel_flist %W %x %y; break}
780 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
781 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
783 set maincursor [. cget -cursor]
784 set textcursor [$ctext cget -cursor]
785 set curtextcursor $textcursor
787 set rowctxmenu .rowctxmenu
788 menu $rowctxmenu -tearoff 0
789 $rowctxmenu add command -label "Diff this -> selected" \
790 -command {diffvssel 0}
791 $rowctxmenu add command -label "Diff selected -> this" \
792 -command {diffvssel 1}
793 $rowctxmenu add command -label "Make patch" -command mkpatch
794 $rowctxmenu add command -label "Create tag" -command mktag
795 $rowctxmenu add command -label "Write commit to file" -command writecommit
796 $rowctxmenu add command -label "Create new branch" -command mkbranch
797 $rowctxmenu add command -label "Cherry-pick this commit" \
800 set headctxmenu .headctxmenu
801 menu $headctxmenu -tearoff 0
802 $headctxmenu add command -label "Check out this branch" \
804 $headctxmenu add command -label "Remove this branch" \
808 # mouse-2 makes all windows scan vertically, but only the one
809 # the cursor is in scans horizontally
810 proc canvscan {op w x y} {
811 global canv canv2 canv3
812 foreach c [list $canv $canv2 $canv3] {
821 proc scrollcanv {cscroll f0 f1} {
827 # when we make a key binding for the toplevel, make sure
828 # it doesn't get triggered when that key is pressed in the
829 # find string entry widget.
830 proc bindkey {ev script} {
833 set escript [bind Entry $ev]
834 if {$escript == {}} {
835 set escript [bind Entry <Key>]
838 bind $e $ev "$escript; break"
842 # set the focus back to the toplevel for any click outside
853 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
854 global stuffsaved findmergefiles maxgraphpct
855 global maxwidth showneartags
856 global viewname viewfiles viewargs viewperm nextviewnum
857 global cmitmode wrapcomment
858 global colors bgcolor fgcolor diffcolors selectbgcolor
860 if {$stuffsaved} return
861 if {![winfo viewable .]} return
863 set f [open "~/.gitk-new" w]
864 puts $f [list set mainfont $mainfont]
865 puts $f [list set textfont $textfont]
866 puts $f [list set uifont $uifont]
867 puts $f [list set tabstop $tabstop]
868 puts $f [list set findmergefiles $findmergefiles]
869 puts $f [list set maxgraphpct $maxgraphpct]
870 puts $f [list set maxwidth $maxwidth]
871 puts $f [list set cmitmode $cmitmode]
872 puts $f [list set wrapcomment $wrapcomment]
873 puts $f [list set showneartags $showneartags]
874 puts $f [list set bgcolor $bgcolor]
875 puts $f [list set fgcolor $fgcolor]
876 puts $f [list set colors $colors]
877 puts $f [list set diffcolors $diffcolors]
878 puts $f [list set selectbgcolor $selectbgcolor]
880 puts $f "set geometry(main) [wm geometry .]"
881 puts $f "set geometry(topwidth) [winfo width .tf]"
882 puts $f "set geometry(topheight) [winfo height .tf]"
883 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
884 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
885 puts $f "set geometry(botwidth) [winfo width .bleft]"
886 puts $f "set geometry(botheight) [winfo height .bleft]"
888 puts -nonewline $f "set permviews {"
889 for {set v 0} {$v < $nextviewnum} {incr v} {
891 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
896 file rename -force "~/.gitk-new" "~/.gitk"
901 proc resizeclistpanes {win w} {
903 if {[info exists oldwidth($win)]} {
904 set s0 [$win sash coord 0]
905 set s1 [$win sash coord 1]
907 set sash0 [expr {int($w/2 - 2)}]
908 set sash1 [expr {int($w*5/6 - 2)}]
910 set factor [expr {1.0 * $w / $oldwidth($win)}]
911 set sash0 [expr {int($factor * [lindex $s0 0])}]
912 set sash1 [expr {int($factor * [lindex $s1 0])}]
916 if {$sash1 < $sash0 + 20} {
917 set sash1 [expr {$sash0 + 20}]
919 if {$sash1 > $w - 10} {
920 set sash1 [expr {$w - 10}]
921 if {$sash0 > $sash1 - 20} {
922 set sash0 [expr {$sash1 - 20}]
926 $win sash place 0 $sash0 [lindex $s0 1]
927 $win sash place 1 $sash1 [lindex $s1 1]
929 set oldwidth($win) $w
932 proc resizecdetpanes {win w} {
934 if {[info exists oldwidth($win)]} {
935 set s0 [$win sash coord 0]
937 set sash0 [expr {int($w*3/4 - 2)}]
939 set factor [expr {1.0 * $w / $oldwidth($win)}]
940 set sash0 [expr {int($factor * [lindex $s0 0])}]
944 if {$sash0 > $w - 15} {
945 set sash0 [expr {$w - 15}]
948 $win sash place 0 $sash0 [lindex $s0 1]
950 set oldwidth($win) $w
954 global canv canv2 canv3
960 proc bindall {event action} {
961 global canv canv2 canv3
962 bind $canv $event $action
963 bind $canv2 $event $action
964 bind $canv3 $event $action
970 if {[winfo exists $w]} {
975 wm title $w "About gitk"
977 Gitk - a commit viewer for git
979 Copyright © 2005-2006 Paul Mackerras
981 Use and redistribute under the terms of the GNU General Public License} \
982 -justify center -aspect 400 -border 2 -bg white -relief groove
983 pack $w.m -side top -fill x -padx 2 -pady 2
984 $w.m configure -font $uifont
985 button $w.ok -text Close -command "destroy $w" -default active
986 pack $w.ok -side bottom
987 $w.ok configure -font $uifont
988 bind $w <Visibility> "focus $w.ok"
989 bind $w <Key-Escape> "destroy $w"
990 bind $w <Key-Return> "destroy $w"
996 if {[winfo exists $w]} {
1001 wm title $w "Gitk key bindings"
1002 message $w.m -text {
1006 <Home> Move to first commit
1007 <End> Move to last commit
1008 <Up>, p, i Move up one commit
1009 <Down>, n, k Move down one commit
1010 <Left>, z, j Go back in history list
1011 <Right>, x, l Go forward in history list
1012 <PageUp> Move up one page in commit list
1013 <PageDown> Move down one page in commit list
1014 <Ctrl-Home> Scroll to top of commit list
1015 <Ctrl-End> Scroll to bottom of commit list
1016 <Ctrl-Up> Scroll commit list up one line
1017 <Ctrl-Down> Scroll commit list down one line
1018 <Ctrl-PageUp> Scroll commit list up one page
1019 <Ctrl-PageDown> Scroll commit list down one page
1020 <Shift-Up> Move to previous highlighted line
1021 <Shift-Down> Move to next highlighted line
1022 <Delete>, b Scroll diff view up one page
1023 <Backspace> Scroll diff view up one page
1024 <Space> Scroll diff view down one page
1025 u Scroll diff view up 18 lines
1026 d Scroll diff view down 18 lines
1028 <Ctrl-G> Move to next find hit
1029 <Return> Move to next find hit
1030 / Move to next find hit, or redo find
1031 ? Move to previous find hit
1032 f Scroll diff view to next file
1033 <Ctrl-S> Search for next hit in diff view
1034 <Ctrl-R> Search for previous hit in diff view
1035 <Ctrl-KP+> Increase font size
1036 <Ctrl-plus> Increase font size
1037 <Ctrl-KP-> Decrease font size
1038 <Ctrl-minus> Decrease font size
1041 -justify left -bg white -border 2 -relief groove
1042 pack $w.m -side top -fill both -padx 2 -pady 2
1043 $w.m configure -font $uifont
1044 button $w.ok -text Close -command "destroy $w" -default active
1045 pack $w.ok -side bottom
1046 $w.ok configure -font $uifont
1047 bind $w <Visibility> "focus $w.ok"
1048 bind $w <Key-Escape> "destroy $w"
1049 bind $w <Key-Return> "destroy $w"
1052 # Procedures for manipulating the file list window at the
1053 # bottom right of the overall window.
1055 proc treeview {w l openlevs} {
1056 global treecontents treediropen treeheight treeparent treeindex
1066 set treecontents() {}
1067 $w conf -state normal
1069 while {[string range $f 0 $prefixend] ne $prefix} {
1070 if {$lev <= $openlevs} {
1071 $w mark set e:$treeindex($prefix) "end -1c"
1072 $w mark gravity e:$treeindex($prefix) left
1074 set treeheight($prefix) $ht
1075 incr ht [lindex $htstack end]
1076 set htstack [lreplace $htstack end end]
1077 set prefixend [lindex $prefendstack end]
1078 set prefendstack [lreplace $prefendstack end end]
1079 set prefix [string range $prefix 0 $prefixend]
1082 set tail [string range $f [expr {$prefixend+1}] end]
1083 while {[set slash [string first "/" $tail]] >= 0} {
1086 lappend prefendstack $prefixend
1087 incr prefixend [expr {$slash + 1}]
1088 set d [string range $tail 0 $slash]
1089 lappend treecontents($prefix) $d
1090 set oldprefix $prefix
1092 set treecontents($prefix) {}
1093 set treeindex($prefix) [incr ix]
1094 set treeparent($prefix) $oldprefix
1095 set tail [string range $tail [expr {$slash+1}] end]
1096 if {$lev <= $openlevs} {
1098 set treediropen($prefix) [expr {$lev < $openlevs}]
1099 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1100 $w mark set d:$ix "end -1c"
1101 $w mark gravity d:$ix left
1103 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1105 $w image create end -align center -image $bm -padx 1 \
1107 $w insert end $d [highlight_tag $prefix]
1108 $w mark set s:$ix "end -1c"
1109 $w mark gravity s:$ix left
1114 if {$lev <= $openlevs} {
1117 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1119 $w insert end $tail [highlight_tag $f]
1121 lappend treecontents($prefix) $tail
1124 while {$htstack ne {}} {
1125 set treeheight($prefix) $ht
1126 incr ht [lindex $htstack end]
1127 set htstack [lreplace $htstack end end]
1129 $w conf -state disabled
1132 proc linetoelt {l} {
1133 global treeheight treecontents
1138 foreach e $treecontents($prefix) {
1143 if {[string index $e end] eq "/"} {
1144 set n $treeheight($prefix$e)
1156 proc highlight_tree {y prefix} {
1157 global treeheight treecontents cflist
1159 foreach e $treecontents($prefix) {
1161 if {[highlight_tag $path] ne {}} {
1162 $cflist tag add bold $y.0 "$y.0 lineend"
1165 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1166 set y [highlight_tree $y $path]
1172 proc treeclosedir {w dir} {
1173 global treediropen treeheight treeparent treeindex
1175 set ix $treeindex($dir)
1176 $w conf -state normal
1177 $w delete s:$ix e:$ix
1178 set treediropen($dir) 0
1179 $w image configure a:$ix -image tri-rt
1180 $w conf -state disabled
1181 set n [expr {1 - $treeheight($dir)}]
1182 while {$dir ne {}} {
1183 incr treeheight($dir) $n
1184 set dir $treeparent($dir)
1188 proc treeopendir {w dir} {
1189 global treediropen treeheight treeparent treecontents treeindex
1191 set ix $treeindex($dir)
1192 $w conf -state normal
1193 $w image configure a:$ix -image tri-dn
1194 $w mark set e:$ix s:$ix
1195 $w mark gravity e:$ix right
1198 set n [llength $treecontents($dir)]
1199 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1202 incr treeheight($x) $n
1204 foreach e $treecontents($dir) {
1206 if {[string index $e end] eq "/"} {
1207 set iy $treeindex($de)
1208 $w mark set d:$iy e:$ix
1209 $w mark gravity d:$iy left
1210 $w insert e:$ix $str
1211 set treediropen($de) 0
1212 $w image create e:$ix -align center -image tri-rt -padx 1 \
1214 $w insert e:$ix $e [highlight_tag $de]
1215 $w mark set s:$iy e:$ix
1216 $w mark gravity s:$iy left
1217 set treeheight($de) 1
1219 $w insert e:$ix $str
1220 $w insert e:$ix $e [highlight_tag $de]
1223 $w mark gravity e:$ix left
1224 $w conf -state disabled
1225 set treediropen($dir) 1
1226 set top [lindex [split [$w index @0,0] .] 0]
1227 set ht [$w cget -height]
1228 set l [lindex [split [$w index s:$ix] .] 0]
1231 } elseif {$l + $n + 1 > $top + $ht} {
1232 set top [expr {$l + $n + 2 - $ht}]
1240 proc treeclick {w x y} {
1241 global treediropen cmitmode ctext cflist cflist_top
1243 if {$cmitmode ne "tree"} return
1244 if {![info exists cflist_top]} return
1245 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1246 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1247 $cflist tag add highlight $l.0 "$l.0 lineend"
1253 set e [linetoelt $l]
1254 if {[string index $e end] ne "/"} {
1256 } elseif {$treediropen($e)} {
1263 proc setfilelist {id} {
1264 global treefilelist cflist
1266 treeview $cflist $treefilelist($id) 0
1269 image create bitmap tri-rt -background black -foreground blue -data {
1270 #define tri-rt_width 13
1271 #define tri-rt_height 13
1272 static unsigned char tri-rt_bits[] = {
1273 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1274 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1277 #define tri-rt-mask_width 13
1278 #define tri-rt-mask_height 13
1279 static unsigned char tri-rt-mask_bits[] = {
1280 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1281 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1284 image create bitmap tri-dn -background black -foreground blue -data {
1285 #define tri-dn_width 13
1286 #define tri-dn_height 13
1287 static unsigned char tri-dn_bits[] = {
1288 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1289 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1292 #define tri-dn-mask_width 13
1293 #define tri-dn-mask_height 13
1294 static unsigned char tri-dn-mask_bits[] = {
1295 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1296 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1300 proc init_flist {first} {
1301 global cflist cflist_top selectedline difffilestart
1303 $cflist conf -state normal
1304 $cflist delete 0.0 end
1306 $cflist insert end $first
1308 $cflist tag add highlight 1.0 "1.0 lineend"
1310 catch {unset cflist_top}
1312 $cflist conf -state disabled
1313 set difffilestart {}
1316 proc highlight_tag {f} {
1317 global highlight_paths
1319 foreach p $highlight_paths {
1320 if {[string match $p $f]} {
1327 proc highlight_filelist {} {
1328 global cmitmode cflist
1330 $cflist conf -state normal
1331 if {$cmitmode ne "tree"} {
1332 set end [lindex [split [$cflist index end] .] 0]
1333 for {set l 2} {$l < $end} {incr l} {
1334 set line [$cflist get $l.0 "$l.0 lineend"]
1335 if {[highlight_tag $line] ne {}} {
1336 $cflist tag add bold $l.0 "$l.0 lineend"
1342 $cflist conf -state disabled
1345 proc unhighlight_filelist {} {
1348 $cflist conf -state normal
1349 $cflist tag remove bold 1.0 end
1350 $cflist conf -state disabled
1353 proc add_flist {fl} {
1356 $cflist conf -state normal
1358 $cflist insert end "\n"
1359 $cflist insert end $f [highlight_tag $f]
1361 $cflist conf -state disabled
1364 proc sel_flist {w x y} {
1365 global ctext difffilestart cflist cflist_top cmitmode
1367 if {$cmitmode eq "tree"} return
1368 if {![info exists cflist_top]} return
1369 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1370 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1371 $cflist tag add highlight $l.0 "$l.0 lineend"
1376 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1380 # Functions for adding and removing shell-type quoting
1382 proc shellquote {str} {
1383 if {![string match "*\['\"\\ \t]*" $str]} {
1386 if {![string match "*\['\"\\]*" $str]} {
1389 if {![string match "*'*" $str]} {
1392 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1395 proc shellarglist {l} {
1401 append str [shellquote $a]
1406 proc shelldequote {str} {
1411 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1412 append ret [string range $str $used end]
1413 set used [string length $str]
1416 set first [lindex $first 0]
1417 set ch [string index $str $first]
1418 if {$first > $used} {
1419 append ret [string range $str $used [expr {$first - 1}]]
1422 if {$ch eq " " || $ch eq "\t"} break
1425 set first [string first "'" $str $used]
1427 error "unmatched single-quote"
1429 append ret [string range $str $used [expr {$first - 1}]]
1434 if {$used >= [string length $str]} {
1435 error "trailing backslash"
1437 append ret [string index $str $used]
1442 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1443 error "unmatched double-quote"
1445 set first [lindex $first 0]
1446 set ch [string index $str $first]
1447 if {$first > $used} {
1448 append ret [string range $str $used [expr {$first - 1}]]
1451 if {$ch eq "\""} break
1453 append ret [string index $str $used]
1457 return [list $used $ret]
1460 proc shellsplit {str} {
1463 set str [string trimleft $str]
1464 if {$str eq {}} break
1465 set dq [shelldequote $str]
1466 set n [lindex $dq 0]
1467 set word [lindex $dq 1]
1468 set str [string range $str $n end]
1474 # Code to implement multiple views
1476 proc newview {ishighlight} {
1477 global nextviewnum newviewname newviewperm uifont newishighlight
1478 global newviewargs revtreeargs
1480 set newishighlight $ishighlight
1482 if {[winfo exists $top]} {
1486 set newviewname($nextviewnum) "View $nextviewnum"
1487 set newviewperm($nextviewnum) 0
1488 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1489 vieweditor $top $nextviewnum "Gitk view definition"
1494 global viewname viewperm newviewname newviewperm
1495 global viewargs newviewargs
1497 set top .gitkvedit-$curview
1498 if {[winfo exists $top]} {
1502 set newviewname($curview) $viewname($curview)
1503 set newviewperm($curview) $viewperm($curview)
1504 set newviewargs($curview) [shellarglist $viewargs($curview)]
1505 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1508 proc vieweditor {top n title} {
1509 global newviewname newviewperm viewfiles
1513 wm title $top $title
1514 label $top.nl -text "Name" -font $uifont
1515 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1516 grid $top.nl $top.name -sticky w -pady 5
1517 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1519 grid $top.perm - -pady 5 -sticky w
1520 message $top.al -aspect 1000 -font $uifont \
1521 -text "Commits to include (arguments to git rev-list):"
1522 grid $top.al - -sticky w -pady 5
1523 entry $top.args -width 50 -textvariable newviewargs($n) \
1524 -background white -font $uifont
1525 grid $top.args - -sticky ew -padx 5
1526 message $top.l -aspect 1000 -font $uifont \
1527 -text "Enter files and directories to include, one per line:"
1528 grid $top.l - -sticky w
1529 text $top.t -width 40 -height 10 -background white -font $uifont
1530 if {[info exists viewfiles($n)]} {
1531 foreach f $viewfiles($n) {
1532 $top.t insert end $f
1533 $top.t insert end "\n"
1535 $top.t delete {end - 1c} end
1536 $top.t mark set insert 0.0
1538 grid $top.t - -sticky ew -padx 5
1540 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1542 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1544 grid $top.buts.ok $top.buts.can
1545 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1546 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1547 grid $top.buts - -pady 10 -sticky ew
1551 proc doviewmenu {m first cmd op argv} {
1552 set nmenu [$m index end]
1553 for {set i $first} {$i <= $nmenu} {incr i} {
1554 if {[$m entrycget $i -command] eq $cmd} {
1555 eval $m $op $i $argv
1561 proc allviewmenus {n op args} {
1564 doviewmenu .bar.view 5 [list showview $n] $op $args
1565 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1568 proc newviewok {top n} {
1569 global nextviewnum newviewperm newviewname newishighlight
1570 global viewname viewfiles viewperm selectedview curview
1571 global viewargs newviewargs viewhlmenu
1574 set newargs [shellsplit $newviewargs($n)]
1576 error_popup "Error in commit selection arguments: $err"
1582 foreach f [split [$top.t get 0.0 end] "\n"] {
1583 set ft [string trim $f]
1588 if {![info exists viewfiles($n)]} {
1589 # creating a new view
1591 set viewname($n) $newviewname($n)
1592 set viewperm($n) $newviewperm($n)
1593 set viewfiles($n) $files
1594 set viewargs($n) $newargs
1596 if {!$newishighlight} {
1597 after idle showview $n
1599 after idle addvhighlight $n
1602 # editing an existing view
1603 set viewperm($n) $newviewperm($n)
1604 if {$newviewname($n) ne $viewname($n)} {
1605 set viewname($n) $newviewname($n)
1606 doviewmenu .bar.view 5 [list showview $n] \
1607 entryconf [list -label $viewname($n)]
1608 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1609 entryconf [list -label $viewname($n) -value $viewname($n)]
1611 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1612 set viewfiles($n) $files
1613 set viewargs($n) $newargs
1614 if {$curview == $n} {
1615 after idle updatecommits
1619 catch {destroy $top}
1623 global curview viewdata viewperm hlview selectedhlview
1625 if {$curview == 0} return
1626 if {[info exists hlview] && $hlview == $curview} {
1627 set selectedhlview None
1630 allviewmenus $curview delete
1631 set viewdata($curview) {}
1632 set viewperm($curview) 0
1636 proc addviewmenu {n} {
1637 global viewname viewhlmenu
1639 .bar.view add radiobutton -label $viewname($n) \
1640 -command [list showview $n] -variable selectedview -value $n
1641 $viewhlmenu add radiobutton -label $viewname($n) \
1642 -command [list addvhighlight $n] -variable selectedhlview
1645 proc flatten {var} {
1649 foreach i [array names $var] {
1650 lappend ret $i [set $var\($i\)]
1655 proc unflatten {var l} {
1665 global curview viewdata viewfiles
1666 global displayorder parentlist childlist rowidlist rowoffsets
1667 global colormap rowtextx commitrow nextcolor canvxmax
1668 global numcommits rowrangelist commitlisted idrowranges
1669 global selectedline currentid canv canvy0
1670 global matchinglines treediffs
1671 global pending_select phase
1672 global commitidx rowlaidout rowoptim linesegends
1673 global commfd nextupdate
1674 global selectedview selectfirst
1675 global vparentlist vchildlist vdisporder vcmitlisted
1676 global hlview selectedhlview
1678 if {$n == $curview} return
1680 if {[info exists selectedline]} {
1681 set selid $currentid
1682 set y [yc $selectedline]
1683 set ymax [lindex [$canv cget -scrollregion] 3]
1684 set span [$canv yview]
1685 set ytop [expr {[lindex $span 0] * $ymax}]
1686 set ybot [expr {[lindex $span 1] * $ymax}]
1687 if {$ytop < $y && $y < $ybot} {
1688 set yscreen [expr {$y - $ytop}]
1690 set yscreen [expr {($ybot - $ytop) / 2}]
1692 } elseif {[info exists pending_select]} {
1693 set selid $pending_select
1694 unset pending_select
1699 if {$curview >= 0} {
1700 set vparentlist($curview) $parentlist
1701 set vchildlist($curview) $childlist
1702 set vdisporder($curview) $displayorder
1703 set vcmitlisted($curview) $commitlisted
1705 set viewdata($curview) \
1706 [list $phase $rowidlist $rowoffsets $rowrangelist \
1707 [flatten idrowranges] [flatten idinlist] \
1708 $rowlaidout $rowoptim $numcommits $linesegends]
1709 } elseif {![info exists viewdata($curview)]
1710 || [lindex $viewdata($curview) 0] ne {}} {
1711 set viewdata($curview) \
1712 [list {} $rowidlist $rowoffsets $rowrangelist]
1715 catch {unset matchinglines}
1716 catch {unset treediffs}
1718 if {[info exists hlview] && $hlview == $n} {
1720 set selectedhlview None
1725 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1726 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1728 if {![info exists viewdata($n)]} {
1730 set pending_select $selid
1737 set phase [lindex $v 0]
1738 set displayorder $vdisporder($n)
1739 set parentlist $vparentlist($n)
1740 set childlist $vchildlist($n)
1741 set commitlisted $vcmitlisted($n)
1742 set rowidlist [lindex $v 1]
1743 set rowoffsets [lindex $v 2]
1744 set rowrangelist [lindex $v 3]
1746 set numcommits [llength $displayorder]
1747 catch {unset idrowranges}
1749 unflatten idrowranges [lindex $v 4]
1750 unflatten idinlist [lindex $v 5]
1751 set rowlaidout [lindex $v 6]
1752 set rowoptim [lindex $v 7]
1753 set numcommits [lindex $v 8]
1754 set linesegends [lindex $v 9]
1757 catch {unset colormap}
1758 catch {unset rowtextx}
1760 set canvxmax [$canv cget -width]
1767 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1768 set row $commitrow($n,$selid)
1769 # try to get the selected row in the same position on the screen
1770 set ymax [lindex [$canv cget -scrollregion] 3]
1771 set ytop [expr {[yc $row] - $yscreen}]
1775 set yf [expr {$ytop * 1.0 / $ymax}]
1777 allcanvs yview moveto $yf
1781 } elseif {$selid ne {}} {
1782 set pending_select $selid
1784 if {$numcommits > 0} {
1791 if {$phase eq "getcommits"} {
1792 show_status "Reading commits..."
1794 if {[info exists commfd($n)]} {
1799 } elseif {$numcommits == 0} {
1800 show_status "No commits selected"
1804 # Stuff relating to the highlighting facility
1806 proc ishighlighted {row} {
1807 global vhighlights fhighlights nhighlights rhighlights
1809 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1810 return $nhighlights($row)
1812 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1813 return $vhighlights($row)
1815 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1816 return $fhighlights($row)
1818 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1819 return $rhighlights($row)
1824 proc bolden {row font} {
1825 global canv linehtag selectedline boldrows
1827 lappend boldrows $row
1828 $canv itemconf $linehtag($row) -font $font
1829 if {[info exists selectedline] && $row == $selectedline} {
1831 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1832 -outline {{}} -tags secsel \
1833 -fill [$canv cget -selectbackground]]
1838 proc bolden_name {row font} {
1839 global canv2 linentag selectedline boldnamerows
1841 lappend boldnamerows $row
1842 $canv2 itemconf $linentag($row) -font $font
1843 if {[info exists selectedline] && $row == $selectedline} {
1844 $canv2 delete secsel
1845 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1846 -outline {{}} -tags secsel \
1847 -fill [$canv2 cget -selectbackground]]
1853 global mainfont boldrows
1856 foreach row $boldrows {
1857 if {![ishighlighted $row]} {
1858 bolden $row $mainfont
1860 lappend stillbold $row
1863 set boldrows $stillbold
1866 proc addvhighlight {n} {
1867 global hlview curview viewdata vhl_done vhighlights commitidx
1869 if {[info exists hlview]} {
1873 if {$n != $curview && ![info exists viewdata($n)]} {
1874 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1875 set vparentlist($n) {}
1876 set vchildlist($n) {}
1877 set vdisporder($n) {}
1878 set vcmitlisted($n) {}
1881 set vhl_done $commitidx($hlview)
1882 if {$vhl_done > 0} {
1887 proc delvhighlight {} {
1888 global hlview vhighlights
1890 if {![info exists hlview]} return
1892 catch {unset vhighlights}
1896 proc vhighlightmore {} {
1897 global hlview vhl_done commitidx vhighlights
1898 global displayorder vdisporder curview mainfont
1900 set font [concat $mainfont bold]
1901 set max $commitidx($hlview)
1902 if {$hlview == $curview} {
1903 set disp $displayorder
1905 set disp $vdisporder($hlview)
1907 set vr [visiblerows]
1908 set r0 [lindex $vr 0]
1909 set r1 [lindex $vr 1]
1910 for {set i $vhl_done} {$i < $max} {incr i} {
1911 set id [lindex $disp $i]
1912 if {[info exists commitrow($curview,$id)]} {
1913 set row $commitrow($curview,$id)
1914 if {$r0 <= $row && $row <= $r1} {
1915 if {![highlighted $row]} {
1918 set vhighlights($row) 1
1925 proc askvhighlight {row id} {
1926 global hlview vhighlights commitrow iddrawn mainfont
1928 if {[info exists commitrow($hlview,$id)]} {
1929 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1930 bolden $row [concat $mainfont bold]
1932 set vhighlights($row) 1
1934 set vhighlights($row) 0
1938 proc hfiles_change {name ix op} {
1939 global highlight_files filehighlight fhighlights fh_serial
1940 global mainfont highlight_paths
1942 if {[info exists filehighlight]} {
1943 # delete previous highlights
1944 catch {close $filehighlight}
1946 catch {unset fhighlights}
1948 unhighlight_filelist
1950 set highlight_paths {}
1951 after cancel do_file_hl $fh_serial
1953 if {$highlight_files ne {}} {
1954 after 300 do_file_hl $fh_serial
1958 proc makepatterns {l} {
1961 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1962 if {[string index $ee end] eq "/"} {
1972 proc do_file_hl {serial} {
1973 global highlight_files filehighlight highlight_paths gdttype fhl_list
1975 if {$gdttype eq "touching paths:"} {
1976 if {[catch {set paths [shellsplit $highlight_files]}]} return
1977 set highlight_paths [makepatterns $paths]
1979 set gdtargs [concat -- $paths]
1981 set gdtargs [list "-S$highlight_files"]
1983 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1984 set filehighlight [open $cmd r+]
1985 fconfigure $filehighlight -blocking 0
1986 fileevent $filehighlight readable readfhighlight
1992 proc flushhighlights {} {
1993 global filehighlight fhl_list
1995 if {[info exists filehighlight]} {
1997 puts $filehighlight ""
1998 flush $filehighlight
2002 proc askfilehighlight {row id} {
2003 global filehighlight fhighlights fhl_list
2005 lappend fhl_list $id
2006 set fhighlights($row) -1
2007 puts $filehighlight $id
2010 proc readfhighlight {} {
2011 global filehighlight fhighlights commitrow curview mainfont iddrawn
2014 while {[gets $filehighlight line] >= 0} {
2015 set line [string trim $line]
2016 set i [lsearch -exact $fhl_list $line]
2017 if {$i < 0} continue
2018 for {set j 0} {$j < $i} {incr j} {
2019 set id [lindex $fhl_list $j]
2020 if {[info exists commitrow($curview,$id)]} {
2021 set fhighlights($commitrow($curview,$id)) 0
2024 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2025 if {$line eq {}} continue
2026 if {![info exists commitrow($curview,$line)]} continue
2027 set row $commitrow($curview,$line)
2028 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2029 bolden $row [concat $mainfont bold]
2031 set fhighlights($row) 1
2033 if {[eof $filehighlight]} {
2035 puts "oops, git diff-tree died"
2036 catch {close $filehighlight}
2042 proc find_change {name ix op} {
2043 global nhighlights mainfont boldnamerows
2044 global findstring findpattern findtype
2046 # delete previous highlights, if any
2047 foreach row $boldnamerows {
2048 bolden_name $row $mainfont
2051 catch {unset nhighlights}
2053 if {$findtype ne "Regexp"} {
2054 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2056 set findpattern "*$e*"
2061 proc askfindhighlight {row id} {
2062 global nhighlights commitinfo iddrawn mainfont
2063 global findstring findtype findloc findpattern
2065 if {![info exists commitinfo($id)]} {
2068 set info $commitinfo($id)
2070 set fldtypes {Headline Author Date Committer CDate Comments}
2071 foreach f $info ty $fldtypes {
2072 if {$findloc ne "All fields" && $findloc ne $ty} {
2075 if {$findtype eq "Regexp"} {
2076 set doesmatch [regexp $findstring $f]
2077 } elseif {$findtype eq "IgnCase"} {
2078 set doesmatch [string match -nocase $findpattern $f]
2080 set doesmatch [string match $findpattern $f]
2083 if {$ty eq "Author"} {
2090 if {[info exists iddrawn($id)]} {
2091 if {$isbold && ![ishighlighted $row]} {
2092 bolden $row [concat $mainfont bold]
2095 bolden_name $row [concat $mainfont bold]
2098 set nhighlights($row) $isbold
2101 proc vrel_change {name ix op} {
2102 global highlight_related
2105 if {$highlight_related ne "None"} {
2106 after idle drawvisible
2110 # prepare for testing whether commits are descendents or ancestors of a
2111 proc rhighlight_sel {a} {
2112 global descendent desc_todo ancestor anc_todo
2113 global highlight_related rhighlights
2115 catch {unset descendent}
2116 set desc_todo [list $a]
2117 catch {unset ancestor}
2118 set anc_todo [list $a]
2119 if {$highlight_related ne "None"} {
2121 after idle drawvisible
2125 proc rhighlight_none {} {
2128 catch {unset rhighlights}
2132 proc is_descendent {a} {
2133 global curview children commitrow descendent desc_todo
2136 set la $commitrow($v,$a)
2140 for {set i 0} {$i < [llength $todo]} {incr i} {
2141 set do [lindex $todo $i]
2142 if {$commitrow($v,$do) < $la} {
2143 lappend leftover $do
2146 foreach nk $children($v,$do) {
2147 if {![info exists descendent($nk)]} {
2148 set descendent($nk) 1
2156 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2160 set descendent($a) 0
2161 set desc_todo $leftover
2164 proc is_ancestor {a} {
2165 global curview parentlist commitrow ancestor anc_todo
2168 set la $commitrow($v,$a)
2172 for {set i 0} {$i < [llength $todo]} {incr i} {
2173 set do [lindex $todo $i]
2174 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2175 lappend leftover $do
2178 foreach np [lindex $parentlist $commitrow($v,$do)] {
2179 if {![info exists ancestor($np)]} {
2188 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2193 set anc_todo $leftover
2196 proc askrelhighlight {row id} {
2197 global descendent highlight_related iddrawn mainfont rhighlights
2198 global selectedline ancestor
2200 if {![info exists selectedline]} return
2202 if {$highlight_related eq "Descendent" ||
2203 $highlight_related eq "Not descendent"} {
2204 if {![info exists descendent($id)]} {
2207 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2210 } elseif {$highlight_related eq "Ancestor" ||
2211 $highlight_related eq "Not ancestor"} {
2212 if {![info exists ancestor($id)]} {
2215 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2219 if {[info exists iddrawn($id)]} {
2220 if {$isbold && ![ishighlighted $row]} {
2221 bolden $row [concat $mainfont bold]
2224 set rhighlights($row) $isbold
2227 proc next_hlcont {} {
2228 global fhl_row fhl_dirn displayorder numcommits
2229 global vhighlights fhighlights nhighlights rhighlights
2230 global hlview filehighlight findstring highlight_related
2232 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2235 if {$row < 0 || $row >= $numcommits} {
2240 set id [lindex $displayorder $row]
2241 if {[info exists hlview]} {
2242 if {![info exists vhighlights($row)]} {
2243 askvhighlight $row $id
2245 if {$vhighlights($row) > 0} break
2247 if {$findstring ne {}} {
2248 if {![info exists nhighlights($row)]} {
2249 askfindhighlight $row $id
2251 if {$nhighlights($row) > 0} break
2253 if {$highlight_related ne "None"} {
2254 if {![info exists rhighlights($row)]} {
2255 askrelhighlight $row $id
2257 if {$rhighlights($row) > 0} break
2259 if {[info exists filehighlight]} {
2260 if {![info exists fhighlights($row)]} {
2261 # ask for a few more while we're at it...
2263 for {set n 0} {$n < 100} {incr n} {
2264 if {![info exists fhighlights($r)]} {
2265 askfilehighlight $r [lindex $displayorder $r]
2268 if {$r < 0 || $r >= $numcommits} break
2272 if {$fhighlights($row) < 0} {
2276 if {$fhighlights($row) > 0} break
2284 proc next_highlight {dirn} {
2285 global selectedline fhl_row fhl_dirn
2286 global hlview filehighlight findstring highlight_related
2288 if {![info exists selectedline]} return
2289 if {!([info exists hlview] || $findstring ne {} ||
2290 $highlight_related ne "None" || [info exists filehighlight])} return
2291 set fhl_row [expr {$selectedline + $dirn}]
2296 proc cancel_next_highlight {} {
2302 # Graph layout functions
2304 proc shortids {ids} {
2307 if {[llength $id] > 1} {
2308 lappend res [shortids $id]
2309 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2310 lappend res [string range $id 0 7]
2318 proc incrange {l x o} {
2321 set e [lindex $l $x]
2323 lset l $x [expr {$e + $o}]
2332 for {} {$n > 0} {incr n -1} {
2338 proc usedinrange {id l1 l2} {
2339 global children commitrow childlist curview
2341 if {[info exists commitrow($curview,$id)]} {
2342 set r $commitrow($curview,$id)
2343 if {$l1 <= $r && $r <= $l2} {
2344 return [expr {$r - $l1 + 1}]
2346 set kids [lindex $childlist $r]
2348 set kids $children($curview,$id)
2351 set r $commitrow($curview,$c)
2352 if {$l1 <= $r && $r <= $l2} {
2353 return [expr {$r - $l1 + 1}]
2359 proc sanity {row {full 0}} {
2360 global rowidlist rowoffsets
2363 set ids [lindex $rowidlist $row]
2366 if {$id eq {}} continue
2367 if {$col < [llength $ids] - 1 &&
2368 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2369 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2371 set o [lindex $rowoffsets $row $col]
2377 if {[lindex $rowidlist $y $x] != $id} {
2378 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2379 puts " id=[shortids $id] check started at row $row"
2380 for {set i $row} {$i >= $y} {incr i -1} {
2381 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2386 set o [lindex $rowoffsets $y $x]
2391 proc makeuparrow {oid x y z} {
2392 global rowidlist rowoffsets uparrowlen idrowranges
2394 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2397 set off0 [lindex $rowoffsets $y]
2398 for {set x0 $x} {1} {incr x0} {
2399 if {$x0 >= [llength $off0]} {
2400 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2403 set z [lindex $off0 $x0]
2409 set z [expr {$x0 - $x}]
2410 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2411 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2413 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2414 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2415 lappend idrowranges($oid) $y
2418 proc initlayout {} {
2419 global rowidlist rowoffsets displayorder commitlisted
2420 global rowlaidout rowoptim
2421 global idinlist rowchk rowrangelist idrowranges
2422 global numcommits canvxmax canv
2424 global parentlist childlist children
2425 global colormap rowtextx
2426 global linesegends selectfirst
2437 catch {unset idinlist}
2438 catch {unset rowchk}
2441 set canvxmax [$canv cget -width]
2442 catch {unset colormap}
2443 catch {unset rowtextx}
2444 catch {unset idrowranges}
2449 proc setcanvscroll {} {
2450 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2452 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2453 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2454 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2455 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2458 proc visiblerows {} {
2459 global canv numcommits linespc
2461 set ymax [lindex [$canv cget -scrollregion] 3]
2462 if {$ymax eq {} || $ymax == 0} return
2464 set y0 [expr {int([lindex $f 0] * $ymax)}]
2465 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2469 set y1 [expr {int([lindex $f 1] * $ymax)}]
2470 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2471 if {$r1 >= $numcommits} {
2472 set r1 [expr {$numcommits - 1}]
2474 return [list $r0 $r1]
2477 proc layoutmore {tmax} {
2478 global rowlaidout rowoptim commitidx numcommits optim_delay
2479 global uparrowlen curview
2482 if {$rowoptim - $optim_delay > $numcommits} {
2483 showstuff [expr {$rowoptim - $optim_delay}]
2484 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2485 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2489 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2491 } elseif {$commitidx($curview) > $rowlaidout} {
2492 set nr [expr {$commitidx($curview) - $rowlaidout}]
2493 # may need to increase this threshold if uparrowlen or
2494 # mingaplen are increased...
2499 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2500 if {$rowlaidout == $row} {
2506 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2512 proc showstuff {canshow} {
2513 global numcommits commitrow pending_select selectedline
2514 global linesegends idrowranges idrangedrawn curview
2515 global displayorder selectfirst
2517 if {$numcommits == 0} {
2519 set phase "incrdraw"
2523 set numcommits $canshow
2525 set rows [visiblerows]
2526 set r0 [lindex $rows 0]
2527 set r1 [lindex $rows 1]
2529 for {set r $row} {$r < $canshow} {incr r} {
2530 foreach id [lindex $linesegends [expr {$r+1}]] {
2532 foreach {s e} [rowranges $id] {
2534 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2535 && ![info exists idrangedrawn($id,$i)]} {
2537 set idrangedrawn($id,$i) 1
2542 if {$canshow > $r1} {
2545 while {$row < $canshow} {
2549 if {[info exists pending_select] &&
2550 [info exists commitrow($curview,$pending_select)] &&
2551 $commitrow($curview,$pending_select) < $numcommits} {
2552 selectline $commitrow($curview,$pending_select) 1
2555 if {[info exists selectedline] || [info exists pending_select]} {
2564 proc layoutrows {row endrow last} {
2565 global rowidlist rowoffsets displayorder
2566 global uparrowlen downarrowlen maxwidth mingaplen
2567 global childlist parentlist
2568 global idrowranges linesegends
2569 global commitidx curview
2570 global idinlist rowchk rowrangelist
2572 set idlist [lindex $rowidlist $row]
2573 set offs [lindex $rowoffsets $row]
2574 while {$row < $endrow} {
2575 set id [lindex $displayorder $row]
2578 foreach p [lindex $parentlist $row] {
2579 if {![info exists idinlist($p)]} {
2581 } elseif {!$idinlist($p)} {
2586 set nev [expr {[llength $idlist] + [llength $newolds]
2587 + [llength $oldolds] - $maxwidth + 1}]
2590 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2591 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2592 set i [lindex $idlist $x]
2593 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2594 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2595 [expr {$row + $uparrowlen + $mingaplen}]]
2597 set idlist [lreplace $idlist $x $x]
2598 set offs [lreplace $offs $x $x]
2599 set offs [incrange $offs $x 1]
2601 set rm1 [expr {$row - 1}]
2603 lappend idrowranges($i) $rm1
2604 if {[incr nev -1] <= 0} break
2607 set rowchk($id) [expr {$row + $r}]
2610 lset rowidlist $row $idlist
2611 lset rowoffsets $row $offs
2613 lappend linesegends $lse
2614 set col [lsearch -exact $idlist $id]
2616 set col [llength $idlist]
2618 lset rowidlist $row $idlist
2620 if {[lindex $childlist $row] ne {}} {
2621 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2625 lset rowoffsets $row $offs
2627 makeuparrow $id $col $row $z
2633 if {[info exists idrowranges($id)]} {
2634 set ranges $idrowranges($id)
2636 unset idrowranges($id)
2638 lappend rowrangelist $ranges
2640 set offs [ntimes [llength $idlist] 0]
2641 set l [llength $newolds]
2642 set idlist [eval lreplace \$idlist $col $col $newolds]
2645 set offs [lrange $offs 0 [expr {$col - 1}]]
2646 foreach x $newolds {
2651 set tmp [expr {[llength $idlist] - [llength $offs]}]
2653 set offs [concat $offs [ntimes $tmp $o]]
2658 foreach i $newolds {
2660 set idrowranges($i) $row
2663 foreach oid $oldolds {
2664 set idinlist($oid) 1
2665 set idlist [linsert $idlist $col $oid]
2666 set offs [linsert $offs $col $o]
2667 makeuparrow $oid $col $row $o
2670 lappend rowidlist $idlist
2671 lappend rowoffsets $offs
2676 proc addextraid {id row} {
2677 global displayorder commitrow commitinfo
2678 global commitidx commitlisted
2679 global parentlist childlist children curview
2681 incr commitidx($curview)
2682 lappend displayorder $id
2683 lappend commitlisted 0
2684 lappend parentlist {}
2685 set commitrow($curview,$id) $row
2687 if {![info exists commitinfo($id)]} {
2688 set commitinfo($id) {"No commit information available"}
2690 if {![info exists children($curview,$id)]} {
2691 set children($curview,$id) {}
2693 lappend childlist $children($curview,$id)
2696 proc layouttail {} {
2697 global rowidlist rowoffsets idinlist commitidx curview
2698 global idrowranges rowrangelist
2700 set row $commitidx($curview)
2701 set idlist [lindex $rowidlist $row]
2702 while {$idlist ne {}} {
2703 set col [expr {[llength $idlist] - 1}]
2704 set id [lindex $idlist $col]
2707 lappend idrowranges($id) $row
2708 lappend rowrangelist $idrowranges($id)
2709 unset idrowranges($id)
2711 set offs [ntimes $col 0]
2712 set idlist [lreplace $idlist $col $col]
2713 lappend rowidlist $idlist
2714 lappend rowoffsets $offs
2717 foreach id [array names idinlist] {
2719 lset rowidlist $row [list $id]
2720 lset rowoffsets $row 0
2721 makeuparrow $id 0 $row 0
2722 lappend idrowranges($id) $row
2723 lappend rowrangelist $idrowranges($id)
2724 unset idrowranges($id)
2726 lappend rowidlist {}
2727 lappend rowoffsets {}
2731 proc insert_pad {row col npad} {
2732 global rowidlist rowoffsets
2734 set pad [ntimes $npad {}]
2735 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2736 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2737 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2740 proc optimize_rows {row col endrow} {
2741 global rowidlist rowoffsets idrowranges displayorder
2743 for {} {$row < $endrow} {incr row} {
2744 set idlist [lindex $rowidlist $row]
2745 set offs [lindex $rowoffsets $row]
2747 for {} {$col < [llength $offs]} {incr col} {
2748 if {[lindex $idlist $col] eq {}} {
2752 set z [lindex $offs $col]
2753 if {$z eq {}} continue
2755 set x0 [expr {$col + $z}]
2756 set y0 [expr {$row - 1}]
2757 set z0 [lindex $rowoffsets $y0 $x0]
2759 set id [lindex $idlist $col]
2760 set ranges [rowranges $id]
2761 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2765 # Looking at lines from this row to the previous row,
2766 # make them go straight up if they end in an arrow on
2767 # the previous row; otherwise make them go straight up
2769 if {$z < -1 || ($z < 0 && $isarrow)} {
2770 # Line currently goes left too much;
2771 # insert pads in the previous row, then optimize it
2772 set npad [expr {-1 - $z + $isarrow}]
2773 set offs [incrange $offs $col $npad]
2774 insert_pad $y0 $x0 $npad
2776 optimize_rows $y0 $x0 $row
2778 set z [lindex $offs $col]
2779 set x0 [expr {$col + $z}]
2780 set z0 [lindex $rowoffsets $y0 $x0]
2781 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2782 # Line currently goes right too much;
2783 # insert pads in this line and adjust the next's rowoffsets
2784 set npad [expr {$z - 1 + $isarrow}]
2785 set y1 [expr {$row + 1}]
2786 set offs2 [lindex $rowoffsets $y1]
2790 if {$z eq {} || $x1 + $z < $col} continue
2791 if {$x1 + $z > $col} {
2794 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2797 set pad [ntimes $npad {}]
2798 set idlist [eval linsert \$idlist $col $pad]
2799 set tmp [eval linsert \$offs $col $pad]
2801 set offs [incrange $tmp $col [expr {-$npad}]]
2802 set z [lindex $offs $col]
2805 if {$z0 eq {} && !$isarrow} {
2806 # this line links to its first child on row $row-2
2807 set rm2 [expr {$row - 2}]
2808 set id [lindex $displayorder $rm2]
2809 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2811 set z0 [expr {$xc - $x0}]
2814 # avoid lines jigging left then immediately right
2815 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2816 insert_pad $y0 $x0 1
2817 set offs [incrange $offs $col 1]
2818 optimize_rows $y0 [expr {$x0 + 1}] $row
2823 # Find the first column that doesn't have a line going right
2824 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2825 set o [lindex $offs $col]
2827 # check if this is the link to the first child
2828 set id [lindex $idlist $col]
2829 set ranges [rowranges $id]
2830 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2831 # it is, work out offset to child
2832 set y0 [expr {$row - 1}]
2833 set id [lindex $displayorder $y0]
2834 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2836 set o [expr {$x0 - $col}]
2840 if {$o eq {} || $o <= 0} break
2842 # Insert a pad at that column as long as it has a line and
2843 # isn't the last column, and adjust the next row' offsets
2844 if {$o ne {} && [incr col] < [llength $idlist]} {
2845 set y1 [expr {$row + 1}]
2846 set offs2 [lindex $rowoffsets $y1]
2850 if {$z eq {} || $x1 + $z < $col} continue
2851 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2854 set idlist [linsert $idlist $col {}]
2855 set tmp [linsert $offs $col {}]
2857 set offs [incrange $tmp $col -1]
2860 lset rowidlist $row $idlist
2861 lset rowoffsets $row $offs
2867 global canvx0 linespc
2868 return [expr {$canvx0 + $col * $linespc}]
2872 global canvy0 linespc
2873 return [expr {$canvy0 + $row * $linespc}]
2876 proc linewidth {id} {
2877 global thickerline lthickness
2880 if {[info exists thickerline] && $id eq $thickerline} {
2881 set wid [expr {2 * $lthickness}]
2886 proc rowranges {id} {
2887 global phase idrowranges commitrow rowlaidout rowrangelist curview
2891 ([info exists commitrow($curview,$id)]
2892 && $commitrow($curview,$id) < $rowlaidout)} {
2893 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2894 } elseif {[info exists idrowranges($id)]} {
2895 set ranges $idrowranges($id)
2900 proc drawlineseg {id i} {
2901 global rowoffsets rowidlist
2903 global canv colormap linespc
2904 global numcommits commitrow curview
2906 set ranges [rowranges $id]
2908 if {[info exists commitrow($curview,$id)]
2909 && $commitrow($curview,$id) < $numcommits} {
2910 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2914 set startrow [lindex $ranges [expr {2 * $i}]]
2915 set row [lindex $ranges [expr {2 * $i + 1}]]
2916 if {$startrow == $row} return
2919 set col [lsearch -exact [lindex $rowidlist $row] $id]
2921 puts "oops: drawline: id $id not on row $row"
2927 set o [lindex $rowoffsets $row $col]
2930 # changing direction
2931 set x [xc $row $col]
2933 lappend coords $x $y
2939 set x [xc $row $col]
2941 lappend coords $x $y
2943 # draw the link to the first child as part of this line
2945 set child [lindex $displayorder $row]
2946 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2948 set x [xc $row $ccol]
2950 if {$ccol < $col - 1} {
2951 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2952 } elseif {$ccol > $col + 1} {
2953 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2955 lappend coords $x $y
2958 if {[llength $coords] < 4} return
2960 # This line has an arrow at the lower end: check if the arrow is
2961 # on a diagonal segment, and if so, work around the Tk 8.4
2962 # refusal to draw arrows on diagonal lines.
2963 set x0 [lindex $coords 0]
2964 set x1 [lindex $coords 2]
2966 set y0 [lindex $coords 1]
2967 set y1 [lindex $coords 3]
2968 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2969 # we have a nearby vertical segment, just trim off the diag bit
2970 set coords [lrange $coords 2 end]
2972 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2973 set xi [expr {$x0 - $slope * $linespc / 2}]
2974 set yi [expr {$y0 - $linespc / 2}]
2975 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2979 set arrow [expr {2 * ($i > 0) + $downarrow}]
2980 set arrow [lindex {none first last both} $arrow]
2981 set t [$canv create line $coords -width [linewidth $id] \
2982 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2987 proc drawparentlinks {id row col olds} {
2988 global rowidlist canv colormap
2990 set row2 [expr {$row + 1}]
2991 set x [xc $row $col]
2994 set ids [lindex $rowidlist $row2]
2995 # rmx = right-most X coord used
2998 set i [lsearch -exact $ids $p]
3000 puts "oops, parent $p of $id not in list"
3003 set x2 [xc $row2 $i]
3007 set ranges [rowranges $p]
3008 if {$ranges ne {} && $row2 == [lindex $ranges 0]
3009 && $row2 < [lindex $ranges 1]} {
3010 # drawlineseg will do this one for us
3014 # should handle duplicated parents here...
3015 set coords [list $x $y]
3016 if {$i < $col - 1} {
3017 lappend coords [xc $row [expr {$i + 1}]] $y
3018 } elseif {$i > $col + 1} {
3019 lappend coords [xc $row [expr {$i - 1}]] $y
3021 lappend coords $x2 $y2
3022 set t [$canv create line $coords -width [linewidth $p] \
3023 -fill $colormap($p) -tags lines.$p]
3030 proc drawlines {id} {
3031 global colormap canv
3033 global children iddrawn commitrow rowidlist curview
3035 $canv delete lines.$id
3036 set nr [expr {[llength [rowranges $id]] / 2}]
3037 for {set i 0} {$i < $nr} {incr i} {
3038 if {[info exists idrangedrawn($id,$i)]} {
3042 foreach child $children($curview,$id) {
3043 if {[info exists iddrawn($child)]} {
3044 set row $commitrow($curview,$child)
3045 set col [lsearch -exact [lindex $rowidlist $row] $child]
3047 drawparentlinks $child $row $col [list $id]
3053 proc drawcmittext {id row col rmx} {
3054 global linespc canv canv2 canv3 canvy0 fgcolor
3055 global commitlisted commitinfo rowidlist
3056 global rowtextx idpos idtags idheads idotherrefs
3057 global linehtag linentag linedtag
3058 global mainfont canvxmax boldrows boldnamerows fgcolor
3060 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3061 set x [xc $row $col]
3063 set orad [expr {$linespc / 3}]
3064 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3065 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3066 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3068 $canv bind $t <1> {selcanvline {} %x %y}
3069 set xt [xc $row [llength [lindex $rowidlist $row]]]
3073 set rowtextx($row) $xt
3074 set idpos($id) [list $x $xt $y]
3075 if {[info exists idtags($id)] || [info exists idheads($id)]
3076 || [info exists idotherrefs($id)]} {
3077 set xt [drawtags $id $x $xt $y]
3079 set headline [lindex $commitinfo($id) 0]
3080 set name [lindex $commitinfo($id) 1]
3081 set date [lindex $commitinfo($id) 2]
3082 set date [formatdate $date]
3085 set isbold [ishighlighted $row]
3087 lappend boldrows $row
3090 lappend boldnamerows $row
3094 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3095 -text $headline -font $font -tags text]
3096 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3097 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3098 -text $name -font $nfont -tags text]
3099 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3100 -text $date -font $mainfont -tags text]
3101 set xr [expr {$xt + [font measure $mainfont $headline]}]
3102 if {$xr > $canvxmax} {
3108 proc drawcmitrow {row} {
3109 global displayorder rowidlist
3110 global idrangedrawn iddrawn
3111 global commitinfo parentlist numcommits
3112 global filehighlight fhighlights findstring nhighlights
3113 global hlview vhighlights
3114 global highlight_related rhighlights
3116 if {$row >= $numcommits} return
3117 foreach id [lindex $rowidlist $row] {
3118 if {$id eq {}} continue
3120 foreach {s e} [rowranges $id] {
3122 if {$row < $s} continue
3125 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3127 set idrangedrawn($id,$i) 1
3134 set id [lindex $displayorder $row]
3135 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3136 askvhighlight $row $id
3138 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3139 askfilehighlight $row $id
3141 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3142 askfindhighlight $row $id
3144 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3145 askrelhighlight $row $id
3147 if {[info exists iddrawn($id)]} return
3148 set col [lsearch -exact [lindex $rowidlist $row] $id]
3150 puts "oops, row $row id $id not in list"
3153 if {![info exists commitinfo($id)]} {
3157 set olds [lindex $parentlist $row]
3159 set rmx [drawparentlinks $id $row $col $olds]
3163 drawcmittext $id $row $col $rmx
3167 proc drawfrac {f0 f1} {
3168 global numcommits canv
3171 set ymax [lindex [$canv cget -scrollregion] 3]
3172 if {$ymax eq {} || $ymax == 0} return
3173 set y0 [expr {int($f0 * $ymax)}]
3174 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3178 set y1 [expr {int($f1 * $ymax)}]
3179 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3180 if {$endrow >= $numcommits} {
3181 set endrow [expr {$numcommits - 1}]
3183 for {} {$row <= $endrow} {incr row} {
3188 proc drawvisible {} {
3190 eval drawfrac [$canv yview]
3193 proc clear_display {} {
3194 global iddrawn idrangedrawn
3195 global vhighlights fhighlights nhighlights rhighlights
3198 catch {unset iddrawn}
3199 catch {unset idrangedrawn}
3200 catch {unset vhighlights}
3201 catch {unset fhighlights}
3202 catch {unset nhighlights}
3203 catch {unset rhighlights}
3206 proc findcrossings {id} {
3207 global rowidlist parentlist numcommits rowoffsets displayorder
3211 foreach {s e} [rowranges $id] {
3212 if {$e >= $numcommits} {
3213 set e [expr {$numcommits - 1}]
3215 if {$e <= $s} continue
3216 set x [lsearch -exact [lindex $rowidlist $e] $id]
3218 puts "findcrossings: oops, no [shortids $id] in row $e"
3221 for {set row $e} {[incr row -1] >= $s} {} {
3222 set olds [lindex $parentlist $row]
3223 set kid [lindex $displayorder $row]
3224 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3225 if {$kidx < 0} continue
3226 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3228 set px [lsearch -exact $nextrow $p]
3229 if {$px < 0} continue
3230 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3231 if {[lsearch -exact $ccross $p] >= 0} continue
3232 if {$x == $px + ($kidx < $px? -1: 1)} {
3234 } elseif {[lsearch -exact $cross $p] < 0} {
3239 set inc [lindex $rowoffsets $row $x]
3240 if {$inc eq {}} break
3244 return [concat $ccross {{}} $cross]
3247 proc assigncolor {id} {
3248 global colormap colors nextcolor
3249 global commitrow parentlist children children curview
3251 if {[info exists colormap($id)]} return
3252 set ncolors [llength $colors]
3253 if {[info exists children($curview,$id)]} {
3254 set kids $children($curview,$id)
3258 if {[llength $kids] == 1} {
3259 set child [lindex $kids 0]
3260 if {[info exists colormap($child)]
3261 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3262 set colormap($id) $colormap($child)
3268 foreach x [findcrossings $id] {
3270 # delimiter between corner crossings and other crossings
3271 if {[llength $badcolors] >= $ncolors - 1} break
3272 set origbad $badcolors
3274 if {[info exists colormap($x)]
3275 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3276 lappend badcolors $colormap($x)
3279 if {[llength $badcolors] >= $ncolors} {
3280 set badcolors $origbad
3282 set origbad $badcolors
3283 if {[llength $badcolors] < $ncolors - 1} {
3284 foreach child $kids {
3285 if {[info exists colormap($child)]
3286 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3287 lappend badcolors $colormap($child)
3289 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3290 if {[info exists colormap($p)]
3291 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3292 lappend badcolors $colormap($p)
3296 if {[llength $badcolors] >= $ncolors} {
3297 set badcolors $origbad
3300 for {set i 0} {$i <= $ncolors} {incr i} {
3301 set c [lindex $colors $nextcolor]
3302 if {[incr nextcolor] >= $ncolors} {
3305 if {[lsearch -exact $badcolors $c]} break
3307 set colormap($id) $c
3310 proc bindline {t id} {
3313 $canv bind $t <Enter> "lineenter %x %y $id"
3314 $canv bind $t <Motion> "linemotion %x %y $id"
3315 $canv bind $t <Leave> "lineleave $id"
3316 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3319 proc drawtags {id x xt y1} {
3320 global idtags idheads idotherrefs mainhead
3321 global linespc lthickness
3322 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3327 if {[info exists idtags($id)]} {
3328 set marks $idtags($id)
3329 set ntags [llength $marks]
3331 if {[info exists idheads($id)]} {
3332 set marks [concat $marks $idheads($id)]
3333 set nheads [llength $idheads($id)]
3335 if {[info exists idotherrefs($id)]} {
3336 set marks [concat $marks $idotherrefs($id)]
3342 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3343 set yt [expr {$y1 - 0.5 * $linespc}]
3344 set yb [expr {$yt + $linespc - 1}]
3348 foreach tag $marks {
3350 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3351 set wid [font measure [concat $mainfont bold] $tag]
3353 set wid [font measure $mainfont $tag]
3357 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3359 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3360 -width $lthickness -fill black -tags tag.$id]
3362 foreach tag $marks x $xvals wid $wvals {
3363 set xl [expr {$x + $delta}]
3364 set xr [expr {$x + $delta + $wid + $lthickness}]
3366 if {[incr ntags -1] >= 0} {
3368 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3369 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3370 -width 1 -outline black -fill yellow -tags tag.$id]
3371 $canv bind $t <1> [list showtag $tag 1]
3372 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3374 # draw a head or other ref
3375 if {[incr nheads -1] >= 0} {
3377 if {$tag eq $mainhead} {
3383 set xl [expr {$xl - $delta/2}]
3384 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3385 -width 1 -outline black -fill $col -tags tag.$id
3386 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3387 set rwid [font measure $mainfont $remoteprefix]
3388 set xi [expr {$x + 1}]
3389 set yti [expr {$yt + 1}]
3390 set xri [expr {$x + $rwid}]
3391 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3392 -width 0 -fill "#ffddaa" -tags tag.$id
3395 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3396 -font $font -tags [list tag.$id text]]
3398 $canv bind $t <1> [list showtag $tag 1]
3399 } elseif {$nheads >= 0} {
3400 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3406 proc xcoord {i level ln} {
3407 global canvx0 xspc1 xspc2
3409 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3410 if {$i > 0 && $i == $level} {
3411 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3412 } elseif {$i > $level} {
3413 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3418 proc show_status {msg} {
3419 global canv mainfont fgcolor
3422 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3423 -tags text -fill $fgcolor
3426 proc finishcommits {} {
3427 global commitidx phase curview
3428 global pending_select
3430 if {$commitidx($curview) > 0} {
3433 show_status "No commits selected"
3436 catch {unset pending_select}
3439 # Insert a new commit as the child of the commit on row $row.
3440 # The new commit will be displayed on row $row and the commits
3441 # on that row and below will move down one row.
3442 proc insertrow {row newcmit} {
3443 global displayorder parentlist childlist commitlisted
3444 global commitrow curview rowidlist rowoffsets numcommits
3445 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3446 global linesegends selectedline
3448 if {$row >= $numcommits} {
3449 puts "oops, inserting new row $row but only have $numcommits rows"
3452 set p [lindex $displayorder $row]
3453 set displayorder [linsert $displayorder $row $newcmit]
3454 set parentlist [linsert $parentlist $row $p]
3455 set kids [lindex $childlist $row]
3456 lappend kids $newcmit
3457 lset childlist $row $kids
3458 set childlist [linsert $childlist $row {}]
3459 set commitlisted [linsert $commitlisted $row 1]
3460 set l [llength $displayorder]
3461 for {set r $row} {$r < $l} {incr r} {
3462 set id [lindex $displayorder $r]
3463 set commitrow($curview,$id) $r
3466 set idlist [lindex $rowidlist $row]
3467 set offs [lindex $rowoffsets $row]
3470 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3476 if {[llength $kids] == 1} {
3477 set col [lsearch -exact $idlist $p]
3478 lset idlist $col $newcmit
3480 set col [llength $idlist]
3481 lappend idlist $newcmit
3483 lset rowoffsets $row $offs
3485 set rowidlist [linsert $rowidlist $row $idlist]
3486 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3488 set rowrangelist [linsert $rowrangelist $row {}]
3489 set l [llength $rowrangelist]
3490 for {set r 0} {$r < $l} {incr r} {
3491 set ranges [lindex $rowrangelist $r]
3492 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3496 lappend newranges [expr {$x + 1}]
3498 lappend newranges $x
3501 lset rowrangelist $r $newranges
3504 if {[llength $kids] > 1} {
3505 set rp1 [expr {$row + 1}]
3506 set ranges [lindex $rowrangelist $rp1]
3507 if {$ranges eq {}} {
3508 set ranges [list $row $rp1]
3509 } elseif {[lindex $ranges end-1] == $rp1} {
3510 lset ranges end-1 $row
3512 lset rowrangelist $rp1 $ranges
3514 foreach id [array names idrowranges] {
3515 set ranges $idrowranges($id)
3516 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3520 lappend newranges [expr {$x + 1}]
3522 lappend newranges $x
3525 set idrowranges($id) $newranges
3529 set linesegends [linsert $linesegends $row {}]
3535 if {[info exists selectedline] && $selectedline >= $row} {
3541 # Don't change the text pane cursor if it is currently the hand cursor,
3542 # showing that we are over a sha1 ID link.
3543 proc settextcursor {c} {
3544 global ctext curtextcursor
3546 if {[$ctext cget -cursor] == $curtextcursor} {
3547 $ctext config -cursor $c
3549 set curtextcursor $c
3552 proc nowbusy {what} {
3555 if {[array names isbusy] eq {}} {
3556 . config -cursor watch
3562 proc notbusy {what} {
3563 global isbusy maincursor textcursor
3565 catch {unset isbusy($what)}
3566 if {[array names isbusy] eq {}} {
3567 . config -cursor $maincursor
3568 settextcursor $textcursor
3574 global rowlaidout commitidx curview
3575 global pending_select
3577 layoutrows $rowlaidout $commitidx($curview) 1
3579 optimize_rows $row 0 $commitidx($curview)
3580 showstuff $commitidx($curview)
3581 if {[info exists pending_select]} {
3585 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3587 #puts "overall $drawmsecs ms for $numcommits commits"
3590 proc findmatches {f} {
3591 global findtype foundstring foundstrlen
3592 if {$findtype == "Regexp"} {
3593 set matches [regexp -indices -all -inline $foundstring $f]
3595 if {$findtype == "IgnCase"} {
3596 set str [string tolower $f]
3602 while {[set j [string first $foundstring $str $i]] >= 0} {
3603 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3604 set i [expr {$j + $foundstrlen}]
3611 global findtype findloc findstring markedmatches commitinfo
3612 global numcommits displayorder linehtag linentag linedtag
3613 global mainfont canv canv2 canv3 selectedline
3614 global matchinglines foundstring foundstrlen matchstring
3619 cancel_next_highlight
3621 set matchinglines {}
3622 if {$findtype == "IgnCase"} {
3623 set foundstring [string tolower $findstring]
3625 set foundstring $findstring
3627 set foundstrlen [string length $findstring]
3628 if {$foundstrlen == 0} return
3629 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3630 set matchstring "*$matchstring*"
3631 if {![info exists selectedline]} {
3634 set oldsel $selectedline
3637 set fldtypes {Headline Author Date Committer CDate Comments}
3639 foreach id $displayorder {
3640 set d $commitdata($id)
3642 if {$findtype == "Regexp"} {
3643 set doesmatch [regexp $foundstring $d]
3644 } elseif {$findtype == "IgnCase"} {
3645 set doesmatch [string match -nocase $matchstring $d]
3647 set doesmatch [string match $matchstring $d]
3649 if {!$doesmatch} continue
3650 if {![info exists commitinfo($id)]} {
3653 set info $commitinfo($id)
3655 foreach f $info ty $fldtypes {
3656 if {$findloc != "All fields" && $findloc != $ty} {
3659 set matches [findmatches $f]
3660 if {$matches == {}} continue
3662 if {$ty == "Headline"} {
3664 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3665 } elseif {$ty == "Author"} {
3667 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3668 } elseif {$ty == "Date"} {
3670 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3674 lappend matchinglines $l
3675 if {!$didsel && $l > $oldsel} {
3681 if {$matchinglines == {}} {
3683 } elseif {!$didsel} {
3684 findselectline [lindex $matchinglines 0]
3688 proc findselectline {l} {
3689 global findloc commentend ctext
3691 if {$findloc == "All fields" || $findloc == "Comments"} {
3692 # highlight the matches in the comments
3693 set f [$ctext get 1.0 $commentend]
3694 set matches [findmatches $f]
3695 foreach match $matches {
3696 set start [lindex $match 0]
3697 set end [expr {[lindex $match 1] + 1}]
3698 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3703 proc findnext {restart} {
3704 global matchinglines selectedline
3705 if {![info exists matchinglines]} {
3711 if {![info exists selectedline]} return
3712 foreach l $matchinglines {
3713 if {$l > $selectedline} {
3722 global matchinglines selectedline
3723 if {![info exists matchinglines]} {
3727 if {![info exists selectedline]} return
3729 foreach l $matchinglines {
3730 if {$l >= $selectedline} break
3734 findselectline $prev
3740 proc stopfindproc {{done 0}} {
3741 global findprocpid findprocfile findids
3742 global ctext findoldcursor phase maincursor textcursor
3743 global findinprogress
3745 catch {unset findids}
3746 if {[info exists findprocpid]} {
3748 catch {exec kill $findprocpid}
3750 catch {close $findprocfile}
3753 catch {unset findinprogress}
3757 # mark a commit as matching by putting a yellow background
3758 # behind the headline
3759 proc markheadline {l id} {
3760 global canv mainfont linehtag
3763 set bbox [$canv bbox $linehtag($l)]
3764 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3768 # mark the bits of a headline, author or date that match a find string
3769 proc markmatches {canv l str tag matches font} {
3770 set bbox [$canv bbox $tag]
3771 set x0 [lindex $bbox 0]
3772 set y0 [lindex $bbox 1]
3773 set y1 [lindex $bbox 3]
3774 foreach match $matches {
3775 set start [lindex $match 0]
3776 set end [lindex $match 1]
3777 if {$start > $end} continue
3778 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3779 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3780 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3781 [expr {$x0+$xlen+2}] $y1 \
3782 -outline {} -tags matches -fill yellow]
3787 proc unmarkmatches {} {
3788 global matchinglines findids
3789 allcanvs delete matches
3790 catch {unset matchinglines}
3791 catch {unset findids}
3794 proc selcanvline {w x y} {
3795 global canv canvy0 ctext linespc
3797 set ymax [lindex [$canv cget -scrollregion] 3]
3798 if {$ymax == {}} return
3799 set yfrac [lindex [$canv yview] 0]
3800 set y [expr {$y + $yfrac * $ymax}]
3801 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3806 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3812 proc commit_descriptor {p} {
3814 if {![info exists commitinfo($p)]} {
3818 if {[llength $commitinfo($p)] > 1} {
3819 set l [lindex $commitinfo($p) 0]
3824 # append some text to the ctext widget, and make any SHA1 ID
3825 # that we know about be a clickable link.
3826 proc appendwithlinks {text tags} {
3827 global ctext commitrow linknum curview
3829 set start [$ctext index "end - 1c"]
3830 $ctext insert end $text $tags
3831 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3835 set linkid [string range $text $s $e]
3836 if {![info exists commitrow($curview,$linkid)]} continue
3838 $ctext tag add link "$start + $s c" "$start + $e c"
3839 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3840 $ctext tag bind link$linknum <1> \
3841 [list selectline $commitrow($curview,$linkid) 1]
3844 $ctext tag conf link -foreground blue -underline 1
3845 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3846 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3849 proc viewnextline {dir} {
3853 set ymax [lindex [$canv cget -scrollregion] 3]
3854 set wnow [$canv yview]
3855 set wtop [expr {[lindex $wnow 0] * $ymax}]
3856 set newtop [expr {$wtop + $dir * $linespc}]
3859 } elseif {$newtop > $ymax} {
3862 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3865 # add a list of tag or branch names at position pos
3866 # returns the number of names inserted
3867 proc appendrefs {pos ids var} {
3868 global ctext commitrow linknum curview $var maxrefs
3870 if {[catch {$ctext index $pos}]} {
3873 $ctext conf -state normal
3874 $ctext delete $pos "$pos lineend"
3877 foreach tag [set $var\($id\)] {
3878 lappend tags [list $tag $id]
3881 if {[llength $tags] > $maxrefs} {
3882 $ctext insert $pos "many ([llength $tags])"
3884 set tags [lsort -index 0 -decreasing $tags]
3887 set id [lindex $ti 1]
3890 $ctext tag delete $lk
3891 $ctext insert $pos $sep
3892 $ctext insert $pos [lindex $ti 0] $lk
3893 if {[info exists commitrow($curview,$id)]} {
3894 $ctext tag conf $lk -foreground blue
3895 $ctext tag bind $lk <1> \
3896 [list selectline $commitrow($curview,$id) 1]
3897 $ctext tag conf $lk -underline 1
3898 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3899 $ctext tag bind $lk <Leave> \
3900 { %W configure -cursor $curtextcursor }
3905 $ctext conf -state disabled
3906 return [llength $tags]
3909 # called when we have finished computing the nearby tags
3910 proc dispneartags {delay} {
3911 global selectedline currentid showneartags tagphase
3913 if {![info exists selectedline] || !$showneartags} return
3914 after cancel dispnexttag
3916 after 200 dispnexttag
3919 after idle dispnexttag
3924 proc dispnexttag {} {
3925 global selectedline currentid showneartags tagphase ctext
3927 if {![info exists selectedline] || !$showneartags} return
3928 switch -- $tagphase {
3930 set dtags [desctags $currentid]
3932 appendrefs precedes $dtags idtags
3936 set atags [anctags $currentid]
3938 appendrefs follows $atags idtags
3942 set dheads [descheads $currentid]
3943 if {$dheads ne {}} {
3944 if {[appendrefs branch $dheads idheads] > 1
3945 && [$ctext get "branch -3c"] eq "h"} {
3946 # turn "Branch" into "Branches"
3947 $ctext conf -state normal
3948 $ctext insert "branch -2c" "es"
3949 $ctext conf -state disabled
3954 if {[incr tagphase] <= 2} {
3955 after idle dispnexttag
3959 proc selectline {l isnew} {
3960 global canv canv2 canv3 ctext commitinfo selectedline
3961 global displayorder linehtag linentag linedtag
3962 global canvy0 linespc parentlist childlist
3963 global currentid sha1entry
3964 global commentend idtags linknum
3965 global mergemax numcommits pending_select
3966 global cmitmode showneartags allcommits
3968 catch {unset pending_select}
3971 cancel_next_highlight
3972 if {$l < 0 || $l >= $numcommits} return
3973 set y [expr {$canvy0 + $l * $linespc}]
3974 set ymax [lindex [$canv cget -scrollregion] 3]
3975 set ytop [expr {$y - $linespc - 1}]
3976 set ybot [expr {$y + $linespc + 1}]
3977 set wnow [$canv yview]
3978 set wtop [expr {[lindex $wnow 0] * $ymax}]
3979 set wbot [expr {[lindex $wnow 1] * $ymax}]
3980 set wh [expr {$wbot - $wtop}]
3982 if {$ytop < $wtop} {
3983 if {$ybot < $wtop} {
3984 set newtop [expr {$y - $wh / 2.0}]
3987 if {$newtop > $wtop - $linespc} {
3988 set newtop [expr {$wtop - $linespc}]
3991 } elseif {$ybot > $wbot} {
3992 if {$ytop > $wbot} {
3993 set newtop [expr {$y - $wh / 2.0}]
3995 set newtop [expr {$ybot - $wh}]
3996 if {$newtop < $wtop + $linespc} {
3997 set newtop [expr {$wtop + $linespc}]
4001 if {$newtop != $wtop} {
4005 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4009 if {![info exists linehtag($l)]} return
4011 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4012 -tags secsel -fill [$canv cget -selectbackground]]
4014 $canv2 delete secsel
4015 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4016 -tags secsel -fill [$canv2 cget -selectbackground]]
4018 $canv3 delete secsel
4019 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4020 -tags secsel -fill [$canv3 cget -selectbackground]]
4024 addtohistory [list selectline $l 0]
4029 set id [lindex $displayorder $l]
4031 $sha1entry delete 0 end
4032 $sha1entry insert 0 $id
4033 $sha1entry selection from 0
4034 $sha1entry selection to end
4037 $ctext conf -state normal
4040 set info $commitinfo($id)
4041 set date [formatdate [lindex $info 2]]
4042 $ctext insert end "Author: [lindex $info 1] $date\n"
4043 set date [formatdate [lindex $info 4]]
4044 $ctext insert end "Committer: [lindex $info 3] $date\n"
4045 if {[info exists idtags($id)]} {
4046 $ctext insert end "Tags:"
4047 foreach tag $idtags($id) {
4048 $ctext insert end " $tag"
4050 $ctext insert end "\n"
4054 set olds [lindex $parentlist $l]
4055 if {[llength $olds] > 1} {
4058 if {$np >= $mergemax} {
4063 $ctext insert end "Parent: " $tag
4064 appendwithlinks [commit_descriptor $p] {}
4069 append headers "Parent: [commit_descriptor $p]"
4073 foreach c [lindex $childlist $l] {
4074 append headers "Child: [commit_descriptor $c]"
4077 # make anything that looks like a SHA1 ID be a clickable link
4078 appendwithlinks $headers {}
4079 if {$showneartags} {
4080 if {![info exists allcommits]} {
4083 $ctext insert end "Branch: "
4084 $ctext mark set branch "end -1c"
4085 $ctext mark gravity branch left
4086 $ctext insert end "\nFollows: "
4087 $ctext mark set follows "end -1c"
4088 $ctext mark gravity follows left
4089 $ctext insert end "\nPrecedes: "
4090 $ctext mark set precedes "end -1c"
4091 $ctext mark gravity precedes left
4092 $ctext insert end "\n"
4095 $ctext insert end "\n"
4096 appendwithlinks [lindex $info 5] {comment}
4098 $ctext tag delete Comments
4099 $ctext tag remove found 1.0 end
4100 $ctext conf -state disabled
4101 set commentend [$ctext index "end - 1c"]
4103 init_flist "Comments"
4104 if {$cmitmode eq "tree"} {
4106 } elseif {[llength $olds] <= 1} {
4113 proc selfirstline {} {
4118 proc sellastline {} {
4121 set l [expr {$numcommits - 1}]
4125 proc selnextline {dir} {
4127 if {![info exists selectedline]} return
4128 set l [expr {$selectedline + $dir}]
4133 proc selnextpage {dir} {
4134 global canv linespc selectedline numcommits
4136 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4140 allcanvs yview scroll [expr {$dir * $lpp}] units
4142 if {![info exists selectedline]} return
4143 set l [expr {$selectedline + $dir * $lpp}]
4146 } elseif {$l >= $numcommits} {
4147 set l [expr $numcommits - 1]
4153 proc unselectline {} {
4154 global selectedline currentid
4156 catch {unset selectedline}
4157 catch {unset currentid}
4158 allcanvs delete secsel
4160 cancel_next_highlight
4163 proc reselectline {} {
4166 if {[info exists selectedline]} {
4167 selectline $selectedline 0
4171 proc addtohistory {cmd} {
4172 global history historyindex curview
4174 set elt [list $curview $cmd]
4175 if {$historyindex > 0
4176 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4180 if {$historyindex < [llength $history]} {
4181 set history [lreplace $history $historyindex end $elt]
4183 lappend history $elt
4186 if {$historyindex > 1} {
4187 .tf.bar.leftbut conf -state normal
4189 .tf.bar.leftbut conf -state disabled
4191 .tf.bar.rightbut conf -state disabled
4197 set view [lindex $elt 0]
4198 set cmd [lindex $elt 1]
4199 if {$curview != $view} {
4206 global history historyindex
4208 if {$historyindex > 1} {
4209 incr historyindex -1
4210 godo [lindex $history [expr {$historyindex - 1}]]
4211 .tf.bar.rightbut conf -state normal
4213 if {$historyindex <= 1} {
4214 .tf.bar.leftbut conf -state disabled
4219 global history historyindex
4221 if {$historyindex < [llength $history]} {
4222 set cmd [lindex $history $historyindex]
4225 .tf.bar.leftbut conf -state normal
4227 if {$historyindex >= [llength $history]} {
4228 .tf.bar.rightbut conf -state disabled
4233 global treefilelist treeidlist diffids diffmergeid treepending
4236 catch {unset diffmergeid}
4237 if {![info exists treefilelist($id)]} {
4238 if {![info exists treepending]} {
4239 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4243 set treefilelist($id) {}
4244 set treeidlist($id) {}
4245 fconfigure $gtf -blocking 0
4246 fileevent $gtf readable [list gettreeline $gtf $id]
4253 proc gettreeline {gtf id} {
4254 global treefilelist treeidlist treepending cmitmode diffids
4256 while {[gets $gtf line] >= 0} {
4257 if {[lindex $line 1] ne "blob"} continue
4258 set sha1 [lindex $line 2]
4259 set fname [lindex $line 3]
4260 lappend treefilelist($id) $fname
4261 lappend treeidlist($id) $sha1
4263 if {![eof $gtf]} return
4266 if {$cmitmode ne "tree"} {
4267 if {![info exists diffmergeid]} {
4268 gettreediffs $diffids
4270 } elseif {$id ne $diffids} {
4278 global treefilelist treeidlist diffids
4279 global ctext commentend
4281 set i [lsearch -exact $treefilelist($diffids) $f]
4283 puts "oops, $f not in list for id $diffids"
4286 set blob [lindex $treeidlist($diffids) $i]
4287 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4288 puts "oops, error reading blob $blob: $err"
4291 fconfigure $bf -blocking 0
4292 fileevent $bf readable [list getblobline $bf $diffids]
4293 $ctext config -state normal
4294 clear_ctext $commentend
4295 $ctext insert end "\n"
4296 $ctext insert end "$f\n" filesep
4297 $ctext config -state disabled
4298 $ctext yview $commentend
4301 proc getblobline {bf id} {
4302 global diffids cmitmode ctext
4304 if {$id ne $diffids || $cmitmode ne "tree"} {
4308 $ctext config -state normal
4309 while {[gets $bf line] >= 0} {
4310 $ctext insert end "$line\n"
4313 # delete last newline
4314 $ctext delete "end - 2c" "end - 1c"
4317 $ctext config -state disabled
4320 proc mergediff {id l} {
4321 global diffmergeid diffopts mdifffd
4327 # this doesn't seem to actually affect anything...
4328 set env(GIT_DIFF_OPTS) $diffopts
4329 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4330 if {[catch {set mdf [open $cmd r]} err]} {
4331 error_popup "Error getting merge diffs: $err"
4334 fconfigure $mdf -blocking 0
4335 set mdifffd($id) $mdf
4336 set np [llength [lindex $parentlist $l]]
4337 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4338 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4341 proc getmergediffline {mdf id np} {
4342 global diffmergeid ctext cflist nextupdate mergemax
4343 global difffilestart mdifffd
4345 set n [gets $mdf line]
4352 if {![info exists diffmergeid] || $id != $diffmergeid
4353 || $mdf != $mdifffd($id)} {
4356 $ctext conf -state normal
4357 if {[regexp {^diff --cc (.*)} $line match fname]} {
4358 # start of a new file
4359 $ctext insert end "\n"
4360 set here [$ctext index "end - 1c"]
4361 lappend difffilestart $here
4362 add_flist [list $fname]
4363 set l [expr {(78 - [string length $fname]) / 2}]
4364 set pad [string range "----------------------------------------" 1 $l]
4365 $ctext insert end "$pad $fname $pad\n" filesep
4366 } elseif {[regexp {^@@} $line]} {
4367 $ctext insert end "$line\n" hunksep
4368 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4371 # parse the prefix - one ' ', '-' or '+' for each parent
4376 for {set j 0} {$j < $np} {incr j} {
4377 set c [string range $line $j $j]
4380 } elseif {$c == "-"} {
4382 } elseif {$c == "+"} {
4391 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4392 # line doesn't appear in result, parents in $minuses have the line
4393 set num [lindex $minuses 0]
4394 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4395 # line appears in result, parents in $pluses don't have the line
4396 lappend tags mresult
4397 set num [lindex $spaces 0]
4400 if {$num >= $mergemax} {
4405 $ctext insert end "$line\n" $tags
4407 $ctext conf -state disabled
4408 if {[clock clicks -milliseconds] >= $nextupdate} {
4410 fileevent $mdf readable {}
4412 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4416 proc startdiff {ids} {
4417 global treediffs diffids treepending diffmergeid
4420 catch {unset diffmergeid}
4421 if {![info exists treediffs($ids)]} {
4422 if {![info exists treepending]} {
4430 proc addtocflist {ids} {
4431 global treediffs cflist
4432 add_flist $treediffs($ids)
4436 proc gettreediffs {ids} {
4437 global treediff treepending
4438 set treepending $ids
4441 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4443 fconfigure $gdtf -blocking 0
4444 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4447 proc gettreediffline {gdtf ids} {
4448 global treediff treediffs treepending diffids diffmergeid
4451 set n [gets $gdtf line]
4453 if {![eof $gdtf]} return
4455 set treediffs($ids) $treediff
4457 if {$cmitmode eq "tree"} {
4459 } elseif {$ids != $diffids} {
4460 if {![info exists diffmergeid]} {
4461 gettreediffs $diffids
4468 set file [lindex $line 5]
4469 lappend treediff $file
4472 proc getblobdiffs {ids} {
4473 global diffopts blobdifffd diffids env curdifftag curtagstart
4474 global nextupdate diffinhdr treediffs
4476 set env(GIT_DIFF_OPTS) $diffopts
4477 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4478 if {[catch {set bdf [open $cmd r]} err]} {
4479 puts "error getting diffs: $err"
4483 fconfigure $bdf -blocking 0
4484 set blobdifffd($ids) $bdf
4485 set curdifftag Comments
4487 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4488 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4491 proc setinlist {var i val} {
4494 while {[llength [set $var]] < $i} {
4497 if {[llength [set $var]] == $i} {
4504 proc getblobdiffline {bdf ids} {
4505 global diffids blobdifffd ctext curdifftag curtagstart
4506 global diffnexthead diffnextnote difffilestart
4507 global nextupdate diffinhdr treediffs
4509 set n [gets $bdf line]
4513 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4514 $ctext tag add $curdifftag $curtagstart end
4519 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4522 $ctext conf -state normal
4523 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4524 # start of a new file
4525 $ctext insert end "\n"
4526 $ctext tag add $curdifftag $curtagstart end
4527 set here [$ctext index "end - 1c"]
4528 set curtagstart $here
4530 set i [lsearch -exact $treediffs($ids) $fname]
4532 setinlist difffilestart $i $here
4534 if {$newname ne $fname} {
4535 set i [lsearch -exact $treediffs($ids) $newname]
4537 setinlist difffilestart $i $here
4540 set curdifftag "f:$fname"
4541 $ctext tag delete $curdifftag
4542 set l [expr {(78 - [string length $header]) / 2}]
4543 set pad [string range "----------------------------------------" 1 $l]
4544 $ctext insert end "$pad $header $pad\n" filesep
4546 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4548 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4550 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4551 $line match f1l f1c f2l f2c rest]} {
4552 $ctext insert end "$line\n" hunksep
4555 set x [string range $line 0 0]
4556 if {$x == "-" || $x == "+"} {
4557 set tag [expr {$x == "+"}]
4558 $ctext insert end "$line\n" d$tag
4559 } elseif {$x == " "} {
4560 $ctext insert end "$line\n"
4561 } elseif {$diffinhdr || $x == "\\"} {
4562 # e.g. "\ No newline at end of file"
4563 $ctext insert end "$line\n" filesep
4565 # Something else we don't recognize
4566 if {$curdifftag != "Comments"} {
4567 $ctext insert end "\n"
4568 $ctext tag add $curdifftag $curtagstart end
4569 set curtagstart [$ctext index "end - 1c"]
4570 set curdifftag Comments
4572 $ctext insert end "$line\n" filesep
4575 $ctext conf -state disabled
4576 if {[clock clicks -milliseconds] >= $nextupdate} {
4578 fileevent $bdf readable {}
4580 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4584 proc changediffdisp {} {
4585 global ctext diffelide
4587 $ctext tag conf d0 -elide [lindex $diffelide 0]
4588 $ctext tag conf d1 -elide [lindex $diffelide 1]
4592 global difffilestart ctext
4593 set prev [lindex $difffilestart 0]
4594 set here [$ctext index @0,0]
4595 foreach loc $difffilestart {
4596 if {[$ctext compare $loc >= $here]} {
4606 global difffilestart ctext
4607 set here [$ctext index @0,0]
4608 foreach loc $difffilestart {
4609 if {[$ctext compare $loc > $here]} {
4616 proc clear_ctext {{first 1.0}} {
4617 global ctext smarktop smarkbot
4619 set l [lindex [split $first .] 0]
4620 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4623 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4626 $ctext delete $first end
4629 proc incrsearch {name ix op} {
4630 global ctext searchstring searchdirn
4632 $ctext tag remove found 1.0 end
4633 if {[catch {$ctext index anchor}]} {
4634 # no anchor set, use start of selection, or of visible area
4635 set sel [$ctext tag ranges sel]
4637 $ctext mark set anchor [lindex $sel 0]
4638 } elseif {$searchdirn eq "-forwards"} {
4639 $ctext mark set anchor @0,0
4641 $ctext mark set anchor @0,[winfo height $ctext]
4644 if {$searchstring ne {}} {
4645 set here [$ctext search $searchdirn -- $searchstring anchor]
4654 global sstring ctext searchstring searchdirn
4657 $sstring icursor end
4658 set searchdirn -forwards
4659 if {$searchstring ne {}} {
4660 set sel [$ctext tag ranges sel]
4662 set start "[lindex $sel 0] + 1c"
4663 } elseif {[catch {set start [$ctext index anchor]}]} {
4666 set match [$ctext search -count mlen -- $searchstring $start]
4667 $ctext tag remove sel 1.0 end
4673 set mend "$match + $mlen c"
4674 $ctext tag add sel $match $mend
4675 $ctext mark unset anchor
4679 proc dosearchback {} {
4680 global sstring ctext searchstring searchdirn
4683 $sstring icursor end
4684 set searchdirn -backwards
4685 if {$searchstring ne {}} {
4686 set sel [$ctext tag ranges sel]
4688 set start [lindex $sel 0]
4689 } elseif {[catch {set start [$ctext index anchor]}]} {
4690 set start @0,[winfo height $ctext]
4692 set match [$ctext search -backwards -count ml -- $searchstring $start]
4693 $ctext tag remove sel 1.0 end
4699 set mend "$match + $ml c"
4700 $ctext tag add sel $match $mend
4701 $ctext mark unset anchor
4705 proc searchmark {first last} {
4706 global ctext searchstring
4710 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4711 if {$match eq {}} break
4712 set mend "$match + $mlen c"
4713 $ctext tag add found $match $mend
4717 proc searchmarkvisible {doall} {
4718 global ctext smarktop smarkbot
4720 set topline [lindex [split [$ctext index @0,0] .] 0]
4721 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4722 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4723 # no overlap with previous
4724 searchmark $topline $botline
4725 set smarktop $topline
4726 set smarkbot $botline
4728 if {$topline < $smarktop} {
4729 searchmark $topline [expr {$smarktop-1}]
4730 set smarktop $topline
4732 if {$botline > $smarkbot} {
4733 searchmark [expr {$smarkbot+1}] $botline
4734 set smarkbot $botline
4739 proc scrolltext {f0 f1} {
4742 .bleft.sb set $f0 $f1
4743 if {$searchstring ne {}} {
4749 global linespc charspc canvx0 canvy0 mainfont
4750 global xspc1 xspc2 lthickness
4752 set linespc [font metrics $mainfont -linespace]
4753 set charspc [font measure $mainfont "m"]
4754 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4755 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4756 set lthickness [expr {int($linespc / 9) + 1}]
4757 set xspc1(0) $linespc
4765 set ymax [lindex [$canv cget -scrollregion] 3]
4766 if {$ymax eq {} || $ymax == 0} return
4767 set span [$canv yview]
4770 allcanvs yview moveto [lindex $span 0]
4772 if {[info exists selectedline]} {
4773 selectline $selectedline 0
4774 allcanvs yview moveto [lindex $span 0]
4778 proc incrfont {inc} {
4779 global mainfont textfont ctext canv phase cflist
4780 global charspc tabstop
4781 global stopped entries
4783 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4784 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4786 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
4787 $cflist conf -font $textfont
4788 $ctext tag conf filesep -font [concat $textfont bold]
4789 foreach e $entries {
4790 $e conf -font $mainfont
4792 if {$phase eq "getcommits"} {
4793 $canv itemconf textitems -font $mainfont
4799 global sha1entry sha1string
4800 if {[string length $sha1string] == 40} {
4801 $sha1entry delete 0 end
4805 proc sha1change {n1 n2 op} {
4806 global sha1string currentid sha1but
4807 if {$sha1string == {}
4808 || ([info exists currentid] && $sha1string == $currentid)} {
4813 if {[$sha1but cget -state] == $state} return
4814 if {$state == "normal"} {
4815 $sha1but conf -state normal -relief raised -text "Goto: "
4817 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4821 proc gotocommit {} {
4822 global sha1string currentid commitrow tagids headids
4823 global displayorder numcommits curview
4825 if {$sha1string == {}
4826 || ([info exists currentid] && $sha1string == $currentid)} return
4827 if {[info exists tagids($sha1string)]} {
4828 set id $tagids($sha1string)
4829 } elseif {[info exists headids($sha1string)]} {
4830 set id $headids($sha1string)
4832 set id [string tolower $sha1string]
4833 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4835 foreach i $displayorder {
4836 if {[string match $id* $i]} {
4840 if {$matches ne {}} {
4841 if {[llength $matches] > 1} {
4842 error_popup "Short SHA1 id $id is ambiguous"
4845 set id [lindex $matches 0]
4849 if {[info exists commitrow($curview,$id)]} {
4850 selectline $commitrow($curview,$id) 1
4853 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4858 error_popup "$type $sha1string is not known"
4861 proc lineenter {x y id} {
4862 global hoverx hovery hoverid hovertimer
4863 global commitinfo canv
4865 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4869 if {[info exists hovertimer]} {
4870 after cancel $hovertimer
4872 set hovertimer [after 500 linehover]
4876 proc linemotion {x y id} {
4877 global hoverx hovery hoverid hovertimer
4879 if {[info exists hoverid] && $id == $hoverid} {
4882 if {[info exists hovertimer]} {
4883 after cancel $hovertimer
4885 set hovertimer [after 500 linehover]
4889 proc lineleave {id} {
4890 global hoverid hovertimer canv
4892 if {[info exists hoverid] && $id == $hoverid} {
4894 if {[info exists hovertimer]} {
4895 after cancel $hovertimer
4903 global hoverx hovery hoverid hovertimer
4904 global canv linespc lthickness
4905 global commitinfo mainfont
4907 set text [lindex $commitinfo($hoverid) 0]
4908 set ymax [lindex [$canv cget -scrollregion] 3]
4909 if {$ymax == {}} return
4910 set yfrac [lindex [$canv yview] 0]
4911 set x [expr {$hoverx + 2 * $linespc}]
4912 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4913 set x0 [expr {$x - 2 * $lthickness}]
4914 set y0 [expr {$y - 2 * $lthickness}]
4915 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4916 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4917 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4918 -fill \#ffff80 -outline black -width 1 -tags hover]
4920 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4925 proc clickisonarrow {id y} {
4928 set ranges [rowranges $id]
4929 set thresh [expr {2 * $lthickness + 6}]
4930 set n [expr {[llength $ranges] - 1}]
4931 for {set i 1} {$i < $n} {incr i} {
4932 set row [lindex $ranges $i]
4933 if {abs([yc $row] - $y) < $thresh} {
4940 proc arrowjump {id n y} {
4943 # 1 <-> 2, 3 <-> 4, etc...
4944 set n [expr {(($n - 1) ^ 1) + 1}]
4945 set row [lindex [rowranges $id] $n]
4947 set ymax [lindex [$canv cget -scrollregion] 3]
4948 if {$ymax eq {} || $ymax <= 0} return
4949 set view [$canv yview]
4950 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4951 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4955 allcanvs yview moveto $yfrac
4958 proc lineclick {x y id isnew} {
4959 global ctext commitinfo children canv thickerline curview
4961 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4966 # draw this line thicker than normal
4970 set ymax [lindex [$canv cget -scrollregion] 3]
4971 if {$ymax eq {}} return
4972 set yfrac [lindex [$canv yview] 0]
4973 set y [expr {$y + $yfrac * $ymax}]
4975 set dirn [clickisonarrow $id $y]
4977 arrowjump $id $dirn $y
4982 addtohistory [list lineclick $x $y $id 0]
4984 # fill the details pane with info about this line
4985 $ctext conf -state normal
4987 $ctext tag conf link -foreground blue -underline 1
4988 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4989 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4990 $ctext insert end "Parent:\t"
4991 $ctext insert end $id [list link link0]
4992 $ctext tag bind link0 <1> [list selbyid $id]
4993 set info $commitinfo($id)
4994 $ctext insert end "\n\t[lindex $info 0]\n"
4995 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4996 set date [formatdate [lindex $info 2]]
4997 $ctext insert end "\tDate:\t$date\n"
4998 set kids $children($curview,$id)
5000 $ctext insert end "\nChildren:"
5002 foreach child $kids {
5004 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5005 set info $commitinfo($child)
5006 $ctext insert end "\n\t"
5007 $ctext insert end $child [list link link$i]
5008 $ctext tag bind link$i <1> [list selbyid $child]
5009 $ctext insert end "\n\t[lindex $info 0]"
5010 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5011 set date [formatdate [lindex $info 2]]
5012 $ctext insert end "\n\tDate:\t$date\n"
5015 $ctext conf -state disabled
5019 proc normalline {} {
5021 if {[info exists thickerline]} {
5029 global commitrow curview
5030 if {[info exists commitrow($curview,$id)]} {
5031 selectline $commitrow($curview,$id) 1
5037 if {![info exists startmstime]} {
5038 set startmstime [clock clicks -milliseconds]
5040 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5043 proc rowmenu {x y id} {
5044 global rowctxmenu commitrow selectedline rowmenuid curview
5046 if {![info exists selectedline]
5047 || $commitrow($curview,$id) eq $selectedline} {
5052 $rowctxmenu entryconfigure "Diff this*" -state $state
5053 $rowctxmenu entryconfigure "Diff selected*" -state $state
5054 $rowctxmenu entryconfigure "Make patch" -state $state
5056 tk_popup $rowctxmenu $x $y
5059 proc diffvssel {dirn} {
5060 global rowmenuid selectedline displayorder
5062 if {![info exists selectedline]} return
5064 set oldid [lindex $displayorder $selectedline]
5065 set newid $rowmenuid
5067 set oldid $rowmenuid
5068 set newid [lindex $displayorder $selectedline]
5070 addtohistory [list doseldiff $oldid $newid]
5071 doseldiff $oldid $newid
5074 proc doseldiff {oldid newid} {
5078 $ctext conf -state normal
5081 $ctext insert end "From "
5082 $ctext tag conf link -foreground blue -underline 1
5083 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5084 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5085 $ctext tag bind link0 <1> [list selbyid $oldid]
5086 $ctext insert end $oldid [list link link0]
5087 $ctext insert end "\n "
5088 $ctext insert end [lindex $commitinfo($oldid) 0]
5089 $ctext insert end "\n\nTo "
5090 $ctext tag bind link1 <1> [list selbyid $newid]
5091 $ctext insert end $newid [list link link1]
5092 $ctext insert end "\n "
5093 $ctext insert end [lindex $commitinfo($newid) 0]
5094 $ctext insert end "\n"
5095 $ctext conf -state disabled
5096 $ctext tag delete Comments
5097 $ctext tag remove found 1.0 end
5098 startdiff [list $oldid $newid]
5102 global rowmenuid currentid commitinfo patchtop patchnum
5104 if {![info exists currentid]} return
5105 set oldid $currentid
5106 set oldhead [lindex $commitinfo($oldid) 0]
5107 set newid $rowmenuid
5108 set newhead [lindex $commitinfo($newid) 0]
5111 catch {destroy $top}
5113 label $top.title -text "Generate patch"
5114 grid $top.title - -pady 10
5115 label $top.from -text "From:"
5116 entry $top.fromsha1 -width 40 -relief flat
5117 $top.fromsha1 insert 0 $oldid
5118 $top.fromsha1 conf -state readonly
5119 grid $top.from $top.fromsha1 -sticky w
5120 entry $top.fromhead -width 60 -relief flat
5121 $top.fromhead insert 0 $oldhead
5122 $top.fromhead conf -state readonly
5123 grid x $top.fromhead -sticky w
5124 label $top.to -text "To:"
5125 entry $top.tosha1 -width 40 -relief flat
5126 $top.tosha1 insert 0 $newid
5127 $top.tosha1 conf -state readonly
5128 grid $top.to $top.tosha1 -sticky w
5129 entry $top.tohead -width 60 -relief flat
5130 $top.tohead insert 0 $newhead
5131 $top.tohead conf -state readonly
5132 grid x $top.tohead -sticky w
5133 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5134 grid $top.rev x -pady 10
5135 label $top.flab -text "Output file:"
5136 entry $top.fname -width 60
5137 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5139 grid $top.flab $top.fname -sticky w
5141 button $top.buts.gen -text "Generate" -command mkpatchgo
5142 button $top.buts.can -text "Cancel" -command mkpatchcan
5143 grid $top.buts.gen $top.buts.can
5144 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5145 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5146 grid $top.buts - -pady 10 -sticky ew
5150 proc mkpatchrev {} {
5153 set oldid [$patchtop.fromsha1 get]
5154 set oldhead [$patchtop.fromhead get]
5155 set newid [$patchtop.tosha1 get]
5156 set newhead [$patchtop.tohead get]
5157 foreach e [list fromsha1 fromhead tosha1 tohead] \
5158 v [list $newid $newhead $oldid $oldhead] {
5159 $patchtop.$e conf -state normal
5160 $patchtop.$e delete 0 end
5161 $patchtop.$e insert 0 $v
5162 $patchtop.$e conf -state readonly
5169 set oldid [$patchtop.fromsha1 get]
5170 set newid [$patchtop.tosha1 get]
5171 set fname [$patchtop.fname get]
5172 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5173 error_popup "Error creating patch: $err"
5175 catch {destroy $patchtop}
5179 proc mkpatchcan {} {
5182 catch {destroy $patchtop}
5187 global rowmenuid mktagtop commitinfo
5191 catch {destroy $top}
5193 label $top.title -text "Create tag"
5194 grid $top.title - -pady 10
5195 label $top.id -text "ID:"
5196 entry $top.sha1 -width 40 -relief flat
5197 $top.sha1 insert 0 $rowmenuid
5198 $top.sha1 conf -state readonly
5199 grid $top.id $top.sha1 -sticky w
5200 entry $top.head -width 60 -relief flat
5201 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5202 $top.head conf -state readonly
5203 grid x $top.head -sticky w
5204 label $top.tlab -text "Tag name:"
5205 entry $top.tag -width 60
5206 grid $top.tlab $top.tag -sticky w
5208 button $top.buts.gen -text "Create" -command mktaggo
5209 button $top.buts.can -text "Cancel" -command mktagcan
5210 grid $top.buts.gen $top.buts.can
5211 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5212 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5213 grid $top.buts - -pady 10 -sticky ew
5218 global mktagtop env tagids idtags
5220 set id [$mktagtop.sha1 get]
5221 set tag [$mktagtop.tag get]
5223 error_popup "No tag name specified"
5226 if {[info exists tagids($tag)]} {
5227 error_popup "Tag \"$tag\" already exists"
5232 set fname [file join $dir "refs/tags" $tag]
5233 set f [open $fname w]
5237 error_popup "Error creating tag: $err"
5241 set tagids($tag) $id
5242 lappend idtags($id) $tag
5247 proc redrawtags {id} {
5248 global canv linehtag commitrow idpos selectedline curview
5249 global mainfont canvxmax
5251 if {![info exists commitrow($curview,$id)]} return
5252 drawcmitrow $commitrow($curview,$id)
5253 $canv delete tag.$id
5254 set xt [eval drawtags $id $idpos($id)]
5255 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5256 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5257 set xr [expr {$xt + [font measure $mainfont $text]}]
5258 if {$xr > $canvxmax} {
5262 if {[info exists selectedline]
5263 && $selectedline == $commitrow($curview,$id)} {
5264 selectline $selectedline 0
5271 catch {destroy $mktagtop}
5280 proc writecommit {} {
5281 global rowmenuid wrcomtop commitinfo wrcomcmd
5283 set top .writecommit
5285 catch {destroy $top}
5287 label $top.title -text "Write commit to file"
5288 grid $top.title - -pady 10
5289 label $top.id -text "ID:"
5290 entry $top.sha1 -width 40 -relief flat
5291 $top.sha1 insert 0 $rowmenuid
5292 $top.sha1 conf -state readonly
5293 grid $top.id $top.sha1 -sticky w
5294 entry $top.head -width 60 -relief flat
5295 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5296 $top.head conf -state readonly
5297 grid x $top.head -sticky w
5298 label $top.clab -text "Command:"
5299 entry $top.cmd -width 60 -textvariable wrcomcmd
5300 grid $top.clab $top.cmd -sticky w -pady 10
5301 label $top.flab -text "Output file:"
5302 entry $top.fname -width 60
5303 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5304 grid $top.flab $top.fname -sticky w
5306 button $top.buts.gen -text "Write" -command wrcomgo
5307 button $top.buts.can -text "Cancel" -command wrcomcan
5308 grid $top.buts.gen $top.buts.can
5309 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5310 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5311 grid $top.buts - -pady 10 -sticky ew
5318 set id [$wrcomtop.sha1 get]
5319 set cmd "echo $id | [$wrcomtop.cmd get]"
5320 set fname [$wrcomtop.fname get]
5321 if {[catch {exec sh -c $cmd >$fname &} err]} {
5322 error_popup "Error writing commit: $err"
5324 catch {destroy $wrcomtop}
5331 catch {destroy $wrcomtop}
5336 global rowmenuid mkbrtop
5339 catch {destroy $top}
5341 label $top.title -text "Create new branch"
5342 grid $top.title - -pady 10
5343 label $top.id -text "ID:"
5344 entry $top.sha1 -width 40 -relief flat
5345 $top.sha1 insert 0 $rowmenuid
5346 $top.sha1 conf -state readonly
5347 grid $top.id $top.sha1 -sticky w
5348 label $top.nlab -text "Name:"
5349 entry $top.name -width 40
5350 grid $top.nlab $top.name -sticky w
5352 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5353 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5354 grid $top.buts.go $top.buts.can
5355 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5356 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5357 grid $top.buts - -pady 10 -sticky ew
5362 global headids idheads
5364 set name [$top.name get]
5365 set id [$top.sha1 get]
5367 error_popup "Please specify a name for the new branch"
5370 catch {destroy $top}
5374 exec git branch $name $id
5379 set headids($name) $id
5380 lappend idheads($id) $name
5388 proc cherrypick {} {
5389 global rowmenuid curview commitrow
5392 set oldhead [exec git rev-parse HEAD]
5393 set dheads [descheads $rowmenuid]
5394 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5395 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5396 included in branch $mainhead -- really re-apply it?"]
5401 # Unfortunately git-cherry-pick writes stuff to stderr even when
5402 # no error occurs, and exec takes that as an indication of error...
5403 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5408 set newhead [exec git rev-parse HEAD]
5409 if {$newhead eq $oldhead} {
5411 error_popup "No changes committed"
5414 addnewchild $newhead $oldhead
5415 if {[info exists commitrow($curview,$oldhead)]} {
5416 insertrow $commitrow($curview,$oldhead) $newhead
5417 if {$mainhead ne {}} {
5418 movehead $newhead $mainhead
5419 movedhead $newhead $mainhead
5427 # context menu for a head
5428 proc headmenu {x y id head} {
5429 global headmenuid headmenuhead headctxmenu
5432 set headmenuhead $head
5433 tk_popup $headctxmenu $x $y
5437 global headmenuid headmenuhead mainhead headids
5439 # check the tree is clean first??
5440 set oldmainhead $mainhead
5444 exec git checkout -q $headmenuhead
5450 set mainhead $headmenuhead
5451 if {[info exists headids($oldmainhead)]} {
5452 redrawtags $headids($oldmainhead)
5454 redrawtags $headmenuid
5459 global headmenuid headmenuhead mainhead
5460 global headids idheads
5462 set head $headmenuhead
5464 if {$head eq $mainhead} {
5465 error_popup "Cannot delete the currently checked-out branch"
5468 set dheads [descheads $id]
5469 if {$dheads eq $headids($head)} {
5470 # the stuff on this branch isn't on any other branch
5471 if {![confirm_popup "The commits on branch $head aren't on any other\
5472 branch.\nReally delete branch $head?"]} return
5476 if {[catch {exec git branch -D $head} err]} {
5481 removehead $id $head
5482 removedhead $id $head
5488 # Stuff for finding nearby tags
5489 proc getallcommits {} {
5490 global allcommits allids nbmp nextarc seeds
5500 # Called when the graph might have changed
5501 proc regetallcommits {} {
5502 global allcommits seeds
5504 set cmd [concat | git rev-list --all --parents]
5508 set fd [open $cmd r]
5509 fconfigure $fd -blocking 0
5515 proc restartgetall {fd} {
5516 fileevent $fd readable [list getallclines $fd]
5519 # Since most commits have 1 parent and 1 child, we group strings of
5520 # such commits into "arcs" joining branch/merge points (BMPs), which
5521 # are commits that either don't have 1 parent or don't have 1 child.
5523 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5524 # arcout(id) - outgoing arcs for BMP
5525 # arcids(a) - list of IDs on arc including end but not start
5526 # arcstart(a) - BMP ID at start of arc
5527 # arcend(a) - BMP ID at end of arc
5528 # growing(a) - arc a is still growing
5529 # arctags(a) - IDs out of arcids (excluding end) that have tags
5530 # archeads(a) - IDs out of arcids (excluding end) that have heads
5531 # The start of an arc is at the descendent end, so "incoming" means
5532 # coming from descendents, and "outgoing" means going towards ancestors.
5534 proc getallclines {fd} {
5535 global allids allparents allchildren idtags nextarc nbmp
5536 global arcnos arcids arctags arcout arcend arcstart archeads growing
5537 global seeds allcommits allcstart
5539 if {![info exists allcstart]} {
5540 set allcstart [clock clicks -milliseconds]
5543 while {[gets $fd line] >= 0} {
5544 set id [lindex $line 0]
5545 if {[info exists allparents($id)]} {
5550 set olds [lrange $line 1 end]
5551 set allparents($id) $olds
5552 if {![info exists allchildren($id)]} {
5553 set allchildren($id) {}
5558 if {[llength $olds] == 1 && [llength $a] == 1} {
5559 lappend arcids($a) $id
5560 if {[info exists idtags($id)]} {
5561 lappend arctags($a) $id
5563 if {[info exists idheads($id)]} {
5564 lappend archeads($a) $id
5566 if {[info exists allparents($olds)]} {
5567 # seen parent already
5568 if {![info exists arcout($olds)]} {
5571 lappend arcids($a) $olds
5572 set arcend($a) $olds
5575 lappend allchildren($olds) $id
5576 lappend arcnos($olds) $a
5581 foreach a $arcnos($id) {
5582 lappend arcids($a) $id
5589 lappend allchildren($p) $id
5590 set a [incr nextarc]
5591 set arcstart($a) $id
5598 if {[info exists allparents($p)]} {
5599 # seen it already, may need to make a new branch
5600 if {![info exists arcout($p)]} {
5603 lappend arcids($a) $p
5607 lappend arcnos($p) $a
5610 if {[incr nid] >= 50} {
5612 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5613 fileevent $fd readable {}
5614 after idle restartgetall $fd
5620 if {![eof $fd]} return
5622 if {[incr allcommits -1] == 0} {
5628 proc recalcarc {a} {
5629 global arctags archeads arcids idtags idheads
5633 foreach id [lrange $arcids($a) 0 end-1] {
5634 if {[info exists idtags($id)]} {
5637 if {[info exists idheads($id)]} {
5642 set archeads($a) $ah
5646 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
5647 global arcstart arcend arcout allparents growing
5650 if {[llength $a] != 1} {
5651 puts "oops splitarc called but [llength $a] arcs already"
5655 set i [lsearch -exact $arcids($a) $p]
5657 puts "oops splitarc $p not in arc $a"
5660 set na [incr nextarc]
5661 if {[info exists arcend($a)]} {
5662 set arcend($na) $arcend($a)
5664 set l [lindex $allparents([lindex $arcids($a) end]) 0]
5665 set j [lsearch -exact $arcnos($l) $a]
5666 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
5668 set tail [lrange $arcids($a) [expr {$i+1}] end]
5669 set arcids($a) [lrange $arcids($a) 0 $i]
5671 set arcstart($na) $p
5673 set arcids($na) $tail
5674 if {[info exists growing($a)]} {
5681 if {[llength $arcnos($id)] == 1} {
5684 set j [lsearch -exact $arcnos($id) $a]
5685 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
5689 # reconstruct tags and heads lists
5690 if {$arctags($a) ne {} || $archeads($a) ne {}} {
5695 set archeads($na) {}
5699 # Update things for a new commit added that is a child of one
5700 # existing commit. Used when cherry-picking.
5701 proc addnewchild {id p} {
5702 global allids allparents allchildren idtags nextarc nbmp
5703 global arcnos arcids arctags arcout arcend arcstart archeads growing
5707 set allparents($id) [list $p]
5708 set allchildren($id) {}
5712 lappend allchildren($p) $id
5713 set a [incr nextarc]
5714 set arcstart($a) $id
5717 set arcids($a) [list $p]
5719 if {![info exists arcout($p)]} {
5722 lappend arcnos($p) $a
5723 set arcout($id) [list $a]
5726 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
5727 # or 0 if neither is true.
5728 proc anc_or_desc {a b} {
5729 global arcout arcstart arcend arcnos cached_isanc
5731 if {$arcnos($a) eq $arcnos($b)} {
5732 # Both are on the same arc(s); either both are the same BMP,
5733 # or if one is not a BMP, the other is also not a BMP or is
5734 # the BMP at end of the arc (and it only has 1 incoming arc).
5738 # assert {[llength $arcnos($a)] == 1}
5739 set arc [lindex $arcnos($a) 0]
5740 set i [lsearch -exact $arcids($arc) $a]
5741 set j [lsearch -exact $arcids($arc) $b]
5742 if {$i < 0 || $i > $j} {
5749 if {![info exists arcout($a)]} {
5750 set arc [lindex $arcnos($a) 0]
5751 if {[info exists arcend($arc)]} {
5752 set aend $arcend($arc)
5756 set a $arcstart($arc)
5760 if {![info exists arcout($b)]} {
5761 set arc [lindex $arcnos($b) 0]
5762 if {[info exists arcend($arc)]} {
5763 set bend $arcend($arc)
5767 set b $arcstart($arc)
5777 if {[info exists cached_isanc($a,$bend)]} {
5778 if {$cached_isanc($a,$bend)} {
5782 if {[info exists cached_isanc($b,$aend)]} {
5783 if {$cached_isanc($b,$aend)} {
5786 if {[info exists cached_isanc($a,$bend)]} {
5791 set todo [list $a $b]
5794 for {set i 0} {$i < [llength $todo]} {incr i} {
5795 set x [lindex $todo $i]
5796 if {$anc($x) eq {}} {
5799 foreach arc $arcnos($x) {
5800 set xd $arcstart($arc)
5802 set cached_isanc($a,$bend) 1
5803 set cached_isanc($b,$aend) 0
5805 } elseif {$xd eq $aend} {
5806 set cached_isanc($b,$aend) 1
5807 set cached_isanc($a,$bend) 0
5810 if {![info exists anc($xd)]} {
5811 set anc($xd) $anc($x)
5813 } elseif {$anc($xd) ne $anc($x)} {
5818 set cached_isanc($a,$bend) 0
5819 set cached_isanc($b,$aend) 0
5823 # This identifies whether $desc has an ancestor that is
5824 # a growing tip of the graph and which is not an ancestor of $anc
5825 # and returns 0 if so and 1 if not.
5826 # If we subsequently discover a tag on such a growing tip, and that
5827 # turns out to be a descendent of $anc (which it could, since we
5828 # don't necessarily see children before parents), then $desc
5829 # isn't a good choice to display as a descendent tag of
5830 # $anc (since it is the descendent of another tag which is
5831 # a descendent of $anc). Similarly, $anc isn't a good choice to
5832 # display as a ancestor tag of $desc.
5834 proc is_certain {desc anc} {
5835 global arcnos arcout arcstart arcend growing problems
5838 if {[llength $arcnos($anc)] == 1} {
5839 # tags on the same arc are certain
5840 if {$arcnos($desc) eq $arcnos($anc)} {
5843 if {![info exists arcout($anc)]} {
5844 # if $anc is partway along an arc, use the start of the arc instead
5845 set a [lindex $arcnos($anc) 0]
5846 set anc $arcstart($a)
5849 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
5852 set a [lindex $arcnos($desc) 0]
5858 set anclist [list $x]
5862 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
5863 set x [lindex $anclist $i]
5868 foreach a $arcout($x) {
5869 if {[info exists growing($a)]} {
5870 if {![info exists growanc($x)] && $dl($x)} {
5876 if {[info exists dl($y)]} {
5880 if {![info exists done($y)]} {
5883 if {[info exists growanc($x)]} {
5887 for {set k 0} {$k < [llength $xl]} {incr k} {
5888 set z [lindex $xl $k]
5889 foreach c $arcout($z) {
5890 if {[info exists arcend($c)]} {
5892 if {[info exists dl($v)] && $dl($v)} {
5894 if {![info exists done($v)]} {
5897 if {[info exists growanc($v)]} {
5907 } elseif {$y eq $anc || !$dl($x)} {
5918 foreach x [array names growanc] {
5926 proc validate_arctags {a} {
5927 global arctags idtags
5931 foreach id $arctags($a) {
5933 if {![info exists idtags($id)]} {
5934 set na [lreplace $na $i $i]
5941 proc validate_archeads {a} {
5942 global archeads idheads
5945 set na $archeads($a)
5946 foreach id $archeads($a) {
5948 if {![info exists idheads($id)]} {
5949 set na [lreplace $na $i $i]
5953 set archeads($a) $na
5956 # Return the list of IDs that have tags that are descendents of id,
5957 # ignoring IDs that are descendents of IDs already reported.
5958 proc desctags {id} {
5959 global arcnos arcstart arcids arctags idtags allparents
5960 global growing cached_dtags
5962 if {![info exists allparents($id)]} {
5965 set t1 [clock clicks -milliseconds]
5967 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
5968 # part-way along an arc; check that arc first
5969 set a [lindex $arcnos($id) 0]
5970 if {$arctags($a) ne {}} {
5972 set i [lsearch -exact $arcids($a) $id]
5974 foreach t $arctags($a) {
5975 set j [lsearch -exact $arcids($a) $t]
5983 set id $arcstart($a)
5984 if {[info exists idtags($id)]} {
5988 if {[info exists cached_dtags($id)]} {
5989 return $cached_dtags($id)
5996 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
5997 set id [lindex $todo $i]
5999 set ta [info exists hastaggedancestor($id)]
6003 # ignore tags on starting node
6004 if {!$ta && $i > 0} {
6005 if {[info exists idtags($id)]} {
6008 } elseif {[info exists cached_dtags($id)]} {
6009 set tagloc($id) $cached_dtags($id)
6013 foreach a $arcnos($id) {
6015 if {!$ta && $arctags($a) ne {}} {
6017 if {$arctags($a) ne {}} {
6018 lappend tagloc($id) [lindex $arctags($a) end]
6021 if {$ta || $arctags($a) ne {}} {
6022 set tomark [list $d]
6023 for {set j 0} {$j < [llength $tomark]} {incr j} {
6024 set dd [lindex $tomark $j]
6025 if {![info exists hastaggedancestor($dd)]} {
6026 if {[info exists done($dd)]} {
6027 foreach b $arcnos($dd) {
6028 lappend tomark $arcstart($b)
6030 if {[info exists tagloc($dd)]} {
6033 } elseif {[info exists queued($dd)]} {
6036 set hastaggedancestor($dd) 1
6040 if {![info exists queued($d)]} {
6043 if {![info exists hastaggedancestor($d)]} {
6050 foreach id [array names tagloc] {
6051 if {![info exists hastaggedancestor($id)]} {
6052 foreach t $tagloc($id) {
6053 if {[lsearch -exact $tags $t] < 0} {
6059 set t2 [clock clicks -milliseconds]
6062 # remove tags that are descendents of other tags
6063 for {set i 0} {$i < [llength $tags]} {incr i} {
6064 set a [lindex $tags $i]
6065 for {set j 0} {$j < $i} {incr j} {
6066 set b [lindex $tags $j]
6067 set r [anc_or_desc $a $b]
6069 set tags [lreplace $tags $j $j]
6072 } elseif {$r == -1} {
6073 set tags [lreplace $tags $i $i]
6080 if {[array names growing] ne {}} {
6081 # graph isn't finished, need to check if any tag could get
6082 # eclipsed by another tag coming later. Simply ignore any
6083 # tags that could later get eclipsed.
6086 if {[is_certain $t $origid]} {
6090 if {$tags eq $ctags} {
6091 set cached_dtags($origid) $tags
6096 set cached_dtags($origid) $tags
6098 set t3 [clock clicks -milliseconds]
6099 if {0 && $t3 - $t1 >= 100} {
6100 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6101 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6107 global arcnos arcids arcout arcend arctags idtags allparents
6108 global growing cached_atags
6110 if {![info exists allparents($id)]} {
6113 set t1 [clock clicks -milliseconds]
6115 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6116 # part-way along an arc; check that arc first
6117 set a [lindex $arcnos($id) 0]
6118 if {$arctags($a) ne {}} {
6120 set i [lsearch -exact $arcids($a) $id]
6121 foreach t $arctags($a) {
6122 set j [lsearch -exact $arcids($a) $t]
6128 if {![info exists arcend($a)]} {
6132 if {[info exists idtags($id)]} {
6136 if {[info exists cached_atags($id)]} {
6137 return $cached_atags($id)
6145 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6146 set id [lindex $todo $i]
6148 set td [info exists hastaggeddescendent($id)]
6152 # ignore tags on starting node
6153 if {!$td && $i > 0} {
6154 if {[info exists idtags($id)]} {
6157 } elseif {[info exists cached_atags($id)]} {
6158 set tagloc($id) $cached_atags($id)
6162 foreach a $arcout($id) {
6163 if {!$td && $arctags($a) ne {}} {
6165 if {$arctags($a) ne {}} {
6166 lappend tagloc($id) [lindex $arctags($a) 0]
6169 if {![info exists arcend($a)]} continue
6171 if {$td || $arctags($a) ne {}} {
6172 set tomark [list $d]
6173 for {set j 0} {$j < [llength $tomark]} {incr j} {
6174 set dd [lindex $tomark $j]
6175 if {![info exists hastaggeddescendent($dd)]} {
6176 if {[info exists done($dd)]} {
6177 foreach b $arcout($dd) {
6178 if {[info exists arcend($b)]} {
6179 lappend tomark $arcend($b)
6182 if {[info exists tagloc($dd)]} {
6185 } elseif {[info exists queued($dd)]} {
6188 set hastaggeddescendent($dd) 1
6192 if {![info exists queued($d)]} {
6195 if {![info exists hastaggeddescendent($d)]} {
6201 set t2 [clock clicks -milliseconds]
6204 foreach id [array names tagloc] {
6205 if {![info exists hastaggeddescendent($id)]} {
6206 foreach t $tagloc($id) {
6207 if {[lsearch -exact $tags $t] < 0} {
6214 # remove tags that are ancestors of other tags
6215 for {set i 0} {$i < [llength $tags]} {incr i} {
6216 set a [lindex $tags $i]
6217 for {set j 0} {$j < $i} {incr j} {
6218 set b [lindex $tags $j]
6219 set r [anc_or_desc $a $b]
6221 set tags [lreplace $tags $j $j]
6224 } elseif {$r == 1} {
6225 set tags [lreplace $tags $i $i]
6232 if {[array names growing] ne {}} {
6233 # graph isn't finished, need to check if any tag could get
6234 # eclipsed by another tag coming later. Simply ignore any
6235 # tags that could later get eclipsed.
6238 if {[is_certain $origid $t]} {
6242 if {$tags eq $ctags} {
6243 set cached_atags($origid) $tags
6248 set cached_atags($origid) $tags
6250 set t3 [clock clicks -milliseconds]
6251 if {0 && $t3 - $t1 >= 100} {
6252 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6253 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6258 # Return the list of IDs that have heads that are descendents of id,
6259 # including id itself if it has a head.
6260 proc descheads {id} {
6261 global arcnos arcstart arcids archeads idheads cached_dheads
6264 if {![info exists allparents($id)]} {
6268 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6269 # part-way along an arc; check it first
6270 set a [lindex $arcnos($id) 0]
6271 if {$archeads($a) ne {}} {
6272 validate_archeads $a
6273 set i [lsearch -exact $arcids($a) $id]
6274 foreach t $archeads($a) {
6275 set j [lsearch -exact $arcids($a) $t]
6280 set id $arcstart($a)
6285 for {set i 0} {$i < [llength $todo]} {incr i} {
6286 set id [lindex $todo $i]
6287 if {[info exists cached_dheads($id)]} {
6288 set ret [concat $ret $cached_dheads($id)]
6290 if {[info exists idheads($id)]} {
6293 foreach a $arcnos($id) {
6294 if {$archeads($a) ne {}} {
6295 set ret [concat $ret $archeads($a)]
6298 if {![info exists seen($d)]} {
6305 set ret [lsort -unique $ret]
6306 set cached_dheads($origid) $ret
6309 proc addedtag {id} {
6310 global arcnos arcout cached_dtags cached_atags
6312 if {![info exists arcnos($id)]} return
6313 if {![info exists arcout($id)]} {
6314 recalcarc [lindex $arcnos($id) 0]
6316 catch {unset cached_dtags}
6317 catch {unset cached_atags}
6320 proc addedhead {hid head} {
6321 global arcnos arcout cached_dheads
6323 if {![info exists arcnos($hid)]} return
6324 if {![info exists arcout($hid)]} {
6325 recalcarc [lindex $arcnos($hid) 0]
6327 catch {unset cached_dheads}
6330 proc removedhead {hid head} {
6331 global cached_dheads
6333 catch {unset cached_dheads}
6336 proc movedhead {hid head} {
6337 global arcnos arcout cached_dheads
6339 if {![info exists arcnos($hid)]} return
6340 if {![info exists arcout($hid)]} {
6341 recalcarc [lindex $arcnos($hid) 0]
6343 catch {unset cached_dheads}
6346 proc changedrefs {} {
6347 global cached_dheads cached_dtags cached_atags
6348 global arctags archeads arcnos arcout idheads idtags
6350 foreach id [concat [array names idheads] [array names idtags]] {
6351 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6352 set a [lindex $arcnos($id) 0]
6353 if {![info exists donearc($a)]} {
6359 catch {unset cached_dtags}
6360 catch {unset cached_atags}
6361 catch {unset cached_dheads}
6364 proc rereadrefs {} {
6365 global idtags idheads idotherrefs mainhead
6367 set refids [concat [array names idtags] \
6368 [array names idheads] [array names idotherrefs]]
6369 foreach id $refids {
6370 if {![info exists ref($id)]} {
6371 set ref($id) [listrefs $id]
6374 set oldmainhead $mainhead
6377 set refids [lsort -unique [concat $refids [array names idtags] \
6378 [array names idheads] [array names idotherrefs]]]
6379 foreach id $refids {
6380 set v [listrefs $id]
6381 if {![info exists ref($id)] || $ref($id) != $v ||
6382 ($id eq $oldmainhead && $id ne $mainhead) ||
6383 ($id eq $mainhead && $id ne $oldmainhead)} {
6389 proc listrefs {id} {
6390 global idtags idheads idotherrefs
6393 if {[info exists idtags($id)]} {
6397 if {[info exists idheads($id)]} {
6401 if {[info exists idotherrefs($id)]} {
6402 set z $idotherrefs($id)
6404 return [list $x $y $z]
6407 proc showtag {tag isnew} {
6408 global ctext tagcontents tagids linknum
6411 addtohistory [list showtag $tag 0]
6413 $ctext conf -state normal
6416 if {[info exists tagcontents($tag)]} {
6417 set text $tagcontents($tag)
6419 set text "Tag: $tag\nId: $tagids($tag)"
6421 appendwithlinks $text {}
6422 $ctext conf -state disabled
6434 global maxwidth maxgraphpct diffopts
6435 global oldprefs prefstop showneartags
6436 global bgcolor fgcolor ctext diffcolors selectbgcolor
6437 global uifont tabstop
6441 if {[winfo exists $top]} {
6445 foreach v {maxwidth maxgraphpct diffopts showneartags} {
6446 set oldprefs($v) [set $v]
6449 wm title $top "Gitk preferences"
6450 label $top.ldisp -text "Commit list display options"
6451 $top.ldisp configure -font $uifont
6452 grid $top.ldisp - -sticky w -pady 10
6453 label $top.spacer -text " "
6454 label $top.maxwidthl -text "Maximum graph width (lines)" \
6456 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6457 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6458 label $top.maxpctl -text "Maximum graph width (% of pane)" \
6460 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6461 grid x $top.maxpctl $top.maxpct -sticky w
6463 label $top.ddisp -text "Diff display options"
6464 $top.ddisp configure -font $uifont
6465 grid $top.ddisp - -sticky w -pady 10
6466 label $top.diffoptl -text "Options for diff program" \
6468 entry $top.diffopt -width 20 -textvariable diffopts
6469 grid x $top.diffoptl $top.diffopt -sticky w
6471 label $top.ntag.l -text "Display nearby tags" -font optionfont
6472 checkbutton $top.ntag.b -variable showneartags
6473 pack $top.ntag.b $top.ntag.l -side left
6474 grid x $top.ntag -sticky w
6475 label $top.tabstopl -text "tabstop" -font optionfont
6476 entry $top.tabstop -width 10 -textvariable tabstop
6477 grid x $top.tabstopl $top.tabstop -sticky w
6479 label $top.cdisp -text "Colors: press to choose"
6480 $top.cdisp configure -font $uifont
6481 grid $top.cdisp - -sticky w -pady 10
6482 label $top.bg -padx 40 -relief sunk -background $bgcolor
6483 button $top.bgbut -text "Background" -font optionfont \
6484 -command [list choosecolor bgcolor 0 $top.bg background setbg]
6485 grid x $top.bgbut $top.bg -sticky w
6486 label $top.fg -padx 40 -relief sunk -background $fgcolor
6487 button $top.fgbut -text "Foreground" -font optionfont \
6488 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6489 grid x $top.fgbut $top.fg -sticky w
6490 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6491 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6492 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6493 [list $ctext tag conf d0 -foreground]]
6494 grid x $top.diffoldbut $top.diffold -sticky w
6495 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6496 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6497 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6498 [list $ctext tag conf d1 -foreground]]
6499 grid x $top.diffnewbut $top.diffnew -sticky w
6500 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6501 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6502 -command [list choosecolor diffcolors 2 $top.hunksep \
6503 "diff hunk header" \
6504 [list $ctext tag conf hunksep -foreground]]
6505 grid x $top.hunksepbut $top.hunksep -sticky w
6506 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6507 button $top.selbgbut -text "Select bg" -font optionfont \
6508 -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6509 grid x $top.selbgbut $top.selbgsep -sticky w
6512 button $top.buts.ok -text "OK" -command prefsok -default active
6513 $top.buts.ok configure -font $uifont
6514 button $top.buts.can -text "Cancel" -command prefscan -default normal
6515 $top.buts.can configure -font $uifont
6516 grid $top.buts.ok $top.buts.can
6517 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6518 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6519 grid $top.buts - - -pady 10 -sticky ew
6520 bind $top <Visibility> "focus $top.buts.ok"
6523 proc choosecolor {v vi w x cmd} {
6526 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6527 -title "Gitk: choose color for $x"]
6528 if {$c eq {}} return
6529 $w conf -background $c
6535 global bglist cflist
6537 $w configure -selectbackground $c
6539 $cflist tag configure highlight \
6540 -background [$cflist cget -selectbackground]
6541 allcanvs itemconf secsel -fill $c
6548 $w conf -background $c
6556 $w conf -foreground $c
6558 allcanvs itemconf text -fill $c
6559 $canv itemconf circle -outline $c
6563 global maxwidth maxgraphpct diffopts
6564 global oldprefs prefstop showneartags
6566 foreach v {maxwidth maxgraphpct diffopts showneartags} {
6567 set $v $oldprefs($v)
6569 catch {destroy $prefstop}
6574 global maxwidth maxgraphpct
6575 global oldprefs prefstop showneartags
6576 global charspc ctext tabstop
6578 catch {destroy $prefstop}
6580 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
6581 if {$maxwidth != $oldprefs(maxwidth)
6582 || $maxgraphpct != $oldprefs(maxgraphpct)} {
6584 } elseif {$showneartags != $oldprefs(showneartags)} {
6589 proc formatdate {d} {
6590 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6593 # This list of encoding names and aliases is distilled from
6594 # http://www.iana.org/assignments/character-sets.
6595 # Not all of them are supported by Tcl.
6596 set encoding_aliases {
6597 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6598 ISO646-US US-ASCII us IBM367 cp367 csASCII }
6599 { ISO-10646-UTF-1 csISO10646UTF1 }
6600 { ISO_646.basic:1983 ref csISO646basic1983 }
6601 { INVARIANT csINVARIANT }
6602 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6603 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6604 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6605 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6606 { NATS-DANO iso-ir-9-1 csNATSDANO }
6607 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6608 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6609 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6610 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6611 { ISO-2022-KR csISO2022KR }
6613 { ISO-2022-JP csISO2022JP }
6614 { ISO-2022-JP-2 csISO2022JP2 }
6615 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6617 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6618 { IT iso-ir-15 ISO646-IT csISO15Italian }
6619 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6620 { ES iso-ir-17 ISO646-ES csISO17Spanish }
6621 { greek7-old iso-ir-18 csISO18Greek7Old }
6622 { latin-greek iso-ir-19 csISO19LatinGreek }
6623 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6624 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6625 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6626 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6627 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6628 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6629 { INIS iso-ir-49 csISO49INIS }
6630 { INIS-8 iso-ir-50 csISO50INIS8 }
6631 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6632 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6633 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6634 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6635 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6636 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6638 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6639 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6640 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6641 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6642 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6643 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6644 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6645 { greek7 iso-ir-88 csISO88Greek7 }
6646 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6647 { iso-ir-90 csISO90 }
6648 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6649 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6650 csISO92JISC62991984b }
6651 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6652 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6653 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6654 csISO95JIS62291984handadd }
6655 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6656 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6657 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6658 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6660 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6661 { T.61-7bit iso-ir-102 csISO102T617bit }
6662 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6663 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6664 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6665 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6666 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6667 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6668 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6669 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6670 arabic csISOLatinArabic }
6671 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6672 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6673 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6674 greek greek8 csISOLatinGreek }
6675 { T.101-G2 iso-ir-128 csISO128T101G2 }
6676 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6678 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6679 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6680 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6681 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6682 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6683 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6684 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6685 csISOLatinCyrillic }
6686 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6687 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6688 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6689 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6690 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6691 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6692 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6693 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6694 { ISO_10367-box iso-ir-155 csISO10367Box }
6695 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6696 { latin-lap lap iso-ir-158 csISO158Lap }
6697 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6698 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6701 { JIS_X0201 X0201 csHalfWidthKatakana }
6702 { KSC5636 ISO646-KR csKSC5636 }
6703 { ISO-10646-UCS-2 csUnicode }
6704 { ISO-10646-UCS-4 csUCS4 }
6705 { DEC-MCS dec csDECMCS }
6706 { hp-roman8 roman8 r8 csHPRoman8 }
6707 { macintosh mac csMacintosh }
6708 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6710 { IBM038 EBCDIC-INT cp038 csIBM038 }
6711 { IBM273 CP273 csIBM273 }
6712 { IBM274 EBCDIC-BE CP274 csIBM274 }
6713 { IBM275 EBCDIC-BR cp275 csIBM275 }
6714 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6715 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6716 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6717 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6718 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6719 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6720 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6721 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6722 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6723 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6724 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6725 { IBM437 cp437 437 csPC8CodePage437 }
6726 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6727 { IBM775 cp775 csPC775Baltic }
6728 { IBM850 cp850 850 csPC850Multilingual }
6729 { IBM851 cp851 851 csIBM851 }
6730 { IBM852 cp852 852 csPCp852 }
6731 { IBM855 cp855 855 csIBM855 }
6732 { IBM857 cp857 857 csIBM857 }
6733 { IBM860 cp860 860 csIBM860 }
6734 { IBM861 cp861 861 cp-is csIBM861 }
6735 { IBM862 cp862 862 csPC862LatinHebrew }
6736 { IBM863 cp863 863 csIBM863 }
6737 { IBM864 cp864 csIBM864 }
6738 { IBM865 cp865 865 csIBM865 }
6739 { IBM866 cp866 866 csIBM866 }
6740 { IBM868 CP868 cp-ar csIBM868 }
6741 { IBM869 cp869 869 cp-gr csIBM869 }
6742 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6743 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6744 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6745 { IBM891 cp891 csIBM891 }
6746 { IBM903 cp903 csIBM903 }
6747 { IBM904 cp904 904 csIBBM904 }
6748 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6749 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6750 { IBM1026 CP1026 csIBM1026 }
6751 { EBCDIC-AT-DE csIBMEBCDICATDE }
6752 { EBCDIC-AT-DE-A csEBCDICATDEA }
6753 { EBCDIC-CA-FR csEBCDICCAFR }
6754 { EBCDIC-DK-NO csEBCDICDKNO }
6755 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6756 { EBCDIC-FI-SE csEBCDICFISE }
6757 { EBCDIC-FI-SE-A csEBCDICFISEA }
6758 { EBCDIC-FR csEBCDICFR }
6759 { EBCDIC-IT csEBCDICIT }
6760 { EBCDIC-PT csEBCDICPT }
6761 { EBCDIC-ES csEBCDICES }
6762 { EBCDIC-ES-A csEBCDICESA }
6763 { EBCDIC-ES-S csEBCDICESS }
6764 { EBCDIC-UK csEBCDICUK }
6765 { EBCDIC-US csEBCDICUS }
6766 { UNKNOWN-8BIT csUnknown8BiT }
6767 { MNEMONIC csMnemonic }
6772 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6773 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6774 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6775 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6776 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6777 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6778 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6779 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6780 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6781 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6782 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6783 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6784 { IBM1047 IBM-1047 }
6785 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6786 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6787 { UNICODE-1-1 csUnicode11 }
6790 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6791 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6793 { ISO-8859-15 ISO_8859-15 Latin-9 }
6794 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6795 { GBK CP936 MS936 windows-936 }
6796 { JIS_Encoding csJISEncoding }
6797 { Shift_JIS MS_Kanji csShiftJIS }
6798 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6800 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6801 { ISO-10646-UCS-Basic csUnicodeASCII }
6802 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6803 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6804 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6805 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6806 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6807 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6808 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6809 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6810 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6811 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6812 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6813 { Ventura-US csVenturaUS }
6814 { Ventura-International csVenturaInternational }
6815 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6816 { PC8-Turkish csPC8Turkish }
6817 { IBM-Symbols csIBMSymbols }
6818 { IBM-Thai csIBMThai }
6819 { HP-Legal csHPLegal }
6820 { HP-Pi-font csHPPiFont }
6821 { HP-Math8 csHPMath8 }
6822 { Adobe-Symbol-Encoding csHPPSMath }
6823 { HP-DeskTop csHPDesktop }
6824 { Ventura-Math csVenturaMath }
6825 { Microsoft-Publishing csMicrosoftPublishing }
6826 { Windows-31J csWindows31J }
6831 proc tcl_encoding {enc} {
6832 global encoding_aliases
6833 set names [encoding names]
6834 set lcnames [string tolower $names]
6835 set enc [string tolower $enc]
6836 set i [lsearch -exact $lcnames $enc]
6838 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6839 if {[regsub {^iso[-_]} $enc iso encx]} {
6840 set i [lsearch -exact $lcnames $encx]
6844 foreach l $encoding_aliases {
6845 set ll [string tolower $l]
6846 if {[lsearch -exact $ll $enc] < 0} continue
6847 # look through the aliases for one that tcl knows about
6849 set i [lsearch -exact $lcnames $e]
6851 if {[regsub {^iso[-_]} $e iso ex]} {
6852 set i [lsearch -exact $lcnames $ex]
6861 return [lindex $names $i]
6868 set diffopts "-U 5 -p"
6869 set wrcomcmd "git diff-tree --stdin -p --pretty"
6873 set gitencoding [exec git config --get i18n.commitencoding]
6875 if {$gitencoding == ""} {
6876 set gitencoding "utf-8"
6878 set tclencoding [tcl_encoding $gitencoding]
6879 if {$tclencoding == {}} {
6880 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6883 set mainfont {Helvetica 9}
6884 set textfont {Courier 9}
6885 set uifont {Helvetica 9 bold}
6887 set findmergefiles 0
6895 set cmitmode "patch"
6896 set wrapcomment "none"
6900 set colors {green red blue magenta darkgrey brown orange}
6903 set diffcolors {red "#00a000" blue}
6904 set selectbgcolor gray85
6906 catch {source ~/.gitk}
6908 font create optionfont -family sans-serif -size -12
6912 switch -regexp -- $arg {
6914 "^-d" { set datemode 1 }
6916 lappend revtreeargs $arg
6921 # check that we can find a .git directory somewhere...
6923 if {![file isdirectory $gitdir]} {
6924 show_error {} . "Cannot find the git directory \"$gitdir\"."
6928 set cmdline_files {}
6929 set i [lsearch -exact $revtreeargs "--"]
6931 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6932 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6933 } elseif {$revtreeargs ne {}} {
6935 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6936 set cmdline_files [split $f "\n"]
6937 set n [llength $cmdline_files]
6938 set revtreeargs [lrange $revtreeargs 0 end-$n]
6940 # unfortunately we get both stdout and stderr in $err,
6941 # so look for "fatal:".
6942 set i [string first "fatal:" $err]
6944 set err [string range $err [expr {$i + 6}] end]
6946 show_error {} . "Bad arguments to gitk:\n$err"
6955 set highlight_paths {}
6956 set searchdirn -forwards
6966 set selectedhlview None
6977 wm title . "[file tail $argv0]: [file tail [pwd]]"
6980 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6981 # create a view for the files/dirs specified on the command line
6985 set viewname(1) "Command line"
6986 set viewfiles(1) $cmdline_files
6987 set viewargs(1) $revtreeargs
6990 .bar.view entryconf Edit* -state normal
6991 .bar.view entryconf Delete* -state normal
6994 if {[info exists permviews]} {
6995 foreach v $permviews {
6998 set viewname($n) [lindex $v 0]
6999 set viewfiles($n) [lindex $v 1]
7000 set viewargs($n) [lindex $v 2]