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
)]} {
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
27 set commitidx
($view) 0
28 set args
$viewargs($view)
29 if {$viewfiles($view) ne
{}} {
30 set args
[concat
$args "--" $viewfiles($view)]
32 set order
"--topo-order"
34 set order
"--date-order"
37 set fd
[open
[concat | git rev-list
--header $order \
38 --parents --boundary --default HEAD
$args] r
]
40 puts stderr
"Error executing git rev-list: $err"
44 set leftover
($view) {}
45 fconfigure
$fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure
$fd -encoding $tclencoding
49 fileevent
$fd readable
[list getcommitlines
$fd $view]
53 proc stop_rev_list
{} {
56 if {![info exists commfd
($curview)]} return
57 set fd
$commfd($curview)
63 unset commfd
($curview)
67 global phase canv mainfont curview
71 start_rev_list
$curview
72 show_status
"Reading commits..."
75 proc getcommitlines
{fd view
} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof
$fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure
$fd -blocking 1
90 if {[catch
{close
$fd} err
]} {
92 if {$view != $curview} {
93 set fv
" for the \"$viewname($view)\" view"
95 if {[string range
$err 0 4] == "usage"} {
96 set err
"Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq
"Command line"} {
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
104 set err
"Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i
[string first
"\0" $stuff $start]
118 append leftover
($view) [string range
$stuff $start end
]
122 set cmit
$leftover($view)
123 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
124 set leftover
($view) {}
126 set cmit
[string range
$stuff $start [expr {$i - 1}]]
128 set start
[expr {$i + 1}]
129 set j
[string first
"\n" $cmit]
133 set ids
[string range
$cmit 0 [expr {$j - 1}]]
134 if {[string range
$ids 0 0] == "-"} {
136 set ids
[string range
$ids 1 end
]
140 if {[string length
$id] != 40} {
148 if {[string length
$shortcmit] > 80} {
149 set shortcmit
"[string range $shortcmit 0 80]..."
151 error_popup
"Can't parse git rev-list output: {$shortcmit}"
154 set id
[lindex
$ids 0]
156 set olds
[lrange
$ids 1 end
]
159 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
160 lappend children
($view,$p) $id
167 if {![info exists children
($view,$id)]} {
168 set children
($view,$id) {}
170 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
171 set commitrow
($view,$id) $commitidx($view)
172 incr commitidx
($view)
173 if {$view == $curview} {
174 lappend parentlist
$olds
175 lappend childlist
$children($view,$id)
176 lappend displayorder
$id
177 lappend commitlisted
$listed
179 lappend vparentlist
($view) $olds
180 lappend vchildlist
($view) $children($view,$id)
181 lappend vdisporder
($view) $id
182 lappend vcmitlisted
($view) $listed
187 if {$view == $curview} {
189 } elseif
{[info exists hlview
] && $view == $hlview} {
193 if {[clock clicks
-milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v
[array names commfd
] {
202 fileevent
$commfd($v) readable
{}
205 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate
[expr {$numcommits + 1}]
208 } elseif
{$numcommits < 10000} {
209 set ncmupdate
[expr {$numcommits + 10}]
211 set ncmupdate
[expr {$numcommits + 100}]
213 foreach v
[array names commfd
] {
215 fileevent
$fd readable
[list getcommitlines
$fd $v]
219 proc readcommit
{id
} {
220 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
221 parsecommit
$id $contents 0
224 proc updatecommits
{} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
233 foreach id
$displayorder {
234 catch
{unset children
($n,$id)}
235 catch
{unset commitrow
($n,$id)}
238 catch
{unset selectedline
}
239 catch
{unset thickerline
}
240 catch
{unset viewdata
($n)}
246 proc parsecommit
{id contents listed
} {
247 global commitinfo cdate
256 set hdrend
[string first
"\n\n" $contents]
258 # should never happen...
259 set hdrend
[string length
$contents]
261 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
262 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
263 foreach line
[split $header "\n"] {
264 set tag
[lindex
$line 0]
265 if {$tag == "author"} {
266 set audate
[lindex
$line end-1
]
267 set auname
[lrange
$line 1 end-2
]
268 } elseif
{$tag == "committer"} {
269 set comdate
[lindex
$line end-1
]
270 set comname
[lrange
$line 1 end-2
]
274 # take the first line of the comment as the headline
275 set i
[string first
"\n" $comment]
277 set headline
[string trim
[string range
$comment 0 $i]]
279 set headline
$comment
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
285 foreach line
[split $comment "\n"] {
286 append newcomment
" "
287 append newcomment
$line
288 append newcomment
"\n"
290 set comment
$newcomment
292 if {$comdate != {}} {
293 set cdate
($id) $comdate
295 set commitinfo
($id) [list
$headline $auname $audate \
296 $comname $comdate $comment]
299 proc getcommit
{id
} {
300 global commitdata commitinfo
302 if {[info exists commitdata
($id)]} {
303 parsecommit
$id $commitdata($id) 1
306 if {![info exists commitinfo
($id)]} {
307 set commitinfo
($id) {"No commit information available"}
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs mainhead
317 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
320 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
321 while {0 <= [set n
[gets
$refd line
]]} {
322 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
326 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
329 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
333 if {[regexp
{^remotes
/} $path match
]} {
336 if {$type == "tags"} {
337 set tagids
($name) $id
338 lappend idtags
($id) $name
343 set commit
[exec git rev-parse
"$id^0"]
344 if {$commit != $id} {
345 set tagids
($name) $commit
346 lappend idtags
($commit) $name
350 set tagcontents
($name) [exec git cat-file tag
$id]
352 } elseif
{ $type == "heads" } {
353 set headids
($name) $id
354 lappend idheads
($id) $name
356 set otherrefids
($name) $id
357 lappend idotherrefs
($id) $name
363 set thehead
[exec git symbolic-ref HEAD
]
364 if {[string match
"refs/heads/*" $thehead]} {
365 set mainhead
[string range
$thehead 11 end
]
370 proc show_error
{w top msg
} {
371 message
$w.m
-text $msg -justify center
-aspect 400
372 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
373 button
$w.ok
-text OK
-command "destroy $top"
374 pack
$w.ok
-side bottom
-fill x
375 bind $top <Visibility
> "grab $top; focus $top"
376 bind $top <Key-Return
> "destroy $top"
380 proc error_popup msg
{
384 show_error
$w $w $msg
387 proc confirm_popup msg
{
393 message
$w.m
-text $msg -justify center
-aspect 400
394 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
395 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
396 pack
$w.ok
-side left
-fill x
397 button
$w.cancel
-text Cancel
-command "destroy $w"
398 pack
$w.cancel
-side right
-fill x
399 bind $w <Visibility
> "grab $w; focus $w"
405 global canv canv2 canv3 linespc charspc ctext cflist
406 global textfont mainfont uifont
407 global findtype findtypemenu findloc findstring fstring geometry
408 global entries sha1entry sha1string sha1but
409 global maincursor textcursor curtextcursor
410 global rowctxmenu mergemax wrapcomment
411 global highlight_files gdttype
412 global searchstring sstring
413 global bgcolor fgcolor bglist fglist diffcolors
417 .bar add cascade
-label "File" -menu .bar.
file
418 .bar configure
-font $uifont
420 .bar.
file add
command -label "Update" -command updatecommits
421 .bar.
file add
command -label "Reread references" -command rereadrefs
422 .bar.
file add
command -label "Quit" -command doquit
423 .bar.
file configure
-font $uifont
425 .bar add cascade
-label "Edit" -menu .bar.edit
426 .bar.edit add
command -label "Preferences" -command doprefs
427 .bar.edit configure
-font $uifont
429 menu .bar.view
-font $uifont
430 .bar add cascade
-label "View" -menu .bar.view
431 .bar.view add
command -label "New view..." -command {newview
0}
432 .bar.view add
command -label "Edit view..." -command editview \
434 .bar.view add
command -label "Delete view" -command delview
-state disabled
435 .bar.view add separator
436 .bar.view add radiobutton
-label "All files" -command {showview
0} \
437 -variable selectedview
-value 0
440 .bar add cascade
-label "Help" -menu .bar.
help
441 .bar.
help add
command -label "About gitk" -command about
442 .bar.
help add
command -label "Key bindings" -command keys
443 .bar.
help configure
-font $uifont
444 . configure
-menu .bar
446 if {![info exists geometry
(canv1
)]} {
447 set geometry
(canv1
) [expr {45 * $charspc}]
448 set geometry
(canv2
) [expr {30 * $charspc}]
449 set geometry
(canv3
) [expr {15 * $charspc}]
450 set geometry
(canvh
) [expr {25 * $linespc + 4}]
451 set geometry
(ctextw
) 80
452 set geometry
(ctexth
) 30
453 set geometry
(cflistw
) 30
455 panedwindow .ctop
-orient vertical
456 if {[info exists geometry
(width
)]} {
457 .ctop conf
-width $geometry(width
) -height $geometry(height
)
458 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
459 set geometry
(ctexth
) [expr {($texth - 8) /
460 [font metrics
$textfont -linespace]}]
465 pack .ctop.top.lbar
-side bottom
-fill x
466 pack .ctop.top.bar
-side bottom
-fill x
467 set cscroll .ctop.top.csb
468 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
469 pack
$cscroll -side right
-fill y
470 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
471 pack .ctop.top.clist
-side top
-fill both
-expand 1
473 set canv .ctop.top.clist.canv
474 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
475 -background $bgcolor -bd 0 \
476 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
477 .ctop.top.clist add
$canv
478 set canv2 .ctop.top.clist.canv2
479 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
480 -background $bgcolor -bd 0 -yscrollincr $linespc
481 .ctop.top.clist add
$canv2
482 set canv3 .ctop.top.clist.canv3
483 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
484 -background $bgcolor -bd 0 -yscrollincr $linespc
485 .ctop.top.clist add
$canv3
486 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
487 lappend bglist
$canv $canv2 $canv3
489 set sha1entry .ctop.top.bar.sha1
490 set entries
$sha1entry
491 set sha1but .ctop.top.bar.sha1label
492 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
493 -command gotocommit
-width 8 -font $uifont
494 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
495 pack .ctop.top.bar.sha1label
-side left
496 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
497 trace add variable sha1string
write sha1change
498 pack
$sha1entry -side left
-pady 2
500 image create bitmap bm-left
-data {
501 #define left_width 16
502 #define left_height 16
503 static unsigned char left_bits
[] = {
504 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
505 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
506 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
508 image create bitmap bm-right
-data {
509 #define right_width 16
510 #define right_height 16
511 static unsigned char right_bits
[] = {
512 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
513 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
514 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
516 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
517 -state disabled
-width 26
518 pack .ctop.top.bar.leftbut
-side left
-fill y
519 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
520 -state disabled
-width 26
521 pack .ctop.top.bar.rightbut
-side left
-fill y
523 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
524 pack .ctop.top.bar.findbut
-side left
526 set fstring .ctop.top.bar.findstring
527 lappend entries
$fstring
528 entry
$fstring -width 30 -font $textfont -textvariable findstring
529 trace add variable findstring
write find_change
530 pack
$fstring -side left
-expand 1 -fill x
532 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
533 findtype Exact IgnCase Regexp
]
534 trace add variable findtype
write find_change
535 .ctop.top.bar.findtype configure
-font $uifont
536 .ctop.top.bar.findtype.menu configure
-font $uifont
537 set findloc
"All fields"
538 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
539 Comments Author Committer
540 trace add variable findloc
write find_change
541 .ctop.top.bar.findloc configure
-font $uifont
542 .ctop.top.bar.findloc.menu configure
-font $uifont
543 pack .ctop.top.bar.findloc
-side right
544 pack .ctop.top.bar.findtype
-side right
546 label .ctop.top.lbar.flabel
-text "Highlight: Commits " \
548 pack .ctop.top.lbar.flabel
-side left
-fill y
549 set gdttype
"touching paths:"
550 set gm
[tk_optionMenu .ctop.top.lbar.gdttype gdttype
"touching paths:" \
551 "adding/removing string:"]
552 trace add variable gdttype
write hfiles_change
553 $gm conf
-font $uifont
554 .ctop.top.lbar.gdttype conf
-font $uifont
555 pack .ctop.top.lbar.gdttype
-side left
-fill y
556 entry .ctop.top.lbar.fent
-width 25 -font $textfont \
557 -textvariable highlight_files
558 trace add variable highlight_files
write hfiles_change
559 lappend entries .ctop.top.lbar.fent
560 pack .ctop.top.lbar.fent
-side left
-fill x
-expand 1
561 label .ctop.top.lbar.vlabel
-text " OR in view" -font $uifont
562 pack .ctop.top.lbar.vlabel
-side left
-fill y
563 global viewhlmenu selectedhlview
564 set viewhlmenu
[tk_optionMenu .ctop.top.lbar.vhl selectedhlview None
]
565 $viewhlmenu entryconf
0 -command delvhighlight
566 $viewhlmenu conf
-font $uifont
567 .ctop.top.lbar.vhl conf
-font $uifont
568 pack .ctop.top.lbar.vhl
-side left
-fill y
569 label .ctop.top.lbar.rlabel
-text " OR " -font $uifont
570 pack .ctop.top.lbar.rlabel
-side left
-fill y
571 global highlight_related
572 set m
[tk_optionMenu .ctop.top.lbar.relm highlight_related None \
573 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
574 $m conf
-font $uifont
575 .ctop.top.lbar.relm conf
-font $uifont
576 trace add variable highlight_related
write vrel_change
577 pack .ctop.top.lbar.relm
-side left
-fill y
579 panedwindow .ctop.cdet
-orient horizontal
581 frame .ctop.cdet.left
582 frame .ctop.cdet.left.bot
583 pack .ctop.cdet.left.bot
-side bottom
-fill x
584 button .ctop.cdet.left.bot.search
-text "Search" -command dosearch \
586 pack .ctop.cdet.left.bot.search
-side left
-padx 5
587 set sstring .ctop.cdet.left.bot.sstring
588 entry
$sstring -width 20 -font $textfont -textvariable searchstring
589 lappend entries
$sstring
590 trace add variable searchstring
write incrsearch
591 pack
$sstring -side left
-expand 1 -fill x
592 set ctext .ctop.cdet.left.ctext
593 text
$ctext -background $bgcolor -foreground $fgcolor \
594 -state disabled
-font $textfont \
595 -width $geometry(ctextw
) -height $geometry(ctexth
) \
596 -yscrollcommand scrolltext
-wrap none
597 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
598 pack .ctop.cdet.left.sb
-side right
-fill y
599 pack
$ctext -side left
-fill both
-expand 1
600 .ctop.cdet add .ctop.cdet.left
601 lappend bglist
$ctext
602 lappend fglist
$ctext
604 $ctext tag conf comment
-wrap $wrapcomment
605 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
606 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
607 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
608 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
609 $ctext tag conf m0
-fore red
610 $ctext tag conf m1
-fore blue
611 $ctext tag conf m2
-fore green
612 $ctext tag conf m3
-fore purple
613 $ctext tag conf
m4 -fore brown
614 $ctext tag conf m5
-fore "#009090"
615 $ctext tag conf m6
-fore magenta
616 $ctext tag conf m7
-fore "#808000"
617 $ctext tag conf m8
-fore "#009000"
618 $ctext tag conf m9
-fore "#ff0080"
619 $ctext tag conf m10
-fore cyan
620 $ctext tag conf m11
-fore "#b07070"
621 $ctext tag conf m12
-fore "#70b0f0"
622 $ctext tag conf m13
-fore "#70f0b0"
623 $ctext tag conf m14
-fore "#f0b070"
624 $ctext tag conf m15
-fore "#ff70b0"
625 $ctext tag conf mmax
-fore darkgrey
627 $ctext tag conf mresult
-font [concat
$textfont bold
]
628 $ctext tag conf msep
-font [concat
$textfont bold
]
629 $ctext tag conf found
-back yellow
631 frame .ctop.cdet.right
632 frame .ctop.cdet.right.mode
633 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
634 -command reselectline
-variable cmitmode
-value "patch"
635 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
636 -command reselectline
-variable cmitmode
-value "tree"
637 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
638 pack .ctop.cdet.right.mode
-side top
-fill x
639 set cflist .ctop.cdet.right.cfiles
640 set indent
[font measure
$mainfont "nn"]
641 text
$cflist -width $geometry(cflistw
) \
642 -background $bgcolor -foreground $fgcolor \
644 -tabs [list
$indent [expr {2 * $indent}]] \
645 -yscrollcommand ".ctop.cdet.right.sb set" \
646 -cursor [. cget
-cursor] \
647 -spacing1 1 -spacing3 1
648 lappend bglist
$cflist
649 lappend fglist
$cflist
650 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
651 pack .ctop.cdet.right.sb
-side right
-fill y
652 pack
$cflist -side left
-fill both
-expand 1
653 $cflist tag configure highlight \
654 -background [$cflist cget
-selectbackground]
655 $cflist tag configure bold
-font [concat
$mainfont bold
]
656 .ctop.cdet add .ctop.cdet.right
657 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
659 pack .ctop
-side top
-fill both
-expand 1
661 bindall
<1> {selcanvline
%W
%x
%y
}
662 #bindall <B1-Motion> {selcanvline %W %x %y}
663 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
664 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
665 bindall
<2> "canvscan mark %W %x %y"
666 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
667 bindkey
<Home
> selfirstline
668 bindkey
<End
> sellastline
669 bind .
<Key-Up
> "selnextline -1"
670 bind .
<Key-Down
> "selnextline 1"
671 bind .
<Shift-Key-Up
> "next_highlight -1"
672 bind .
<Shift-Key-Down
> "next_highlight 1"
673 bindkey
<Key-Right
> "goforw"
674 bindkey
<Key-Left
> "goback"
675 bind .
<Key-Prior
> "selnextpage -1"
676 bind .
<Key-Next
> "selnextpage 1"
677 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
678 bind .
<Control-End
> "allcanvs yview moveto 1.0"
679 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
680 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
681 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
682 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
683 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
684 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
685 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
686 bindkey p
"selnextline -1"
687 bindkey n
"selnextline 1"
690 bindkey i
"selnextline -1"
691 bindkey k
"selnextline 1"
694 bindkey b
"$ctext yview scroll -1 pages"
695 bindkey d
"$ctext yview scroll 18 units"
696 bindkey u
"$ctext yview scroll -18 units"
697 bindkey
/ {findnext
1}
698 bindkey
<Key-Return
> {findnext
0}
701 bind .
<Control-q
> doquit
702 bind .
<Control-f
> dofind
703 bind .
<Control-g
> {findnext
0}
704 bind .
<Control-r
> dosearchback
705 bind .
<Control-s
> dosearch
706 bind .
<Control-equal
> {incrfont
1}
707 bind .
<Control-KP_Add
> {incrfont
1}
708 bind .
<Control-minus
> {incrfont
-1}
709 bind .
<Control-KP_Subtract
> {incrfont
-1}
710 bind .
<Destroy
> {savestuff
%W
}
711 bind .
<Button-1
> "click %W"
712 bind $fstring <Key-Return
> dofind
713 bind $sha1entry <Key-Return
> gotocommit
714 bind $sha1entry <<PasteSelection>> clearsha1
715 bind $cflist <1> {sel_flist %W %x %y; break}
716 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
717 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
719 set maincursor [. cget -cursor]
720 set textcursor [$ctext cget -cursor]
721 set curtextcursor $textcursor
723 set rowctxmenu .rowctxmenu
724 menu $rowctxmenu -tearoff 0
725 $rowctxmenu add command -label "Diff this -> selected" \
726 -command {diffvssel 0}
727 $rowctxmenu add command -label "Diff selected -> this" \
728 -command {diffvssel 1}
729 $rowctxmenu add command -label "Make patch" -command mkpatch
730 $rowctxmenu add command -label "Create tag" -command mktag
731 $rowctxmenu add command -label "Write commit to file" -command writecommit
732 $rowctxmenu add command -label "Create new branch" -command mkbranch
733 $rowctxmenu add command -label "Cherry-pick this commit" \
736 set headctxmenu .headctxmenu
737 menu $headctxmenu -tearoff 0
738 $headctxmenu add command -label "Check out this branch" \
740 $headctxmenu add command -label "Remove this branch" \
744 # mouse-2 makes all windows scan vertically, but only the one
745 # the cursor is in scans horizontally
746 proc canvscan {op w x y} {
747 global canv canv2 canv3
748 foreach c [list $canv $canv2 $canv3] {
757 proc scrollcanv {cscroll f0 f1} {
763 # when we make a key binding for the toplevel, make sure
764 # it doesn't get triggered when that key is pressed in the
765 # find string entry widget.
766 proc bindkey {ev script} {
769 set escript [bind Entry $ev]
770 if {$escript == {}} {
771 set escript [bind Entry <Key>]
774 bind $e $ev "$escript; break"
778 # set the focus back to the toplevel for any click outside
789 global canv canv2 canv3 ctext cflist mainfont textfont uifont
790 global stuffsaved findmergefiles maxgraphpct
791 global maxwidth showneartags
792 global viewname viewfiles viewargs viewperm nextviewnum
793 global cmitmode wrapcomment
794 global colors bgcolor fgcolor diffcolors
796 if {$stuffsaved} return
797 if {![winfo viewable .]} return
799 set f [open "~/.gitk-new" w]
800 puts $f [list set mainfont $mainfont]
801 puts $f [list set textfont $textfont]
802 puts $f [list set uifont $uifont]
803 puts $f [list set findmergefiles $findmergefiles]
804 puts $f [list set maxgraphpct $maxgraphpct]
805 puts $f [list set maxwidth $maxwidth]
806 puts $f [list set cmitmode $cmitmode]
807 puts $f [list set wrapcomment $wrapcomment]
808 puts $f [list set showneartags $showneartags]
809 puts $f [list set bgcolor $bgcolor]
810 puts $f [list set fgcolor $fgcolor]
811 puts $f [list set colors $colors]
812 puts $f [list set diffcolors $diffcolors]
813 puts $f "set geometry(width) [winfo width .ctop]"
814 puts $f "set geometry(height) [winfo height .ctop]"
815 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
816 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
817 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
818 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
819 set wid [expr {([winfo width $ctext] - 8) \
820 / [font measure $textfont "0"]}]
821 puts $f "set geometry(ctextw) $wid"
822 set wid [expr {([winfo width $cflist] - 11) \
823 / [font measure [$cflist cget -font] "0"]}]
824 puts $f "set geometry(cflistw) $wid"
825 puts -nonewline $f "set permviews {"
826 for {set v 0} {$v < $nextviewnum} {incr v} {
828 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
833 file rename -force "~/.gitk-new" "~/.gitk"
838 proc resizeclistpanes {win w} {
840 if {[info exists oldwidth($win)]} {
841 set s0 [$win sash coord 0]
842 set s1 [$win sash coord 1]
844 set sash0 [expr {int($w/2 - 2)}]
845 set sash1 [expr {int($w*5/6 - 2)}]
847 set factor [expr {1.0 * $w / $oldwidth($win)}]
848 set sash0 [expr {int($factor * [lindex $s0 0])}]
849 set sash1 [expr {int($factor * [lindex $s1 0])}]
853 if {$sash1 < $sash0 + 20} {
854 set sash1 [expr {$sash0 + 20}]
856 if {$sash1 > $w - 10} {
857 set sash1 [expr {$w - 10}]
858 if {$sash0 > $sash1 - 20} {
859 set sash0 [expr {$sash1 - 20}]
863 $win sash place 0 $sash0 [lindex $s0 1]
864 $win sash place 1 $sash1 [lindex $s1 1]
866 set oldwidth($win) $w
869 proc resizecdetpanes {win w} {
871 if {[info exists oldwidth($win)]} {
872 set s0 [$win sash coord 0]
874 set sash0 [expr {int($w*3/4 - 2)}]
876 set factor [expr {1.0 * $w / $oldwidth($win)}]
877 set sash0 [expr {int($factor * [lindex $s0 0])}]
881 if {$sash0 > $w - 15} {
882 set sash0 [expr {$w - 15}]
885 $win sash place 0 $sash0 [lindex $s0 1]
887 set oldwidth($win) $w
891 global canv canv2 canv3
897 proc bindall {event action} {
898 global canv canv2 canv3
899 bind $canv $event $action
900 bind $canv2 $event $action
901 bind $canv3 $event $action
906 if {[winfo exists $w]} {
911 wm title $w "About gitk"
913 Gitk - a commit viewer for git
915 Copyright © 2005-2006 Paul Mackerras
917 Use and redistribute under the terms of the GNU General Public License} \
918 -justify center -aspect 400
919 pack $w.m -side top -fill x -padx 20 -pady 20
920 button $w.ok -text Close -command "destroy $w"
921 pack $w.ok -side bottom
926 if {[winfo exists $w]} {
931 wm title $w "Gitk key bindings"
936 <Home> Move to first commit
937 <End> Move to last commit
938 <Up>, p, i Move up one commit
939 <Down>, n, k Move down one commit
940 <Left>, z, j Go back in history list
941 <Right>, x, l Go forward in history list
942 <PageUp> Move up one page in commit list
943 <PageDown> Move down one page in commit list
944 <Ctrl-Home> Scroll to top of commit list
945 <Ctrl-End> Scroll to bottom of commit list
946 <Ctrl-Up> Scroll commit list up one line
947 <Ctrl-Down> Scroll commit list down one line
948 <Ctrl-PageUp> Scroll commit list up one page
949 <Ctrl-PageDown> Scroll commit list down one page
950 <Shift-Up> Move to previous highlighted line
951 <Shift-Down> Move to next highlighted line
952 <Delete>, b Scroll diff view up one page
953 <Backspace> Scroll diff view up one page
954 <Space> Scroll diff view down one page
955 u Scroll diff view up 18 lines
956 d Scroll diff view down 18 lines
958 <Ctrl-G> Move to next find hit
959 <Return> Move to next find hit
960 / Move to next find hit, or redo find
961 ? Move to previous find hit
962 f Scroll diff view to next file
963 <Ctrl-S> Search for next hit in diff view
964 <Ctrl-R> Search for previous hit in diff view
965 <Ctrl-KP+> Increase font size
966 <Ctrl-plus> Increase font size
967 <Ctrl-KP-> Decrease font size
968 <Ctrl-minus> Decrease font size
970 -justify left -bg white -border 2 -relief sunken
971 pack $w.m -side top -fill both
972 button $w.ok -text Close -command "destroy $w"
973 pack $w.ok -side bottom
976 # Procedures for manipulating the file list window at the
977 # bottom right of the overall window.
979 proc treeview {w l openlevs} {
980 global treecontents treediropen treeheight treeparent treeindex
990 set treecontents() {}
991 $w conf -state normal
993 while {[string range $f 0 $prefixend] ne $prefix} {
994 if {$lev <= $openlevs} {
995 $w mark set e:$treeindex($prefix) "end -1c"
996 $w mark gravity e:$treeindex($prefix) left
998 set treeheight($prefix) $ht
999 incr ht [lindex $htstack end]
1000 set htstack [lreplace $htstack end end]
1001 set prefixend [lindex $prefendstack end]
1002 set prefendstack [lreplace $prefendstack end end]
1003 set prefix [string range $prefix 0 $prefixend]
1006 set tail [string range $f [expr {$prefixend+1}] end]
1007 while {[set slash [string first "/" $tail]] >= 0} {
1010 lappend prefendstack $prefixend
1011 incr prefixend [expr {$slash + 1}]
1012 set d [string range $tail 0 $slash]
1013 lappend treecontents($prefix) $d
1014 set oldprefix $prefix
1016 set treecontents($prefix) {}
1017 set treeindex($prefix) [incr ix]
1018 set treeparent($prefix) $oldprefix
1019 set tail [string range $tail [expr {$slash+1}] end]
1020 if {$lev <= $openlevs} {
1022 set treediropen($prefix) [expr {$lev < $openlevs}]
1023 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1024 $w mark set d:$ix "end -1c"
1025 $w mark gravity d:$ix left
1027 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1029 $w image create end -align center -image $bm -padx 1 \
1031 $w insert end $d [highlight_tag $prefix]
1032 $w mark set s:$ix "end -1c"
1033 $w mark gravity s:$ix left
1038 if {$lev <= $openlevs} {
1041 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1043 $w insert end $tail [highlight_tag $f]
1045 lappend treecontents($prefix) $tail
1048 while {$htstack ne {}} {
1049 set treeheight($prefix) $ht
1050 incr ht [lindex $htstack end]
1051 set htstack [lreplace $htstack end end]
1053 $w conf -state disabled
1056 proc linetoelt {l} {
1057 global treeheight treecontents
1062 foreach e $treecontents($prefix) {
1067 if {[string index $e end] eq "/"} {
1068 set n $treeheight($prefix$e)
1080 proc highlight_tree {y prefix} {
1081 global treeheight treecontents cflist
1083 foreach e $treecontents($prefix) {
1085 if {[highlight_tag $path] ne {}} {
1086 $cflist tag add bold $y.0 "$y.0 lineend"
1089 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1090 set y [highlight_tree $y $path]
1096 proc treeclosedir {w dir} {
1097 global treediropen treeheight treeparent treeindex
1099 set ix $treeindex($dir)
1100 $w conf -state normal
1101 $w delete s:$ix e:$ix
1102 set treediropen($dir) 0
1103 $w image configure a:$ix -image tri-rt
1104 $w conf -state disabled
1105 set n [expr {1 - $treeheight($dir)}]
1106 while {$dir ne {}} {
1107 incr treeheight($dir) $n
1108 set dir $treeparent($dir)
1112 proc treeopendir {w dir} {
1113 global treediropen treeheight treeparent treecontents treeindex
1115 set ix $treeindex($dir)
1116 $w conf -state normal
1117 $w image configure a:$ix -image tri-dn
1118 $w mark set e:$ix s:$ix
1119 $w mark gravity e:$ix right
1122 set n [llength $treecontents($dir)]
1123 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1126 incr treeheight($x) $n
1128 foreach e $treecontents($dir) {
1130 if {[string index $e end] eq "/"} {
1131 set iy $treeindex($de)
1132 $w mark set d:$iy e:$ix
1133 $w mark gravity d:$iy left
1134 $w insert e:$ix $str
1135 set treediropen($de) 0
1136 $w image create e:$ix -align center -image tri-rt -padx 1 \
1138 $w insert e:$ix $e [highlight_tag $de]
1139 $w mark set s:$iy e:$ix
1140 $w mark gravity s:$iy left
1141 set treeheight($de) 1
1143 $w insert e:$ix $str
1144 $w insert e:$ix $e [highlight_tag $de]
1147 $w mark gravity e:$ix left
1148 $w conf -state disabled
1149 set treediropen($dir) 1
1150 set top [lindex [split [$w index @0,0] .] 0]
1151 set ht [$w cget -height]
1152 set l [lindex [split [$w index s:$ix] .] 0]
1155 } elseif {$l + $n + 1 > $top + $ht} {
1156 set top [expr {$l + $n + 2 - $ht}]
1164 proc treeclick {w x y} {
1165 global treediropen cmitmode ctext cflist cflist_top
1167 if {$cmitmode ne "tree"} return
1168 if {![info exists cflist_top]} return
1169 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1170 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1171 $cflist tag add highlight $l.0 "$l.0 lineend"
1177 set e [linetoelt $l]
1178 if {[string index $e end] ne "/"} {
1180 } elseif {$treediropen($e)} {
1187 proc setfilelist {id} {
1188 global treefilelist cflist
1190 treeview $cflist $treefilelist($id) 0
1193 image create bitmap tri-rt -background black -foreground blue -data {
1194 #define tri-rt_width 13
1195 #define tri-rt_height 13
1196 static unsigned char tri-rt_bits[] = {
1197 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1198 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1201 #define tri-rt-mask_width 13
1202 #define tri-rt-mask_height 13
1203 static unsigned char tri-rt-mask_bits[] = {
1204 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1205 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1208 image create bitmap tri-dn -background black -foreground blue -data {
1209 #define tri-dn_width 13
1210 #define tri-dn_height 13
1211 static unsigned char tri-dn_bits[] = {
1212 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1213 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1216 #define tri-dn-mask_width 13
1217 #define tri-dn-mask_height 13
1218 static unsigned char tri-dn-mask_bits[] = {
1219 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1220 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1224 proc init_flist {first} {
1225 global cflist cflist_top selectedline difffilestart
1227 $cflist conf -state normal
1228 $cflist delete 0.0 end
1230 $cflist insert end $first
1232 $cflist tag add highlight 1.0 "1.0 lineend"
1234 catch {unset cflist_top}
1236 $cflist conf -state disabled
1237 set difffilestart {}
1240 proc highlight_tag {f} {
1241 global highlight_paths
1243 foreach p $highlight_paths {
1244 if {[string match $p $f]} {
1251 proc highlight_filelist {} {
1252 global cmitmode cflist
1254 $cflist conf -state normal
1255 if {$cmitmode ne "tree"} {
1256 set end [lindex [split [$cflist index end] .] 0]
1257 for {set l 2} {$l < $end} {incr l} {
1258 set line [$cflist get $l.0 "$l.0 lineend"]
1259 if {[highlight_tag $line] ne {}} {
1260 $cflist tag add bold $l.0 "$l.0 lineend"
1266 $cflist conf -state disabled
1269 proc unhighlight_filelist {} {
1272 $cflist conf -state normal
1273 $cflist tag remove bold 1.0 end
1274 $cflist conf -state disabled
1277 proc add_flist {fl} {
1280 $cflist conf -state normal
1282 $cflist insert end "\n"
1283 $cflist insert end $f [highlight_tag $f]
1285 $cflist conf -state disabled
1288 proc sel_flist {w x y} {
1289 global ctext difffilestart cflist cflist_top cmitmode
1291 if {$cmitmode eq "tree"} return
1292 if {![info exists cflist_top]} return
1293 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1294 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1295 $cflist tag add highlight $l.0 "$l.0 lineend"
1300 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1304 # Functions for adding and removing shell-type quoting
1306 proc shellquote {str} {
1307 if {![string match "*\['\"\\ \t]*" $str]} {
1310 if {![string match "*\['\"\\]*" $str]} {
1313 if {![string match "*'*" $str]} {
1316 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1319 proc shellarglist {l} {
1325 append str [shellquote $a]
1330 proc shelldequote {str} {
1335 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1336 append ret [string range $str $used end]
1337 set used [string length $str]
1340 set first [lindex $first 0]
1341 set ch [string index $str $first]
1342 if {$first > $used} {
1343 append ret [string range $str $used [expr {$first - 1}]]
1346 if {$ch eq " " || $ch eq "\t"} break
1349 set first [string first "'" $str $used]
1351 error "unmatched single-quote"
1353 append ret [string range $str $used [expr {$first - 1}]]
1358 if {$used >= [string length $str]} {
1359 error "trailing backslash"
1361 append ret [string index $str $used]
1366 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1367 error "unmatched double-quote"
1369 set first [lindex $first 0]
1370 set ch [string index $str $first]
1371 if {$first > $used} {
1372 append ret [string range $str $used [expr {$first - 1}]]
1375 if {$ch eq "\""} break
1377 append ret [string index $str $used]
1381 return [list $used $ret]
1384 proc shellsplit {str} {
1387 set str [string trimleft $str]
1388 if {$str eq {}} break
1389 set dq [shelldequote $str]
1390 set n [lindex $dq 0]
1391 set word [lindex $dq 1]
1392 set str [string range $str $n end]
1398 # Code to implement multiple views
1400 proc newview {ishighlight} {
1401 global nextviewnum newviewname newviewperm uifont newishighlight
1402 global newviewargs revtreeargs
1404 set newishighlight $ishighlight
1406 if {[winfo exists $top]} {
1410 set newviewname($nextviewnum) "View $nextviewnum"
1411 set newviewperm($nextviewnum) 0
1412 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1413 vieweditor $top $nextviewnum "Gitk view definition"
1418 global viewname viewperm newviewname newviewperm
1419 global viewargs newviewargs
1421 set top .gitkvedit-$curview
1422 if {[winfo exists $top]} {
1426 set newviewname($curview) $viewname($curview)
1427 set newviewperm($curview) $viewperm($curview)
1428 set newviewargs($curview) [shellarglist $viewargs($curview)]
1429 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1432 proc vieweditor {top n title} {
1433 global newviewname newviewperm viewfiles
1437 wm title $top $title
1438 label $top.nl -text "Name" -font $uifont
1439 entry $top.name -width 20 -textvariable newviewname($n)
1440 grid $top.nl $top.name -sticky w -pady 5
1441 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1442 grid $top.perm - -pady 5 -sticky w
1443 message $top.al -aspect 1000 -font $uifont \
1444 -text "Commits to include (arguments to git rev-list):"
1445 grid $top.al - -sticky w -pady 5
1446 entry $top.args -width 50 -textvariable newviewargs($n) \
1448 grid $top.args - -sticky ew -padx 5
1449 message $top.l -aspect 1000 -font $uifont \
1450 -text "Enter files and directories to include, one per line:"
1451 grid $top.l - -sticky w
1452 text $top.t -width 40 -height 10 -background white
1453 if {[info exists viewfiles($n)]} {
1454 foreach f $viewfiles($n) {
1455 $top.t insert end $f
1456 $top.t insert end "\n"
1458 $top.t delete {end - 1c} end
1459 $top.t mark set insert 0.0
1461 grid $top.t - -sticky ew -padx 5
1463 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1464 button $top.buts.can -text "Cancel" -command [list destroy $top]
1465 grid $top.buts.ok $top.buts.can
1466 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1467 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1468 grid $top.buts - -pady 10 -sticky ew
1472 proc doviewmenu {m first cmd op argv} {
1473 set nmenu [$m index end]
1474 for {set i $first} {$i <= $nmenu} {incr i} {
1475 if {[$m entrycget $i -command] eq $cmd} {
1476 eval $m $op $i $argv
1482 proc allviewmenus {n op args} {
1485 doviewmenu .bar.view 7 [list showview $n] $op $args
1486 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1489 proc newviewok {top n} {
1490 global nextviewnum newviewperm newviewname newishighlight
1491 global viewname viewfiles viewperm selectedview curview
1492 global viewargs newviewargs viewhlmenu
1495 set newargs [shellsplit $newviewargs($n)]
1497 error_popup "Error in commit selection arguments: $err"
1503 foreach f [split [$top.t get 0.0 end] "\n"] {
1504 set ft [string trim $f]
1509 if {![info exists viewfiles($n)]} {
1510 # creating a new view
1512 set viewname($n) $newviewname($n)
1513 set viewperm($n) $newviewperm($n)
1514 set viewfiles($n) $files
1515 set viewargs($n) $newargs
1517 if {!$newishighlight} {
1518 after idle showview $n
1520 after idle addvhighlight $n
1523 # editing an existing view
1524 set viewperm($n) $newviewperm($n)
1525 if {$newviewname($n) ne $viewname($n)} {
1526 set viewname($n) $newviewname($n)
1527 doviewmenu .bar.view 7 [list showview $n] \
1528 entryconf [list -label $viewname($n)]
1529 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1530 entryconf [list -label $viewname($n) -value $viewname($n)]
1532 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1533 set viewfiles($n) $files
1534 set viewargs($n) $newargs
1535 if {$curview == $n} {
1536 after idle updatecommits
1540 catch {destroy $top}
1544 global curview viewdata viewperm hlview selectedhlview
1546 if {$curview == 0} return
1547 if {[info exists hlview] && $hlview == $curview} {
1548 set selectedhlview None
1551 allviewmenus $curview delete
1552 set viewdata($curview) {}
1553 set viewperm($curview) 0
1557 proc addviewmenu {n} {
1558 global viewname viewhlmenu
1560 .bar.view add radiobutton -label $viewname($n) \
1561 -command [list showview $n] -variable selectedview -value $n
1562 $viewhlmenu add radiobutton -label $viewname($n) \
1563 -command [list addvhighlight $n] -variable selectedhlview
1566 proc flatten {var} {
1570 foreach i [array names $var] {
1571 lappend ret $i [set $var\($i\)]
1576 proc unflatten {var l} {
1586 global curview viewdata viewfiles
1587 global displayorder parentlist childlist rowidlist rowoffsets
1588 global colormap rowtextx commitrow nextcolor canvxmax
1589 global numcommits rowrangelist commitlisted idrowranges
1590 global selectedline currentid canv canvy0
1591 global matchinglines treediffs
1592 global pending_select phase
1593 global commitidx rowlaidout rowoptim linesegends
1594 global commfd nextupdate
1596 global vparentlist vchildlist vdisporder vcmitlisted
1597 global hlview selectedhlview
1599 if {$n == $curview} return
1601 if {[info exists selectedline]} {
1602 set selid $currentid
1603 set y [yc $selectedline]
1604 set ymax [lindex [$canv cget -scrollregion] 3]
1605 set span [$canv yview]
1606 set ytop [expr {[lindex $span 0] * $ymax}]
1607 set ybot [expr {[lindex $span 1] * $ymax}]
1608 if {$ytop < $y && $y < $ybot} {
1609 set yscreen [expr {$y - $ytop}]
1611 set yscreen [expr {($ybot - $ytop) / 2}]
1617 if {$curview >= 0} {
1618 set vparentlist($curview) $parentlist
1619 set vchildlist($curview) $childlist
1620 set vdisporder($curview) $displayorder
1621 set vcmitlisted($curview) $commitlisted
1623 set viewdata($curview) \
1624 [list $phase $rowidlist $rowoffsets $rowrangelist \
1625 [flatten idrowranges] [flatten idinlist] \
1626 $rowlaidout $rowoptim $numcommits $linesegends]
1627 } elseif {![info exists viewdata($curview)]
1628 || [lindex $viewdata($curview) 0] ne {}} {
1629 set viewdata($curview) \
1630 [list {} $rowidlist $rowoffsets $rowrangelist]
1633 catch {unset matchinglines}
1634 catch {unset treediffs}
1636 if {[info exists hlview] && $hlview == $n} {
1638 set selectedhlview None
1643 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1644 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1646 if {![info exists viewdata($n)]} {
1647 set pending_select $selid
1653 set phase [lindex $v 0]
1654 set displayorder $vdisporder($n)
1655 set parentlist $vparentlist($n)
1656 set childlist $vchildlist($n)
1657 set commitlisted $vcmitlisted($n)
1658 set rowidlist [lindex $v 1]
1659 set rowoffsets [lindex $v 2]
1660 set rowrangelist [lindex $v 3]
1662 set numcommits [llength $displayorder]
1663 catch {unset idrowranges}
1665 unflatten idrowranges [lindex $v 4]
1666 unflatten idinlist [lindex $v 5]
1667 set rowlaidout [lindex $v 6]
1668 set rowoptim [lindex $v 7]
1669 set numcommits [lindex $v 8]
1670 set linesegends [lindex $v 9]
1673 catch {unset colormap}
1674 catch {unset rowtextx}
1676 set canvxmax [$canv cget -width]
1682 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1683 set row $commitrow($n,$selid)
1684 # try to get the selected row in the same position on the screen
1685 set ymax [lindex [$canv cget -scrollregion] 3]
1686 set ytop [expr {[yc $row] - $yscreen}]
1690 set yf [expr {$ytop * 1.0 / $ymax}]
1692 allcanvs yview moveto $yf
1696 if {$phase eq "getcommits"} {
1697 show_status "Reading commits..."
1699 if {[info exists commfd($n)]} {
1704 } elseif {$numcommits == 0} {
1705 show_status "No commits selected"
1709 # Stuff relating to the highlighting facility
1711 proc ishighlighted {row} {
1712 global vhighlights fhighlights nhighlights rhighlights
1714 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1715 return $nhighlights($row)
1717 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1718 return $vhighlights($row)
1720 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1721 return $fhighlights($row)
1723 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1724 return $rhighlights($row)
1729 proc bolden {row font} {
1730 global canv linehtag selectedline boldrows
1732 lappend boldrows $row
1733 $canv itemconf $linehtag($row) -font $font
1734 if {[info exists selectedline] && $row == $selectedline} {
1736 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1737 -outline {{}} -tags secsel \
1738 -fill [$canv cget -selectbackground]]
1743 proc bolden_name {row font} {
1744 global canv2 linentag selectedline boldnamerows
1746 lappend boldnamerows $row
1747 $canv2 itemconf $linentag($row) -font $font
1748 if {[info exists selectedline] && $row == $selectedline} {
1749 $canv2 delete secsel
1750 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1751 -outline {{}} -tags secsel \
1752 -fill [$canv2 cget -selectbackground]]
1758 global mainfont boldrows
1761 foreach row $boldrows {
1762 if {![ishighlighted $row]} {
1763 bolden $row $mainfont
1765 lappend stillbold $row
1768 set boldrows $stillbold
1771 proc addvhighlight {n} {
1772 global hlview curview viewdata vhl_done vhighlights commitidx
1774 if {[info exists hlview]} {
1778 if {$n != $curview && ![info exists viewdata($n)]} {
1779 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1780 set vparentlist($n) {}
1781 set vchildlist($n) {}
1782 set vdisporder($n) {}
1783 set vcmitlisted($n) {}
1786 set vhl_done $commitidx($hlview)
1787 if {$vhl_done > 0} {
1792 proc delvhighlight {} {
1793 global hlview vhighlights
1795 if {![info exists hlview]} return
1797 catch {unset vhighlights}
1801 proc vhighlightmore {} {
1802 global hlview vhl_done commitidx vhighlights
1803 global displayorder vdisporder curview mainfont
1805 set font [concat $mainfont bold]
1806 set max $commitidx($hlview)
1807 if {$hlview == $curview} {
1808 set disp $displayorder
1810 set disp $vdisporder($hlview)
1812 set vr [visiblerows]
1813 set r0 [lindex $vr 0]
1814 set r1 [lindex $vr 1]
1815 for {set i $vhl_done} {$i < $max} {incr i} {
1816 set id [lindex $disp $i]
1817 if {[info exists commitrow($curview,$id)]} {
1818 set row $commitrow($curview,$id)
1819 if {$r0 <= $row && $row <= $r1} {
1820 if {![highlighted $row]} {
1823 set vhighlights($row) 1
1830 proc askvhighlight {row id} {
1831 global hlview vhighlights commitrow iddrawn mainfont
1833 if {[info exists commitrow($hlview,$id)]} {
1834 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1835 bolden $row [concat $mainfont bold]
1837 set vhighlights($row) 1
1839 set vhighlights($row) 0
1843 proc hfiles_change {name ix op} {
1844 global highlight_files filehighlight fhighlights fh_serial
1845 global mainfont highlight_paths
1847 if {[info exists filehighlight]} {
1848 # delete previous highlights
1849 catch {close $filehighlight}
1851 catch {unset fhighlights}
1853 unhighlight_filelist
1855 set highlight_paths {}
1856 after cancel do_file_hl $fh_serial
1858 if {$highlight_files ne {}} {
1859 after 300 do_file_hl $fh_serial
1863 proc makepatterns {l} {
1866 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1867 if {[string index $ee end] eq "/"} {
1877 proc do_file_hl {serial} {
1878 global highlight_files filehighlight highlight_paths gdttype fhl_list
1880 if {$gdttype eq "touching paths:"} {
1881 if {[catch {set paths [shellsplit $highlight_files]}]} return
1882 set highlight_paths [makepatterns $paths]
1884 set gdtargs [concat -- $paths]
1886 set gdtargs [list "-S$highlight_files"]
1888 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1889 set filehighlight [open $cmd r+]
1890 fconfigure $filehighlight -blocking 0
1891 fileevent $filehighlight readable readfhighlight
1897 proc flushhighlights {} {
1898 global filehighlight fhl_list
1900 if {[info exists filehighlight]} {
1902 puts $filehighlight ""
1903 flush $filehighlight
1907 proc askfilehighlight {row id} {
1908 global filehighlight fhighlights fhl_list
1910 lappend fhl_list $id
1911 set fhighlights($row) -1
1912 puts $filehighlight $id
1915 proc readfhighlight {} {
1916 global filehighlight fhighlights commitrow curview mainfont iddrawn
1919 while {[gets $filehighlight line] >= 0} {
1920 set line [string trim $line]
1921 set i [lsearch -exact $fhl_list $line]
1922 if {$i < 0} continue
1923 for {set j 0} {$j < $i} {incr j} {
1924 set id [lindex $fhl_list $j]
1925 if {[info exists commitrow($curview,$id)]} {
1926 set fhighlights($commitrow($curview,$id)) 0
1929 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1930 if {$line eq {}} continue
1931 if {![info exists commitrow($curview,$line)]} continue
1932 set row $commitrow($curview,$line)
1933 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1934 bolden $row [concat $mainfont bold]
1936 set fhighlights($row) 1
1938 if {[eof $filehighlight]} {
1940 puts "oops, git-diff-tree died"
1941 catch {close $filehighlight}
1947 proc find_change {name ix op} {
1948 global nhighlights mainfont boldnamerows
1949 global findstring findpattern findtype
1951 # delete previous highlights, if any
1952 foreach row $boldnamerows {
1953 bolden_name $row $mainfont
1956 catch {unset nhighlights}
1958 if {$findtype ne "Regexp"} {
1959 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1961 set findpattern "*$e*"
1966 proc askfindhighlight {row id} {
1967 global nhighlights commitinfo iddrawn mainfont
1968 global findstring findtype findloc findpattern
1970 if {![info exists commitinfo($id)]} {
1973 set info $commitinfo($id)
1975 set fldtypes {Headline Author Date Committer CDate Comments}
1976 foreach f $info ty $fldtypes {
1977 if {$findloc ne "All fields" && $findloc ne $ty} {
1980 if {$findtype eq "Regexp"} {
1981 set doesmatch [regexp $findstring $f]
1982 } elseif {$findtype eq "IgnCase"} {
1983 set doesmatch [string match -nocase $findpattern $f]
1985 set doesmatch [string match $findpattern $f]
1988 if {$ty eq "Author"} {
1995 if {[info exists iddrawn($id)]} {
1996 if {$isbold && ![ishighlighted $row]} {
1997 bolden $row [concat $mainfont bold]
2000 bolden_name $row [concat $mainfont bold]
2003 set nhighlights($row) $isbold
2006 proc vrel_change {name ix op} {
2007 global highlight_related
2010 if {$highlight_related ne "None"} {
2011 after idle drawvisible
2015 # prepare for testing whether commits are descendents or ancestors of a
2016 proc rhighlight_sel {a} {
2017 global descendent desc_todo ancestor anc_todo
2018 global highlight_related rhighlights
2020 catch {unset descendent}
2021 set desc_todo [list $a]
2022 catch {unset ancestor}
2023 set anc_todo [list $a]
2024 if {$highlight_related ne "None"} {
2026 after idle drawvisible
2030 proc rhighlight_none {} {
2033 catch {unset rhighlights}
2037 proc is_descendent {a} {
2038 global curview children commitrow descendent desc_todo
2041 set la $commitrow($v,$a)
2045 for {set i 0} {$i < [llength $todo]} {incr i} {
2046 set do [lindex $todo $i]
2047 if {$commitrow($v,$do) < $la} {
2048 lappend leftover $do
2051 foreach nk $children($v,$do) {
2052 if {![info exists descendent($nk)]} {
2053 set descendent($nk) 1
2061 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2065 set descendent($a) 0
2066 set desc_todo $leftover
2069 proc is_ancestor {a} {
2070 global curview parentlist commitrow ancestor anc_todo
2073 set la $commitrow($v,$a)
2077 for {set i 0} {$i < [llength $todo]} {incr i} {
2078 set do [lindex $todo $i]
2079 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2080 lappend leftover $do
2083 foreach np [lindex $parentlist $commitrow($v,$do)] {
2084 if {![info exists ancestor($np)]} {
2093 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2098 set anc_todo $leftover
2101 proc askrelhighlight {row id} {
2102 global descendent highlight_related iddrawn mainfont rhighlights
2103 global selectedline ancestor
2105 if {![info exists selectedline]} return
2107 if {$highlight_related eq "Descendent" ||
2108 $highlight_related eq "Not descendent"} {
2109 if {![info exists descendent($id)]} {
2112 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2115 } elseif {$highlight_related eq "Ancestor" ||
2116 $highlight_related eq "Not ancestor"} {
2117 if {![info exists ancestor($id)]} {
2120 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2124 if {[info exists iddrawn($id)]} {
2125 if {$isbold && ![ishighlighted $row]} {
2126 bolden $row [concat $mainfont bold]
2129 set rhighlights($row) $isbold
2132 proc next_hlcont {} {
2133 global fhl_row fhl_dirn displayorder numcommits
2134 global vhighlights fhighlights nhighlights rhighlights
2135 global hlview filehighlight findstring highlight_related
2137 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2140 if {$row < 0 || $row >= $numcommits} {
2145 set id [lindex $displayorder $row]
2146 if {[info exists hlview]} {
2147 if {![info exists vhighlights($row)]} {
2148 askvhighlight $row $id
2150 if {$vhighlights($row) > 0} break
2152 if {$findstring ne {}} {
2153 if {![info exists nhighlights($row)]} {
2154 askfindhighlight $row $id
2156 if {$nhighlights($row) > 0} break
2158 if {$highlight_related ne "None"} {
2159 if {![info exists rhighlights($row)]} {
2160 askrelhighlight $row $id
2162 if {$rhighlights($row) > 0} break
2164 if {[info exists filehighlight]} {
2165 if {![info exists fhighlights($row)]} {
2166 # ask for a few more while we're at it...
2168 for {set n 0} {$n < 100} {incr n} {
2169 if {![info exists fhighlights($r)]} {
2170 askfilehighlight $r [lindex $displayorder $r]
2173 if {$r < 0 || $r >= $numcommits} break
2177 if {$fhighlights($row) < 0} {
2181 if {$fhighlights($row) > 0} break
2189 proc next_highlight {dirn} {
2190 global selectedline fhl_row fhl_dirn
2191 global hlview filehighlight findstring highlight_related
2193 if {![info exists selectedline]} return
2194 if {!([info exists hlview] || $findstring ne {} ||
2195 $highlight_related ne "None" || [info exists filehighlight])} return
2196 set fhl_row [expr {$selectedline + $dirn}]
2201 proc cancel_next_highlight {} {
2207 # Graph layout functions
2209 proc shortids {ids} {
2212 if {[llength $id] > 1} {
2213 lappend res [shortids $id]
2214 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2215 lappend res [string range $id 0 7]
2223 proc incrange {l x o} {
2226 set e [lindex $l $x]
2228 lset l $x [expr {$e + $o}]
2237 for {} {$n > 0} {incr n -1} {
2243 proc usedinrange {id l1 l2} {
2244 global children commitrow childlist curview
2246 if {[info exists commitrow($curview,$id)]} {
2247 set r $commitrow($curview,$id)
2248 if {$l1 <= $r && $r <= $l2} {
2249 return [expr {$r - $l1 + 1}]
2251 set kids [lindex $childlist $r]
2253 set kids $children($curview,$id)
2256 set r $commitrow($curview,$c)
2257 if {$l1 <= $r && $r <= $l2} {
2258 return [expr {$r - $l1 + 1}]
2264 proc sanity {row {full 0}} {
2265 global rowidlist rowoffsets
2268 set ids [lindex $rowidlist $row]
2271 if {$id eq {}} continue
2272 if {$col < [llength $ids] - 1 &&
2273 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2274 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2276 set o [lindex $rowoffsets $row $col]
2282 if {[lindex $rowidlist $y $x] != $id} {
2283 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2284 puts " id=[shortids $id] check started at row $row"
2285 for {set i $row} {$i >= $y} {incr i -1} {
2286 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2291 set o [lindex $rowoffsets $y $x]
2296 proc makeuparrow {oid x y z} {
2297 global rowidlist rowoffsets uparrowlen idrowranges
2299 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2302 set off0 [lindex $rowoffsets $y]
2303 for {set x0 $x} {1} {incr x0} {
2304 if {$x0 >= [llength $off0]} {
2305 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2308 set z [lindex $off0 $x0]
2314 set z [expr {$x0 - $x}]
2315 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2316 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2318 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2319 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2320 lappend idrowranges($oid) $y
2323 proc initlayout {} {
2324 global rowidlist rowoffsets displayorder commitlisted
2325 global rowlaidout rowoptim
2326 global idinlist rowchk rowrangelist idrowranges
2327 global numcommits canvxmax canv
2329 global parentlist childlist children
2330 global colormap rowtextx
2342 catch {unset idinlist}
2343 catch {unset rowchk}
2346 set canvxmax [$canv cget -width]
2347 catch {unset colormap}
2348 catch {unset rowtextx}
2349 catch {unset idrowranges}
2353 proc setcanvscroll {} {
2354 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2356 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2357 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2358 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2359 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2362 proc visiblerows {} {
2363 global canv numcommits linespc
2365 set ymax [lindex [$canv cget -scrollregion] 3]
2366 if {$ymax eq {} || $ymax == 0} return
2368 set y0 [expr {int([lindex $f 0] * $ymax)}]
2369 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2373 set y1 [expr {int([lindex $f 1] * $ymax)}]
2374 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2375 if {$r1 >= $numcommits} {
2376 set r1 [expr {$numcommits - 1}]
2378 return [list $r0 $r1]
2381 proc layoutmore {} {
2382 global rowlaidout rowoptim commitidx numcommits optim_delay
2383 global uparrowlen curview
2386 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2387 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2388 if {$orow > $rowoptim} {
2389 optimize_rows $rowoptim 0 $orow
2392 set canshow [expr {$rowoptim - $optim_delay}]
2393 if {$canshow > $numcommits} {
2398 proc showstuff {canshow} {
2399 global numcommits commitrow pending_select selectedline
2400 global linesegends idrowranges idrangedrawn curview
2402 if {$numcommits == 0} {
2404 set phase "incrdraw"
2408 set numcommits $canshow
2410 set rows [visiblerows]
2411 set r0 [lindex $rows 0]
2412 set r1 [lindex $rows 1]
2414 for {set r $row} {$r < $canshow} {incr r} {
2415 foreach id [lindex $linesegends [expr {$r+1}]] {
2417 foreach {s e} [rowranges $id] {
2419 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2420 && ![info exists idrangedrawn($id,$i)]} {
2422 set idrangedrawn($id,$i) 1
2427 if {$canshow > $r1} {
2430 while {$row < $canshow} {
2434 if {[info exists pending_select] &&
2435 [info exists commitrow($curview,$pending_select)] &&
2436 $commitrow($curview,$pending_select) < $numcommits} {
2437 selectline $commitrow($curview,$pending_select) 1
2439 if {![info exists selectedline] && ![info exists pending_select]} {
2444 proc layoutrows {row endrow last} {
2445 global rowidlist rowoffsets displayorder
2446 global uparrowlen downarrowlen maxwidth mingaplen
2447 global childlist parentlist
2448 global idrowranges linesegends
2449 global commitidx curview
2450 global idinlist rowchk rowrangelist
2452 set idlist [lindex $rowidlist $row]
2453 set offs [lindex $rowoffsets $row]
2454 while {$row < $endrow} {
2455 set id [lindex $displayorder $row]
2458 foreach p [lindex $parentlist $row] {
2459 if {![info exists idinlist($p)]} {
2461 } elseif {!$idinlist($p)} {
2466 set nev [expr {[llength $idlist] + [llength $newolds]
2467 + [llength $oldolds] - $maxwidth + 1}]
2470 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2471 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2472 set i [lindex $idlist $x]
2473 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2474 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2475 [expr {$row + $uparrowlen + $mingaplen}]]
2477 set idlist [lreplace $idlist $x $x]
2478 set offs [lreplace $offs $x $x]
2479 set offs [incrange $offs $x 1]
2481 set rm1 [expr {$row - 1}]
2483 lappend idrowranges($i) $rm1
2484 if {[incr nev -1] <= 0} break
2487 set rowchk($id) [expr {$row + $r}]
2490 lset rowidlist $row $idlist
2491 lset rowoffsets $row $offs
2493 lappend linesegends $lse
2494 set col [lsearch -exact $idlist $id]
2496 set col [llength $idlist]
2498 lset rowidlist $row $idlist
2500 if {[lindex $childlist $row] ne {}} {
2501 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2505 lset rowoffsets $row $offs
2507 makeuparrow $id $col $row $z
2513 if {[info exists idrowranges($id)]} {
2514 set ranges $idrowranges($id)
2516 unset idrowranges($id)
2518 lappend rowrangelist $ranges
2520 set offs [ntimes [llength $idlist] 0]
2521 set l [llength $newolds]
2522 set idlist [eval lreplace \$idlist $col $col $newolds]
2525 set offs [lrange $offs 0 [expr {$col - 1}]]
2526 foreach x $newolds {
2531 set tmp [expr {[llength $idlist] - [llength $offs]}]
2533 set offs [concat $offs [ntimes $tmp $o]]
2538 foreach i $newolds {
2540 set idrowranges($i) $row
2543 foreach oid $oldolds {
2544 set idinlist($oid) 1
2545 set idlist [linsert $idlist $col $oid]
2546 set offs [linsert $offs $col $o]
2547 makeuparrow $oid $col $row $o
2550 lappend rowidlist $idlist
2551 lappend rowoffsets $offs
2556 proc addextraid {id row} {
2557 global displayorder commitrow commitinfo
2558 global commitidx commitlisted
2559 global parentlist childlist children curview
2561 incr commitidx($curview)
2562 lappend displayorder $id
2563 lappend commitlisted 0
2564 lappend parentlist {}
2565 set commitrow($curview,$id) $row
2567 if {![info exists commitinfo($id)]} {
2568 set commitinfo($id) {"No commit information available"}
2570 if {![info exists children($curview,$id)]} {
2571 set children($curview,$id) {}
2573 lappend childlist $children($curview,$id)
2576 proc layouttail {} {
2577 global rowidlist rowoffsets idinlist commitidx curview
2578 global idrowranges rowrangelist
2580 set row $commitidx($curview)
2581 set idlist [lindex $rowidlist $row]
2582 while {$idlist ne {}} {
2583 set col [expr {[llength $idlist] - 1}]
2584 set id [lindex $idlist $col]
2587 lappend idrowranges($id) $row
2588 lappend rowrangelist $idrowranges($id)
2589 unset idrowranges($id)
2591 set offs [ntimes $col 0]
2592 set idlist [lreplace $idlist $col $col]
2593 lappend rowidlist $idlist
2594 lappend rowoffsets $offs
2597 foreach id [array names idinlist] {
2599 lset rowidlist $row [list $id]
2600 lset rowoffsets $row 0
2601 makeuparrow $id 0 $row 0
2602 lappend idrowranges($id) $row
2603 lappend rowrangelist $idrowranges($id)
2604 unset idrowranges($id)
2606 lappend rowidlist {}
2607 lappend rowoffsets {}
2611 proc insert_pad {row col npad} {
2612 global rowidlist rowoffsets
2614 set pad [ntimes $npad {}]
2615 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2616 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2617 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2620 proc optimize_rows {row col endrow} {
2621 global rowidlist rowoffsets idrowranges displayorder
2623 for {} {$row < $endrow} {incr row} {
2624 set idlist [lindex $rowidlist $row]
2625 set offs [lindex $rowoffsets $row]
2627 for {} {$col < [llength $offs]} {incr col} {
2628 if {[lindex $idlist $col] eq {}} {
2632 set z [lindex $offs $col]
2633 if {$z eq {}} continue
2635 set x0 [expr {$col + $z}]
2636 set y0 [expr {$row - 1}]
2637 set z0 [lindex $rowoffsets $y0 $x0]
2639 set id [lindex $idlist $col]
2640 set ranges [rowranges $id]
2641 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2645 if {$z < -1 || ($z < 0 && $isarrow)} {
2646 set npad [expr {-1 - $z + $isarrow}]
2647 set offs [incrange $offs $col $npad]
2648 insert_pad $y0 $x0 $npad
2650 optimize_rows $y0 $x0 $row
2652 set z [lindex $offs $col]
2653 set x0 [expr {$col + $z}]
2654 set z0 [lindex $rowoffsets $y0 $x0]
2655 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2656 set npad [expr {$z - 1 + $isarrow}]
2657 set y1 [expr {$row + 1}]
2658 set offs2 [lindex $rowoffsets $y1]
2662 if {$z eq {} || $x1 + $z < $col} continue
2663 if {$x1 + $z > $col} {
2666 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2669 set pad [ntimes $npad {}]
2670 set idlist [eval linsert \$idlist $col $pad]
2671 set tmp [eval linsert \$offs $col $pad]
2673 set offs [incrange $tmp $col [expr {-$npad}]]
2674 set z [lindex $offs $col]
2677 if {$z0 eq {} && !$isarrow} {
2678 # this line links to its first child on row $row-2
2679 set rm2 [expr {$row - 2}]
2680 set id [lindex $displayorder $rm2]
2681 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2683 set z0 [expr {$xc - $x0}]
2686 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2687 insert_pad $y0 $x0 1
2688 set offs [incrange $offs $col 1]
2689 optimize_rows $y0 [expr {$x0 + 1}] $row
2694 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2695 set o [lindex $offs $col]
2697 # check if this is the link to the first child
2698 set id [lindex $idlist $col]
2699 set ranges [rowranges $id]
2700 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2701 # it is, work out offset to child
2702 set y0 [expr {$row - 1}]
2703 set id [lindex $displayorder $y0]
2704 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2706 set o [expr {$x0 - $col}]
2710 if {$o eq {} || $o <= 0} break
2712 if {$o ne {} && [incr col] < [llength $idlist]} {
2713 set y1 [expr {$row + 1}]
2714 set offs2 [lindex $rowoffsets $y1]
2718 if {$z eq {} || $x1 + $z < $col} continue
2719 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2722 set idlist [linsert $idlist $col {}]
2723 set tmp [linsert $offs $col {}]
2725 set offs [incrange $tmp $col -1]
2728 lset rowidlist $row $idlist
2729 lset rowoffsets $row $offs
2735 global canvx0 linespc
2736 return [expr {$canvx0 + $col * $linespc}]
2740 global canvy0 linespc
2741 return [expr {$canvy0 + $row * $linespc}]
2744 proc linewidth {id} {
2745 global thickerline lthickness
2748 if {[info exists thickerline] && $id eq $thickerline} {
2749 set wid [expr {2 * $lthickness}]
2754 proc rowranges {id} {
2755 global phase idrowranges commitrow rowlaidout rowrangelist curview
2759 ([info exists commitrow($curview,$id)]
2760 && $commitrow($curview,$id) < $rowlaidout)} {
2761 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2762 } elseif {[info exists idrowranges($id)]} {
2763 set ranges $idrowranges($id)
2768 proc drawlineseg {id i} {
2769 global rowoffsets rowidlist
2771 global canv colormap linespc
2772 global numcommits commitrow curview
2774 set ranges [rowranges $id]
2776 if {[info exists commitrow($curview,$id)]
2777 && $commitrow($curview,$id) < $numcommits} {
2778 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2782 set startrow [lindex $ranges [expr {2 * $i}]]
2783 set row [lindex $ranges [expr {2 * $i + 1}]]
2784 if {$startrow == $row} return
2787 set col [lsearch -exact [lindex $rowidlist $row] $id]
2789 puts "oops: drawline: id $id not on row $row"
2795 set o [lindex $rowoffsets $row $col]
2798 # changing direction
2799 set x [xc $row $col]
2801 lappend coords $x $y
2807 set x [xc $row $col]
2809 lappend coords $x $y
2811 # draw the link to the first child as part of this line
2813 set child [lindex $displayorder $row]
2814 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2816 set x [xc $row $ccol]
2818 if {$ccol < $col - 1} {
2819 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2820 } elseif {$ccol > $col + 1} {
2821 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2823 lappend coords $x $y
2826 if {[llength $coords] < 4} return
2828 # This line has an arrow at the lower end: check if the arrow is
2829 # on a diagonal segment, and if so, work around the Tk 8.4
2830 # refusal to draw arrows on diagonal lines.
2831 set x0 [lindex $coords 0]
2832 set x1 [lindex $coords 2]
2834 set y0 [lindex $coords 1]
2835 set y1 [lindex $coords 3]
2836 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2837 # we have a nearby vertical segment, just trim off the diag bit
2838 set coords [lrange $coords 2 end]
2840 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2841 set xi [expr {$x0 - $slope * $linespc / 2}]
2842 set yi [expr {$y0 - $linespc / 2}]
2843 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2847 set arrow [expr {2 * ($i > 0) + $downarrow}]
2848 set arrow [lindex {none first last both} $arrow]
2849 set t [$canv create line $coords -width [linewidth $id] \
2850 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2855 proc drawparentlinks {id row col olds} {
2856 global rowidlist canv colormap
2858 set row2 [expr {$row + 1}]
2859 set x [xc $row $col]
2862 set ids [lindex $rowidlist $row2]
2863 # rmx = right-most X coord used
2866 set i [lsearch -exact $ids $p]
2868 puts "oops, parent $p of $id not in list"
2871 set x2 [xc $row2 $i]
2875 set ranges [rowranges $p]
2876 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2877 && $row2 < [lindex $ranges 1]} {
2878 # drawlineseg will do this one for us
2882 # should handle duplicated parents here...
2883 set coords [list $x $y]
2884 if {$i < $col - 1} {
2885 lappend coords [xc $row [expr {$i + 1}]] $y
2886 } elseif {$i > $col + 1} {
2887 lappend coords [xc $row [expr {$i - 1}]] $y
2889 lappend coords $x2 $y2
2890 set t [$canv create line $coords -width [linewidth $p] \
2891 -fill $colormap($p) -tags lines.$p]
2898 proc drawlines {id} {
2899 global colormap canv
2901 global children iddrawn commitrow rowidlist curview
2903 $canv delete lines.$id
2904 set nr [expr {[llength [rowranges $id]] / 2}]
2905 for {set i 0} {$i < $nr} {incr i} {
2906 if {[info exists idrangedrawn($id,$i)]} {
2910 foreach child $children($curview,$id) {
2911 if {[info exists iddrawn($child)]} {
2912 set row $commitrow($curview,$child)
2913 set col [lsearch -exact [lindex $rowidlist $row] $child]
2915 drawparentlinks $child $row $col [list $id]
2921 proc drawcmittext {id row col rmx} {
2922 global linespc canv canv2 canv3 canvy0 fgcolor
2923 global commitlisted commitinfo rowidlist
2924 global rowtextx idpos idtags idheads idotherrefs
2925 global linehtag linentag linedtag
2926 global mainfont canvxmax boldrows boldnamerows fgcolor
2928 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2929 set x [xc $row $col]
2931 set orad [expr {$linespc / 3}]
2932 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2933 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2934 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2936 $canv bind $t <1> {selcanvline {} %x %y}
2937 set xt [xc $row [llength [lindex $rowidlist $row]]]
2941 set rowtextx($row) $xt
2942 set idpos($id) [list $x $xt $y]
2943 if {[info exists idtags($id)] || [info exists idheads($id)]
2944 || [info exists idotherrefs($id)]} {
2945 set xt [drawtags $id $x $xt $y]
2947 set headline [lindex $commitinfo($id) 0]
2948 set name [lindex $commitinfo($id) 1]
2949 set date [lindex $commitinfo($id) 2]
2950 set date [formatdate $date]
2953 set isbold [ishighlighted $row]
2955 lappend boldrows $row
2958 lappend boldnamerows $row
2962 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2963 -text $headline -font $font -tags text]
2964 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2965 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2966 -text $name -font $nfont -tags text]
2967 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2968 -text $date -font $mainfont -tags text]
2969 set xr [expr {$xt + [font measure $mainfont $headline]}]
2970 if {$xr > $canvxmax} {
2976 proc drawcmitrow {row} {
2977 global displayorder rowidlist
2978 global idrangedrawn iddrawn
2979 global commitinfo parentlist numcommits
2980 global filehighlight fhighlights findstring nhighlights
2981 global hlview vhighlights
2982 global highlight_related rhighlights
2984 if {$row >= $numcommits} return
2985 foreach id [lindex $rowidlist $row] {
2986 if {$id eq {}} continue
2988 foreach {s e} [rowranges $id] {
2990 if {$row < $s} continue
2993 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2995 set idrangedrawn($id,$i) 1
3002 set id [lindex $displayorder $row]
3003 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3004 askvhighlight $row $id
3006 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3007 askfilehighlight $row $id
3009 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3010 askfindhighlight $row $id
3012 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3013 askrelhighlight $row $id
3015 if {[info exists iddrawn($id)]} return
3016 set col [lsearch -exact [lindex $rowidlist $row] $id]
3018 puts "oops, row $row id $id not in list"
3021 if {![info exists commitinfo($id)]} {
3025 set olds [lindex $parentlist $row]
3027 set rmx [drawparentlinks $id $row $col $olds]
3031 drawcmittext $id $row $col $rmx
3035 proc drawfrac {f0 f1} {
3036 global numcommits canv
3039 set ymax [lindex [$canv cget -scrollregion] 3]
3040 if {$ymax eq {} || $ymax == 0} return
3041 set y0 [expr {int($f0 * $ymax)}]
3042 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3046 set y1 [expr {int($f1 * $ymax)}]
3047 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3048 if {$endrow >= $numcommits} {
3049 set endrow [expr {$numcommits - 1}]
3051 for {} {$row <= $endrow} {incr row} {
3056 proc drawvisible {} {
3058 eval drawfrac [$canv yview]
3061 proc clear_display {} {
3062 global iddrawn idrangedrawn
3063 global vhighlights fhighlights nhighlights rhighlights
3066 catch {unset iddrawn}
3067 catch {unset idrangedrawn}
3068 catch {unset vhighlights}
3069 catch {unset fhighlights}
3070 catch {unset nhighlights}
3071 catch {unset rhighlights}
3074 proc findcrossings {id} {
3075 global rowidlist parentlist numcommits rowoffsets displayorder
3079 foreach {s e} [rowranges $id] {
3080 if {$e >= $numcommits} {
3081 set e [expr {$numcommits - 1}]
3083 if {$e <= $s} continue
3084 set x [lsearch -exact [lindex $rowidlist $e] $id]
3086 puts "findcrossings: oops, no [shortids $id] in row $e"
3089 for {set row $e} {[incr row -1] >= $s} {} {
3090 set olds [lindex $parentlist $row]
3091 set kid [lindex $displayorder $row]
3092 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3093 if {$kidx < 0} continue
3094 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3096 set px [lsearch -exact $nextrow $p]
3097 if {$px < 0} continue
3098 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3099 if {[lsearch -exact $ccross $p] >= 0} continue
3100 if {$x == $px + ($kidx < $px? -1: 1)} {
3102 } elseif {[lsearch -exact $cross $p] < 0} {
3107 set inc [lindex $rowoffsets $row $x]
3108 if {$inc eq {}} break
3112 return [concat $ccross {{}} $cross]
3115 proc assigncolor {id} {
3116 global colormap colors nextcolor
3117 global commitrow parentlist children children curview
3119 if {[info exists colormap($id)]} return
3120 set ncolors [llength $colors]
3121 if {[info exists children($curview,$id)]} {
3122 set kids $children($curview,$id)
3126 if {[llength $kids] == 1} {
3127 set child [lindex $kids 0]
3128 if {[info exists colormap($child)]
3129 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3130 set colormap($id) $colormap($child)
3136 foreach x [findcrossings $id] {
3138 # delimiter between corner crossings and other crossings
3139 if {[llength $badcolors] >= $ncolors - 1} break
3140 set origbad $badcolors
3142 if {[info exists colormap($x)]
3143 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3144 lappend badcolors $colormap($x)
3147 if {[llength $badcolors] >= $ncolors} {
3148 set badcolors $origbad
3150 set origbad $badcolors
3151 if {[llength $badcolors] < $ncolors - 1} {
3152 foreach child $kids {
3153 if {[info exists colormap($child)]
3154 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3155 lappend badcolors $colormap($child)
3157 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3158 if {[info exists colormap($p)]
3159 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3160 lappend badcolors $colormap($p)
3164 if {[llength $badcolors] >= $ncolors} {
3165 set badcolors $origbad
3168 for {set i 0} {$i <= $ncolors} {incr i} {
3169 set c [lindex $colors $nextcolor]
3170 if {[incr nextcolor] >= $ncolors} {
3173 if {[lsearch -exact $badcolors $c]} break
3175 set colormap($id) $c
3178 proc bindline {t id} {
3181 $canv bind $t <Enter> "lineenter %x %y $id"
3182 $canv bind $t <Motion> "linemotion %x %y $id"
3183 $canv bind $t <Leave> "lineleave $id"
3184 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3187 proc drawtags {id x xt y1} {
3188 global idtags idheads idotherrefs mainhead
3189 global linespc lthickness
3190 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3195 if {[info exists idtags($id)]} {
3196 set marks $idtags($id)
3197 set ntags [llength $marks]
3199 if {[info exists idheads($id)]} {
3200 set marks [concat $marks $idheads($id)]
3201 set nheads [llength $idheads($id)]
3203 if {[info exists idotherrefs($id)]} {
3204 set marks [concat $marks $idotherrefs($id)]
3210 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3211 set yt [expr {$y1 - 0.5 * $linespc}]
3212 set yb [expr {$yt + $linespc - 1}]
3216 foreach tag $marks {
3218 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3219 set wid [font measure [concat $mainfont bold] $tag]
3221 set wid [font measure $mainfont $tag]
3225 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3227 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3228 -width $lthickness -fill black -tags tag.$id]
3230 foreach tag $marks x $xvals wid $wvals {
3231 set xl [expr {$x + $delta}]
3232 set xr [expr {$x + $delta + $wid + $lthickness}]
3234 if {[incr ntags -1] >= 0} {
3236 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3237 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3238 -width 1 -outline black -fill yellow -tags tag.$id]
3239 $canv bind $t <1> [list showtag $tag 1]
3240 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3242 # draw a head or other ref
3243 if {[incr nheads -1] >= 0} {
3245 if {$tag eq $mainhead} {
3251 set xl [expr {$xl - $delta/2}]
3252 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3253 -width 1 -outline black -fill $col -tags tag.$id
3254 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3255 set rwid [font measure $mainfont $remoteprefix]
3256 set xi [expr {$x + 1}]
3257 set yti [expr {$yt + 1}]
3258 set xri [expr {$x + $rwid}]
3259 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3260 -width 0 -fill "#ffddaa" -tags tag.$id
3263 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3264 -font $font -tags [list tag.$id text]]
3266 $canv bind $t <1> [list showtag $tag 1]
3267 } elseif {$nheads >= 0} {
3268 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3274 proc xcoord {i level ln} {
3275 global canvx0 xspc1 xspc2
3277 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3278 if {$i > 0 && $i == $level} {
3279 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3280 } elseif {$i > $level} {
3281 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3286 proc show_status {msg} {
3287 global canv mainfont fgcolor
3290 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3291 -tags text -fill $fgcolor
3294 proc finishcommits {} {
3295 global commitidx phase curview
3296 global pending_select
3298 if {$commitidx($curview) > 0} {
3301 show_status "No commits selected"
3304 catch {unset pending_select}
3307 # Inserting a new commit as the child of the commit on row $row.
3308 # The new commit will be displayed on row $row and the commits
3309 # on that row and below will move down one row.
3310 proc insertrow {row newcmit} {
3311 global displayorder parentlist childlist commitlisted
3312 global commitrow curview rowidlist rowoffsets numcommits
3313 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3316 if {$row >= $numcommits} {
3317 puts "oops, inserting new row $row but only have $numcommits rows"
3320 set p [lindex $displayorder $row]
3321 set displayorder [linsert $displayorder $row $newcmit]
3322 set parentlist [linsert $parentlist $row $p]
3323 set kids [lindex $childlist $row]
3324 lappend kids $newcmit
3325 lset childlist $row $kids
3326 set childlist [linsert $childlist $row {}]
3327 set l [llength $displayorder]
3328 for {set r $row} {$r < $l} {incr r} {
3329 set id [lindex $displayorder $r]
3330 set commitrow($curview,$id) $r
3333 set idlist [lindex $rowidlist $row]
3334 set offs [lindex $rowoffsets $row]
3337 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3343 if {[llength $kids] == 1} {
3344 set col [lsearch -exact $idlist $p]
3345 lset idlist $col $newcmit
3347 set col [llength $idlist]
3348 lappend idlist $newcmit
3350 lset rowoffsets $row $offs
3352 set rowidlist [linsert $rowidlist $row $idlist]
3353 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3355 set rowrangelist [linsert $rowrangelist $row {}]
3356 set l [llength $rowrangelist]
3357 for {set r 0} {$r < $l} {incr r} {
3358 set ranges [lindex $rowrangelist $r]
3359 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3363 lappend newranges [expr {$x + 1}]
3365 lappend newranges $x
3368 lset rowrangelist $r $newranges
3371 if {[llength $kids] > 1} {
3372 set rp1 [expr {$row + 1}]
3373 set ranges [lindex $rowrangelist $rp1]
3374 if {$ranges eq {}} {
3375 set ranges [list $row $rp1]
3376 } elseif {[lindex $ranges end-1] == $rp1} {
3377 lset ranges end-1 $row
3379 lset rowrangelist $rp1 $ranges
3381 foreach id [array names idrowranges] {
3382 set ranges $idrowranges($id)
3383 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3387 lappend newranges [expr {$x + 1}]
3389 lappend newranges $x
3392 set idrowranges($id) $newranges
3396 set linesegends [linsert $linesegends $row {}]
3405 # Don't change the text pane cursor if it is currently the hand cursor,
3406 # showing that we are over a sha1 ID link.
3407 proc settextcursor {c} {
3408 global ctext curtextcursor
3410 if {[$ctext cget -cursor] == $curtextcursor} {
3411 $ctext config -cursor $c
3413 set curtextcursor $c
3416 proc nowbusy {what} {
3419 if {[array names isbusy] eq {}} {
3420 . config -cursor watch
3426 proc notbusy {what} {
3427 global isbusy maincursor textcursor
3429 catch {unset isbusy($what)}
3430 if {[array names isbusy] eq {}} {
3431 . config -cursor $maincursor
3432 settextcursor $textcursor
3438 global rowlaidout commitidx curview
3439 global pending_select
3442 layoutrows $rowlaidout $commitidx($curview) 1
3444 optimize_rows $row 0 $commitidx($curview)
3445 showstuff $commitidx($curview)
3446 if {[info exists pending_select]} {
3450 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3452 #puts "overall $drawmsecs ms for $numcommits commits"
3455 proc findmatches {f} {
3456 global findtype foundstring foundstrlen
3457 if {$findtype == "Regexp"} {
3458 set matches [regexp -indices -all -inline $foundstring $f]
3460 if {$findtype == "IgnCase"} {
3461 set str [string tolower $f]
3467 while {[set j [string first $foundstring $str $i]] >= 0} {
3468 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3469 set i [expr {$j + $foundstrlen}]
3476 global findtype findloc findstring markedmatches commitinfo
3477 global numcommits displayorder linehtag linentag linedtag
3478 global mainfont canv canv2 canv3 selectedline
3479 global matchinglines foundstring foundstrlen matchstring
3484 cancel_next_highlight
3486 set matchinglines {}
3487 if {$findtype == "IgnCase"} {
3488 set foundstring [string tolower $findstring]
3490 set foundstring $findstring
3492 set foundstrlen [string length $findstring]
3493 if {$foundstrlen == 0} return
3494 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3495 set matchstring "*$matchstring*"
3496 if {![info exists selectedline]} {
3499 set oldsel $selectedline
3502 set fldtypes {Headline Author Date Committer CDate Comments}
3504 foreach id $displayorder {
3505 set d $commitdata($id)
3507 if {$findtype == "Regexp"} {
3508 set doesmatch [regexp $foundstring $d]
3509 } elseif {$findtype == "IgnCase"} {
3510 set doesmatch [string match -nocase $matchstring $d]
3512 set doesmatch [string match $matchstring $d]
3514 if {!$doesmatch} continue
3515 if {![info exists commitinfo($id)]} {
3518 set info $commitinfo($id)
3520 foreach f $info ty $fldtypes {
3521 if {$findloc != "All fields" && $findloc != $ty} {
3524 set matches [findmatches $f]
3525 if {$matches == {}} continue
3527 if {$ty == "Headline"} {
3529 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3530 } elseif {$ty == "Author"} {
3532 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3533 } elseif {$ty == "Date"} {
3535 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3539 lappend matchinglines $l
3540 if {!$didsel && $l > $oldsel} {
3546 if {$matchinglines == {}} {
3548 } elseif {!$didsel} {
3549 findselectline [lindex $matchinglines 0]
3553 proc findselectline {l} {
3554 global findloc commentend ctext
3556 if {$findloc == "All fields" || $findloc == "Comments"} {
3557 # highlight the matches in the comments
3558 set f [$ctext get 1.0 $commentend]
3559 set matches [findmatches $f]
3560 foreach match $matches {
3561 set start [lindex $match 0]
3562 set end [expr {[lindex $match 1] + 1}]
3563 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3568 proc findnext {restart} {
3569 global matchinglines selectedline
3570 if {![info exists matchinglines]} {
3576 if {![info exists selectedline]} return
3577 foreach l $matchinglines {
3578 if {$l > $selectedline} {
3587 global matchinglines selectedline
3588 if {![info exists matchinglines]} {
3592 if {![info exists selectedline]} return
3594 foreach l $matchinglines {
3595 if {$l >= $selectedline} break
3599 findselectline $prev
3605 proc stopfindproc {{done 0}} {
3606 global findprocpid findprocfile findids
3607 global ctext findoldcursor phase maincursor textcursor
3608 global findinprogress
3610 catch {unset findids}
3611 if {[info exists findprocpid]} {
3613 catch {exec kill $findprocpid}
3615 catch {close $findprocfile}
3618 catch {unset findinprogress}
3622 # mark a commit as matching by putting a yellow background
3623 # behind the headline
3624 proc markheadline {l id} {
3625 global canv mainfont linehtag
3628 set bbox [$canv bbox $linehtag($l)]
3629 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3633 # mark the bits of a headline, author or date that match a find string
3634 proc markmatches {canv l str tag matches font} {
3635 set bbox [$canv bbox $tag]
3636 set x0 [lindex $bbox 0]
3637 set y0 [lindex $bbox 1]
3638 set y1 [lindex $bbox 3]
3639 foreach match $matches {
3640 set start [lindex $match 0]
3641 set end [lindex $match 1]
3642 if {$start > $end} continue
3643 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3644 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3645 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3646 [expr {$x0+$xlen+2}] $y1 \
3647 -outline {} -tags matches -fill yellow]
3652 proc unmarkmatches {} {
3653 global matchinglines findids
3654 allcanvs delete matches
3655 catch {unset matchinglines}
3656 catch {unset findids}
3659 proc selcanvline {w x y} {
3660 global canv canvy0 ctext linespc
3662 set ymax [lindex [$canv cget -scrollregion] 3]
3663 if {$ymax == {}} return
3664 set yfrac [lindex [$canv yview] 0]
3665 set y [expr {$y + $yfrac * $ymax}]
3666 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3671 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3677 proc commit_descriptor {p} {
3679 if {![info exists commitinfo($p)]} {
3683 if {[llength $commitinfo($p)] > 1} {
3684 set l [lindex $commitinfo($p) 0]
3689 # append some text to the ctext widget, and make any SHA1 ID
3690 # that we know about be a clickable link.
3691 proc appendwithlinks {text tags} {
3692 global ctext commitrow linknum curview
3694 set start [$ctext index "end - 1c"]
3695 $ctext insert end $text $tags
3696 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3700 set linkid [string range $text $s $e]
3701 if {![info exists commitrow($curview,$linkid)]} continue
3703 $ctext tag add link "$start + $s c" "$start + $e c"
3704 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3705 $ctext tag bind link$linknum <1> \
3706 [list selectline $commitrow($curview,$linkid) 1]
3709 $ctext tag conf link -foreground blue -underline 1
3710 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3711 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3714 proc viewnextline {dir} {
3718 set ymax [lindex [$canv cget -scrollregion] 3]
3719 set wnow [$canv yview]
3720 set wtop [expr {[lindex $wnow 0] * $ymax}]
3721 set newtop [expr {$wtop + $dir * $linespc}]
3724 } elseif {$newtop > $ymax} {
3727 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3730 # add a list of tag or branch names at position pos
3731 # returns the number of names inserted
3732 proc appendrefs {pos tags var} {
3733 global ctext commitrow linknum curview $var
3735 if {[catch {$ctext index $pos}]} {
3738 set tags [lsort $tags]
3741 set id [set $var\($tag\)]
3744 $ctext insert $pos $sep
3745 $ctext insert $pos $tag $lk
3746 $ctext tag conf $lk -foreground blue
3747 if {[info exists commitrow($curview,$id)]} {
3748 $ctext tag bind $lk <1> \
3749 [list selectline $commitrow($curview,$id) 1]
3750 $ctext tag conf $lk -underline 1
3751 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3752 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3756 return [llength $tags]
3759 proc taglist {ids} {
3764 foreach tag $idtags($id) {
3771 # called when we have finished computing the nearby tags
3772 proc dispneartags {} {
3773 global selectedline currentid ctext anc_tags desc_tags showneartags
3776 if {![info exists selectedline] || !$showneartags} return
3778 $ctext conf -state normal
3779 if {[info exists desc_heads($id)]} {
3780 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3781 $ctext insert "branch -2c" "es"
3784 if {[info exists anc_tags($id)]} {
3785 appendrefs follows [taglist $anc_tags($id)] tagids
3787 if {[info exists desc_tags($id)]} {
3788 appendrefs precedes [taglist $desc_tags($id)] tagids
3790 $ctext conf -state disabled
3793 proc selectline {l isnew} {
3794 global canv canv2 canv3 ctext commitinfo selectedline
3795 global displayorder linehtag linentag linedtag
3796 global canvy0 linespc parentlist childlist
3797 global currentid sha1entry
3798 global commentend idtags linknum
3799 global mergemax numcommits pending_select
3800 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3802 catch {unset pending_select}
3805 cancel_next_highlight
3806 if {$l < 0 || $l >= $numcommits} return
3807 set y [expr {$canvy0 + $l * $linespc}]
3808 set ymax [lindex [$canv cget -scrollregion] 3]
3809 set ytop [expr {$y - $linespc - 1}]
3810 set ybot [expr {$y + $linespc + 1}]
3811 set wnow [$canv yview]
3812 set wtop [expr {[lindex $wnow 0] * $ymax}]
3813 set wbot [expr {[lindex $wnow 1] * $ymax}]
3814 set wh [expr {$wbot - $wtop}]
3816 if {$ytop < $wtop} {
3817 if {$ybot < $wtop} {
3818 set newtop [expr {$y - $wh / 2.0}]
3821 if {$newtop > $wtop - $linespc} {
3822 set newtop [expr {$wtop - $linespc}]
3825 } elseif {$ybot > $wbot} {
3826 if {$ytop > $wbot} {
3827 set newtop [expr {$y - $wh / 2.0}]
3829 set newtop [expr {$ybot - $wh}]
3830 if {$newtop < $wtop + $linespc} {
3831 set newtop [expr {$wtop + $linespc}]
3835 if {$newtop != $wtop} {
3839 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3843 if {![info exists linehtag($l)]} return
3845 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3846 -tags secsel -fill [$canv cget -selectbackground]]
3848 $canv2 delete secsel
3849 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3850 -tags secsel -fill [$canv2 cget -selectbackground]]
3852 $canv3 delete secsel
3853 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3854 -tags secsel -fill [$canv3 cget -selectbackground]]
3858 addtohistory [list selectline $l 0]
3863 set id [lindex $displayorder $l]
3865 $sha1entry delete 0 end
3866 $sha1entry insert 0 $id
3867 $sha1entry selection from 0
3868 $sha1entry selection to end
3871 $ctext conf -state normal
3874 set info $commitinfo($id)
3875 set date [formatdate [lindex $info 2]]
3876 $ctext insert end "Author: [lindex $info 1] $date\n"
3877 set date [formatdate [lindex $info 4]]
3878 $ctext insert end "Committer: [lindex $info 3] $date\n"
3879 if {[info exists idtags($id)]} {
3880 $ctext insert end "Tags:"
3881 foreach tag $idtags($id) {
3882 $ctext insert end " $tag"
3884 $ctext insert end "\n"
3888 set olds [lindex $parentlist $l]
3889 if {[llength $olds] > 1} {
3892 if {$np >= $mergemax} {
3897 $ctext insert end "Parent: " $tag
3898 appendwithlinks [commit_descriptor $p] {}
3903 append headers "Parent: [commit_descriptor $p]"
3907 foreach c [lindex $childlist $l] {
3908 append headers "Child: [commit_descriptor $c]"
3911 # make anything that looks like a SHA1 ID be a clickable link
3912 appendwithlinks $headers {}
3913 if {$showneartags} {
3914 if {![info exists allcommits]} {
3917 $ctext insert end "Branch: "
3918 $ctext mark set branch "end -1c"
3919 $ctext mark gravity branch left
3920 if {[info exists desc_heads($id)]} {
3921 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3922 # turn "Branch" into "Branches"
3923 $ctext insert "branch -2c" "es"
3926 $ctext insert end "\nFollows: "
3927 $ctext mark set follows "end -1c"
3928 $ctext mark gravity follows left
3929 if {[info exists anc_tags($id)]} {
3930 appendrefs follows [taglist $anc_tags($id)] tagids
3932 $ctext insert end "\nPrecedes: "
3933 $ctext mark set precedes "end -1c"
3934 $ctext mark gravity precedes left
3935 if {[info exists desc_tags($id)]} {
3936 appendrefs precedes [taglist $desc_tags($id)] tagids
3938 $ctext insert end "\n"
3940 $ctext insert end "\n"
3941 appendwithlinks [lindex $info 5] {comment}
3943 $ctext tag delete Comments
3944 $ctext tag remove found 1.0 end
3945 $ctext conf -state disabled
3946 set commentend [$ctext index "end - 1c"]
3948 init_flist "Comments"
3949 if {$cmitmode eq "tree"} {
3951 } elseif {[llength $olds] <= 1} {
3958 proc selfirstline {} {
3963 proc sellastline {} {
3966 set l [expr {$numcommits - 1}]
3970 proc selnextline {dir} {
3972 if {![info exists selectedline]} return
3973 set l [expr {$selectedline + $dir}]
3978 proc selnextpage {dir} {
3979 global canv linespc selectedline numcommits
3981 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3985 allcanvs yview scroll [expr {$dir * $lpp}] units
3987 if {![info exists selectedline]} return
3988 set l [expr {$selectedline + $dir * $lpp}]
3991 } elseif {$l >= $numcommits} {
3992 set l [expr $numcommits - 1]
3998 proc unselectline {} {
3999 global selectedline currentid
4001 catch {unset selectedline}
4002 catch {unset currentid}
4003 allcanvs delete secsel
4005 cancel_next_highlight
4008 proc reselectline {} {
4011 if {[info exists selectedline]} {
4012 selectline $selectedline 0
4016 proc addtohistory {cmd} {
4017 global history historyindex curview
4019 set elt [list $curview $cmd]
4020 if {$historyindex > 0
4021 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4025 if {$historyindex < [llength $history]} {
4026 set history [lreplace $history $historyindex end $elt]
4028 lappend history $elt
4031 if {$historyindex > 1} {
4032 .ctop.top.bar.leftbut conf -state normal
4034 .ctop.top.bar.leftbut conf -state disabled
4036 .ctop.top.bar.rightbut conf -state disabled
4042 set view [lindex $elt 0]
4043 set cmd [lindex $elt 1]
4044 if {$curview != $view} {
4051 global history historyindex
4053 if {$historyindex > 1} {
4054 incr historyindex -1
4055 godo [lindex $history [expr {$historyindex - 1}]]
4056 .ctop.top.bar.rightbut conf -state normal
4058 if {$historyindex <= 1} {
4059 .ctop.top.bar.leftbut conf -state disabled
4064 global history historyindex
4066 if {$historyindex < [llength $history]} {
4067 set cmd [lindex $history $historyindex]
4070 .ctop.top.bar.leftbut conf -state normal
4072 if {$historyindex >= [llength $history]} {
4073 .ctop.top.bar.rightbut conf -state disabled
4078 global treefilelist treeidlist diffids diffmergeid treepending
4081 catch {unset diffmergeid}
4082 if {![info exists treefilelist($id)]} {
4083 if {![info exists treepending]} {
4084 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4088 set treefilelist($id) {}
4089 set treeidlist($id) {}
4090 fconfigure $gtf -blocking 0
4091 fileevent $gtf readable [list gettreeline $gtf $id]
4098 proc gettreeline {gtf id} {
4099 global treefilelist treeidlist treepending cmitmode diffids
4101 while {[gets $gtf line] >= 0} {
4102 if {[lindex $line 1] ne "blob"} continue
4103 set sha1 [lindex $line 2]
4104 set fname [lindex $line 3]
4105 lappend treefilelist($id) $fname
4106 lappend treeidlist($id) $sha1
4108 if {![eof $gtf]} return
4111 if {$cmitmode ne "tree"} {
4112 if {![info exists diffmergeid]} {
4113 gettreediffs $diffids
4115 } elseif {$id ne $diffids} {
4123 global treefilelist treeidlist diffids
4124 global ctext commentend
4126 set i [lsearch -exact $treefilelist($diffids) $f]
4128 puts "oops, $f not in list for id $diffids"
4131 set blob [lindex $treeidlist($diffids) $i]
4132 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4133 puts "oops, error reading blob $blob: $err"
4136 fconfigure $bf -blocking 0
4137 fileevent $bf readable [list getblobline $bf $diffids]
4138 $ctext config -state normal
4139 clear_ctext $commentend
4140 $ctext insert end "\n"
4141 $ctext insert end "$f\n" filesep
4142 $ctext config -state disabled
4143 $ctext yview $commentend
4146 proc getblobline {bf id} {
4147 global diffids cmitmode ctext
4149 if {$id ne $diffids || $cmitmode ne "tree"} {
4153 $ctext config -state normal
4154 while {[gets $bf line] >= 0} {
4155 $ctext insert end "$line\n"
4158 # delete last newline
4159 $ctext delete "end - 2c" "end - 1c"
4162 $ctext config -state disabled
4165 proc mergediff {id l} {
4166 global diffmergeid diffopts mdifffd
4172 # this doesn't seem to actually affect anything...
4173 set env(GIT_DIFF_OPTS) $diffopts
4174 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4175 if {[catch {set mdf [open $cmd r]} err]} {
4176 error_popup "Error getting merge diffs: $err"
4179 fconfigure $mdf -blocking 0
4180 set mdifffd($id) $mdf
4181 set np [llength [lindex $parentlist $l]]
4182 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4183 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4186 proc getmergediffline {mdf id np} {
4187 global diffmergeid ctext cflist nextupdate mergemax
4188 global difffilestart mdifffd
4190 set n [gets $mdf line]
4197 if {![info exists diffmergeid] || $id != $diffmergeid
4198 || $mdf != $mdifffd($id)} {
4201 $ctext conf -state normal
4202 if {[regexp {^diff --cc (.*)} $line match fname]} {
4203 # start of a new file
4204 $ctext insert end "\n"
4205 set here [$ctext index "end - 1c"]
4206 lappend difffilestart $here
4207 add_flist [list $fname]
4208 set l [expr {(78 - [string length $fname]) / 2}]
4209 set pad [string range "----------------------------------------" 1 $l]
4210 $ctext insert end "$pad $fname $pad\n" filesep
4211 } elseif {[regexp {^@@} $line]} {
4212 $ctext insert end "$line\n" hunksep
4213 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4216 # parse the prefix - one ' ', '-' or '+' for each parent
4221 for {set j 0} {$j < $np} {incr j} {
4222 set c [string range $line $j $j]
4225 } elseif {$c == "-"} {
4227 } elseif {$c == "+"} {
4236 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4237 # line doesn't appear in result, parents in $minuses have the line
4238 set num [lindex $minuses 0]
4239 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4240 # line appears in result, parents in $pluses don't have the line
4241 lappend tags mresult
4242 set num [lindex $spaces 0]
4245 if {$num >= $mergemax} {
4250 $ctext insert end "$line\n" $tags
4252 $ctext conf -state disabled
4253 if {[clock clicks -milliseconds] >= $nextupdate} {
4255 fileevent $mdf readable {}
4257 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4261 proc startdiff {ids} {
4262 global treediffs diffids treepending diffmergeid
4265 catch {unset diffmergeid}
4266 if {![info exists treediffs($ids)]} {
4267 if {![info exists treepending]} {
4275 proc addtocflist {ids} {
4276 global treediffs cflist
4277 add_flist $treediffs($ids)
4281 proc gettreediffs {ids} {
4282 global treediff treepending
4283 set treepending $ids
4286 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4288 fconfigure $gdtf -blocking 0
4289 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4292 proc gettreediffline {gdtf ids} {
4293 global treediff treediffs treepending diffids diffmergeid
4296 set n [gets $gdtf line]
4298 if {![eof $gdtf]} return
4300 set treediffs($ids) $treediff
4302 if {$cmitmode eq "tree"} {
4304 } elseif {$ids != $diffids} {
4305 if {![info exists diffmergeid]} {
4306 gettreediffs $diffids
4313 set file [lindex $line 5]
4314 lappend treediff $file
4317 proc getblobdiffs {ids} {
4318 global diffopts blobdifffd diffids env curdifftag curtagstart
4319 global nextupdate diffinhdr treediffs
4321 set env(GIT_DIFF_OPTS) $diffopts
4322 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4323 if {[catch {set bdf [open $cmd r]} err]} {
4324 puts "error getting diffs: $err"
4328 fconfigure $bdf -blocking 0
4329 set blobdifffd($ids) $bdf
4330 set curdifftag Comments
4332 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4333 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4336 proc setinlist {var i val} {
4339 while {[llength [set $var]] < $i} {
4342 if {[llength [set $var]] == $i} {
4349 proc getblobdiffline {bdf ids} {
4350 global diffids blobdifffd ctext curdifftag curtagstart
4351 global diffnexthead diffnextnote difffilestart
4352 global nextupdate diffinhdr treediffs
4354 set n [gets $bdf line]
4358 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4359 $ctext tag add $curdifftag $curtagstart end
4364 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4367 $ctext conf -state normal
4368 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4369 # start of a new file
4370 $ctext insert end "\n"
4371 $ctext tag add $curdifftag $curtagstart end
4372 set here [$ctext index "end - 1c"]
4373 set curtagstart $here
4375 set i [lsearch -exact $treediffs($ids) $fname]
4377 setinlist difffilestart $i $here
4379 if {$newname ne $fname} {
4380 set i [lsearch -exact $treediffs($ids) $newname]
4382 setinlist difffilestart $i $here
4385 set curdifftag "f:$fname"
4386 $ctext tag delete $curdifftag
4387 set l [expr {(78 - [string length $header]) / 2}]
4388 set pad [string range "----------------------------------------" 1 $l]
4389 $ctext insert end "$pad $header $pad\n" filesep
4391 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4393 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4395 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4396 $line match f1l f1c f2l f2c rest]} {
4397 $ctext insert end "$line\n" hunksep
4400 set x [string range $line 0 0]
4401 if {$x == "-" || $x == "+"} {
4402 set tag [expr {$x == "+"}]
4403 $ctext insert end "$line\n" d$tag
4404 } elseif {$x == " "} {
4405 $ctext insert end "$line\n"
4406 } elseif {$diffinhdr || $x == "\\"} {
4407 # e.g. "\ No newline at end of file"
4408 $ctext insert end "$line\n" filesep
4410 # Something else we don't recognize
4411 if {$curdifftag != "Comments"} {
4412 $ctext insert end "\n"
4413 $ctext tag add $curdifftag $curtagstart end
4414 set curtagstart [$ctext index "end - 1c"]
4415 set curdifftag Comments
4417 $ctext insert end "$line\n" filesep
4420 $ctext conf -state disabled
4421 if {[clock clicks -milliseconds] >= $nextupdate} {
4423 fileevent $bdf readable {}
4425 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4430 global difffilestart ctext
4431 set here [$ctext index @0,0]
4432 foreach loc $difffilestart {
4433 if {[$ctext compare $loc > $here]} {
4439 proc clear_ctext {{first 1.0}} {
4440 global ctext smarktop smarkbot
4442 set l [lindex [split $first .] 0]
4443 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4446 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4449 $ctext delete $first end
4452 proc incrsearch {name ix op} {
4453 global ctext searchstring searchdirn
4455 $ctext tag remove found 1.0 end
4456 if {[catch {$ctext index anchor}]} {
4457 # no anchor set, use start of selection, or of visible area
4458 set sel [$ctext tag ranges sel]
4460 $ctext mark set anchor [lindex $sel 0]
4461 } elseif {$searchdirn eq "-forwards"} {
4462 $ctext mark set anchor @0,0
4464 $ctext mark set anchor @0,[winfo height $ctext]
4467 if {$searchstring ne {}} {
4468 set here [$ctext search $searchdirn -- $searchstring anchor]
4477 global sstring ctext searchstring searchdirn
4480 $sstring icursor end
4481 set searchdirn -forwards
4482 if {$searchstring ne {}} {
4483 set sel [$ctext tag ranges sel]
4485 set start "[lindex $sel 0] + 1c"
4486 } elseif {[catch {set start [$ctext index anchor]}]} {
4489 set match [$ctext search -count mlen -- $searchstring $start]
4490 $ctext tag remove sel 1.0 end
4496 set mend "$match + $mlen c"
4497 $ctext tag add sel $match $mend
4498 $ctext mark unset anchor
4502 proc dosearchback {} {
4503 global sstring ctext searchstring searchdirn
4506 $sstring icursor end
4507 set searchdirn -backwards
4508 if {$searchstring ne {}} {
4509 set sel [$ctext tag ranges sel]
4511 set start [lindex $sel 0]
4512 } elseif {[catch {set start [$ctext index anchor]}]} {
4513 set start @0,[winfo height $ctext]
4515 set match [$ctext search -backwards -count ml -- $searchstring $start]
4516 $ctext tag remove sel 1.0 end
4522 set mend "$match + $ml c"
4523 $ctext tag add sel $match $mend
4524 $ctext mark unset anchor
4528 proc searchmark {first last} {
4529 global ctext searchstring
4533 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4534 if {$match eq {}} break
4535 set mend "$match + $mlen c"
4536 $ctext tag add found $match $mend
4540 proc searchmarkvisible {doall} {
4541 global ctext smarktop smarkbot
4543 set topline [lindex [split [$ctext index @0,0] .] 0]
4544 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4545 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4546 # no overlap with previous
4547 searchmark $topline $botline
4548 set smarktop $topline
4549 set smarkbot $botline
4551 if {$topline < $smarktop} {
4552 searchmark $topline [expr {$smarktop-1}]
4553 set smarktop $topline
4555 if {$botline > $smarkbot} {
4556 searchmark [expr {$smarkbot+1}] $botline
4557 set smarkbot $botline
4562 proc scrolltext {f0 f1} {
4565 .ctop.cdet.left.sb set $f0 $f1
4566 if {$searchstring ne {}} {
4572 global linespc charspc canvx0 canvy0 mainfont
4573 global xspc1 xspc2 lthickness
4575 set linespc [font metrics $mainfont -linespace]
4576 set charspc [font measure $mainfont "m"]
4577 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4578 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4579 set lthickness [expr {int($linespc / 9) + 1}]
4580 set xspc1(0) $linespc
4588 set ymax [lindex [$canv cget -scrollregion] 3]
4589 if {$ymax eq {} || $ymax == 0} return
4590 set span [$canv yview]
4593 allcanvs yview moveto [lindex $span 0]
4595 if {[info exists selectedline]} {
4596 selectline $selectedline 0
4597 allcanvs yview moveto [lindex $span 0]
4601 proc incrfont {inc} {
4602 global mainfont textfont ctext canv phase
4603 global stopped entries
4605 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4606 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4608 $ctext conf -font $textfont
4609 $ctext tag conf filesep -font [concat $textfont bold]
4610 foreach e $entries {
4611 $e conf -font $mainfont
4613 if {$phase eq "getcommits"} {
4614 $canv itemconf textitems -font $mainfont
4620 global sha1entry sha1string
4621 if {[string length $sha1string] == 40} {
4622 $sha1entry delete 0 end
4626 proc sha1change {n1 n2 op} {
4627 global sha1string currentid sha1but
4628 if {$sha1string == {}
4629 || ([info exists currentid] && $sha1string == $currentid)} {
4634 if {[$sha1but cget -state] == $state} return
4635 if {$state == "normal"} {
4636 $sha1but conf -state normal -relief raised -text "Goto: "
4638 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4642 proc gotocommit {} {
4643 global sha1string currentid commitrow tagids headids
4644 global displayorder numcommits curview
4646 if {$sha1string == {}
4647 || ([info exists currentid] && $sha1string == $currentid)} return
4648 if {[info exists tagids($sha1string)]} {
4649 set id $tagids($sha1string)
4650 } elseif {[info exists headids($sha1string)]} {
4651 set id $headids($sha1string)
4653 set id [string tolower $sha1string]
4654 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4656 foreach i $displayorder {
4657 if {[string match $id* $i]} {
4661 if {$matches ne {}} {
4662 if {[llength $matches] > 1} {
4663 error_popup "Short SHA1 id $id is ambiguous"
4666 set id [lindex $matches 0]
4670 if {[info exists commitrow($curview,$id)]} {
4671 selectline $commitrow($curview,$id) 1
4674 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4679 error_popup "$type $sha1string is not known"
4682 proc lineenter {x y id} {
4683 global hoverx hovery hoverid hovertimer
4684 global commitinfo canv
4686 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4690 if {[info exists hovertimer]} {
4691 after cancel $hovertimer
4693 set hovertimer [after 500 linehover]
4697 proc linemotion {x y id} {
4698 global hoverx hovery hoverid hovertimer
4700 if {[info exists hoverid] && $id == $hoverid} {
4703 if {[info exists hovertimer]} {
4704 after cancel $hovertimer
4706 set hovertimer [after 500 linehover]
4710 proc lineleave {id} {
4711 global hoverid hovertimer canv
4713 if {[info exists hoverid] && $id == $hoverid} {
4715 if {[info exists hovertimer]} {
4716 after cancel $hovertimer
4724 global hoverx hovery hoverid hovertimer
4725 global canv linespc lthickness
4726 global commitinfo mainfont
4728 set text [lindex $commitinfo($hoverid) 0]
4729 set ymax [lindex [$canv cget -scrollregion] 3]
4730 if {$ymax == {}} return
4731 set yfrac [lindex [$canv yview] 0]
4732 set x [expr {$hoverx + 2 * $linespc}]
4733 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4734 set x0 [expr {$x - 2 * $lthickness}]
4735 set y0 [expr {$y - 2 * $lthickness}]
4736 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4737 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4738 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4739 -fill \#ffff80 -outline black -width 1 -tags hover]
4741 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4746 proc clickisonarrow {id y} {
4749 set ranges [rowranges $id]
4750 set thresh [expr {2 * $lthickness + 6}]
4751 set n [expr {[llength $ranges] - 1}]
4752 for {set i 1} {$i < $n} {incr i} {
4753 set row [lindex $ranges $i]
4754 if {abs([yc $row] - $y) < $thresh} {
4761 proc arrowjump {id n y} {
4764 # 1 <-> 2, 3 <-> 4, etc...
4765 set n [expr {(($n - 1) ^ 1) + 1}]
4766 set row [lindex [rowranges $id] $n]
4768 set ymax [lindex [$canv cget -scrollregion] 3]
4769 if {$ymax eq {} || $ymax <= 0} return
4770 set view [$canv yview]
4771 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4772 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4776 allcanvs yview moveto $yfrac
4779 proc lineclick {x y id isnew} {
4780 global ctext commitinfo children canv thickerline curview
4782 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4787 # draw this line thicker than normal
4791 set ymax [lindex [$canv cget -scrollregion] 3]
4792 if {$ymax eq {}} return
4793 set yfrac [lindex [$canv yview] 0]
4794 set y [expr {$y + $yfrac * $ymax}]
4796 set dirn [clickisonarrow $id $y]
4798 arrowjump $id $dirn $y
4803 addtohistory [list lineclick $x $y $id 0]
4805 # fill the details pane with info about this line
4806 $ctext conf -state normal
4808 $ctext tag conf link -foreground blue -underline 1
4809 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4810 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4811 $ctext insert end "Parent:\t"
4812 $ctext insert end $id [list link link0]
4813 $ctext tag bind link0 <1> [list selbyid $id]
4814 set info $commitinfo($id)
4815 $ctext insert end "\n\t[lindex $info 0]\n"
4816 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4817 set date [formatdate [lindex $info 2]]
4818 $ctext insert end "\tDate:\t$date\n"
4819 set kids $children($curview,$id)
4821 $ctext insert end "\nChildren:"
4823 foreach child $kids {
4825 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4826 set info $commitinfo($child)
4827 $ctext insert end "\n\t"
4828 $ctext insert end $child [list link link$i]
4829 $ctext tag bind link$i <1> [list selbyid $child]
4830 $ctext insert end "\n\t[lindex $info 0]"
4831 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4832 set date [formatdate [lindex $info 2]]
4833 $ctext insert end "\n\tDate:\t$date\n"
4836 $ctext conf -state disabled
4840 proc normalline {} {
4842 if {[info exists thickerline]} {
4850 global commitrow curview
4851 if {[info exists commitrow($curview,$id)]} {
4852 selectline $commitrow($curview,$id) 1
4858 if {![info exists startmstime]} {
4859 set startmstime [clock clicks -milliseconds]
4861 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4864 proc rowmenu {x y id} {
4865 global rowctxmenu commitrow selectedline rowmenuid curview
4867 if {![info exists selectedline]
4868 || $commitrow($curview,$id) eq $selectedline} {
4873 $rowctxmenu entryconfigure 0 -state $state
4874 $rowctxmenu entryconfigure 1 -state $state
4875 $rowctxmenu entryconfigure 2 -state $state
4877 tk_popup $rowctxmenu $x $y
4880 proc diffvssel {dirn} {
4881 global rowmenuid selectedline displayorder
4883 if {![info exists selectedline]} return
4885 set oldid [lindex $displayorder $selectedline]
4886 set newid $rowmenuid
4888 set oldid $rowmenuid
4889 set newid [lindex $displayorder $selectedline]
4891 addtohistory [list doseldiff $oldid $newid]
4892 doseldiff $oldid $newid
4895 proc doseldiff {oldid newid} {
4899 $ctext conf -state normal
4902 $ctext insert end "From "
4903 $ctext tag conf link -foreground blue -underline 1
4904 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4905 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4906 $ctext tag bind link0 <1> [list selbyid $oldid]
4907 $ctext insert end $oldid [list link link0]
4908 $ctext insert end "\n "
4909 $ctext insert end [lindex $commitinfo($oldid) 0]
4910 $ctext insert end "\n\nTo "
4911 $ctext tag bind link1 <1> [list selbyid $newid]
4912 $ctext insert end $newid [list link link1]
4913 $ctext insert end "\n "
4914 $ctext insert end [lindex $commitinfo($newid) 0]
4915 $ctext insert end "\n"
4916 $ctext conf -state disabled
4917 $ctext tag delete Comments
4918 $ctext tag remove found 1.0 end
4919 startdiff [list $oldid $newid]
4923 global rowmenuid currentid commitinfo patchtop patchnum
4925 if {![info exists currentid]} return
4926 set oldid $currentid
4927 set oldhead [lindex $commitinfo($oldid) 0]
4928 set newid $rowmenuid
4929 set newhead [lindex $commitinfo($newid) 0]
4932 catch {destroy $top}
4934 label $top.title -text "Generate patch"
4935 grid $top.title - -pady 10
4936 label $top.from -text "From:"
4937 entry $top.fromsha1 -width 40 -relief flat
4938 $top.fromsha1 insert 0 $oldid
4939 $top.fromsha1 conf -state readonly
4940 grid $top.from $top.fromsha1 -sticky w
4941 entry $top.fromhead -width 60 -relief flat
4942 $top.fromhead insert 0 $oldhead
4943 $top.fromhead conf -state readonly
4944 grid x $top.fromhead -sticky w
4945 label $top.to -text "To:"
4946 entry $top.tosha1 -width 40 -relief flat
4947 $top.tosha1 insert 0 $newid
4948 $top.tosha1 conf -state readonly
4949 grid $top.to $top.tosha1 -sticky w
4950 entry $top.tohead -width 60 -relief flat
4951 $top.tohead insert 0 $newhead
4952 $top.tohead conf -state readonly
4953 grid x $top.tohead -sticky w
4954 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4955 grid $top.rev x -pady 10
4956 label $top.flab -text "Output file:"
4957 entry $top.fname -width 60
4958 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4960 grid $top.flab $top.fname -sticky w
4962 button $top.buts.gen -text "Generate" -command mkpatchgo
4963 button $top.buts.can -text "Cancel" -command mkpatchcan
4964 grid $top.buts.gen $top.buts.can
4965 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4966 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4967 grid $top.buts - -pady 10 -sticky ew
4971 proc mkpatchrev {} {
4974 set oldid [$patchtop.fromsha1 get]
4975 set oldhead [$patchtop.fromhead get]
4976 set newid [$patchtop.tosha1 get]
4977 set newhead [$patchtop.tohead get]
4978 foreach e [list fromsha1 fromhead tosha1 tohead] \
4979 v [list $newid $newhead $oldid $oldhead] {
4980 $patchtop.$e conf -state normal
4981 $patchtop.$e delete 0 end
4982 $patchtop.$e insert 0 $v
4983 $patchtop.$e conf -state readonly
4990 set oldid [$patchtop.fromsha1 get]
4991 set newid [$patchtop.tosha1 get]
4992 set fname [$patchtop.fname get]
4993 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4994 error_popup "Error creating patch: $err"
4996 catch {destroy $patchtop}
5000 proc mkpatchcan {} {
5003 catch {destroy $patchtop}
5008 global rowmenuid mktagtop commitinfo
5012 catch {destroy $top}
5014 label $top.title -text "Create tag"
5015 grid $top.title - -pady 10
5016 label $top.id -text "ID:"
5017 entry $top.sha1 -width 40 -relief flat
5018 $top.sha1 insert 0 $rowmenuid
5019 $top.sha1 conf -state readonly
5020 grid $top.id $top.sha1 -sticky w
5021 entry $top.head -width 60 -relief flat
5022 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5023 $top.head conf -state readonly
5024 grid x $top.head -sticky w
5025 label $top.tlab -text "Tag name:"
5026 entry $top.tag -width 60
5027 grid $top.tlab $top.tag -sticky w
5029 button $top.buts.gen -text "Create" -command mktaggo
5030 button $top.buts.can -text "Cancel" -command mktagcan
5031 grid $top.buts.gen $top.buts.can
5032 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5033 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5034 grid $top.buts - -pady 10 -sticky ew
5039 global mktagtop env tagids idtags
5041 set id [$mktagtop.sha1 get]
5042 set tag [$mktagtop.tag get]
5044 error_popup "No tag name specified"
5047 if {[info exists tagids($tag)]} {
5048 error_popup "Tag \"$tag\" already exists"
5053 set fname [file join $dir "refs/tags" $tag]
5054 set f [open $fname w]
5058 error_popup "Error creating tag: $err"
5062 set tagids($tag) $id
5063 lappend idtags($id) $tag
5067 proc redrawtags {id} {
5068 global canv linehtag commitrow idpos selectedline curview
5069 global mainfont canvxmax
5071 if {![info exists commitrow($curview,$id)]} return
5072 drawcmitrow $commitrow($curview,$id)
5073 $canv delete tag.$id
5074 set xt [eval drawtags $id $idpos($id)]
5075 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5076 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5077 set xr [expr {$xt + [font measure $mainfont $text]}]
5078 if {$xr > $canvxmax} {
5082 if {[info exists selectedline]
5083 && $selectedline == $commitrow($curview,$id)} {
5084 selectline $selectedline 0
5091 catch {destroy $mktagtop}
5100 proc writecommit {} {
5101 global rowmenuid wrcomtop commitinfo wrcomcmd
5103 set top .writecommit
5105 catch {destroy $top}
5107 label $top.title -text "Write commit to file"
5108 grid $top.title - -pady 10
5109 label $top.id -text "ID:"
5110 entry $top.sha1 -width 40 -relief flat
5111 $top.sha1 insert 0 $rowmenuid
5112 $top.sha1 conf -state readonly
5113 grid $top.id $top.sha1 -sticky w
5114 entry $top.head -width 60 -relief flat
5115 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5116 $top.head conf -state readonly
5117 grid x $top.head -sticky w
5118 label $top.clab -text "Command:"
5119 entry $top.cmd -width 60 -textvariable wrcomcmd
5120 grid $top.clab $top.cmd -sticky w -pady 10
5121 label $top.flab -text "Output file:"
5122 entry $top.fname -width 60
5123 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5124 grid $top.flab $top.fname -sticky w
5126 button $top.buts.gen -text "Write" -command wrcomgo
5127 button $top.buts.can -text "Cancel" -command wrcomcan
5128 grid $top.buts.gen $top.buts.can
5129 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5130 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5131 grid $top.buts - -pady 10 -sticky ew
5138 set id [$wrcomtop.sha1 get]
5139 set cmd "echo $id | [$wrcomtop.cmd get]"
5140 set fname [$wrcomtop.fname get]
5141 if {[catch {exec sh -c $cmd >$fname &} err]} {
5142 error_popup "Error writing commit: $err"
5144 catch {destroy $wrcomtop}
5151 catch {destroy $wrcomtop}
5156 global rowmenuid mkbrtop
5159 catch {destroy $top}
5161 label $top.title -text "Create new branch"
5162 grid $top.title - -pady 10
5163 label $top.id -text "ID:"
5164 entry $top.sha1 -width 40 -relief flat
5165 $top.sha1 insert 0 $rowmenuid
5166 $top.sha1 conf -state readonly
5167 grid $top.id $top.sha1 -sticky w
5168 label $top.nlab -text "Name:"
5169 entry $top.name -width 40
5170 grid $top.nlab $top.name -sticky w
5172 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5173 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5174 grid $top.buts.go $top.buts.can
5175 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5176 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5177 grid $top.buts - -pady 10 -sticky ew
5182 global headids idheads
5184 set name [$top.name get]
5185 set id [$top.sha1 get]
5187 error_popup "Please specify a name for the new branch"
5190 catch {destroy $top}
5194 exec git branch $name $id
5200 # XXX should update list of heads displayed for selected commit
5206 proc cherrypick {} {
5207 global rowmenuid curview commitrow
5208 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5210 if {[info exists desc_heads($rowmenuid)]
5211 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5212 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5213 included in branch $mainhead -- really re-apply it?"]
5218 set oldhead [exec git rev-parse HEAD]
5219 # Unfortunately git-cherry-pick writes stuff to stderr even when
5220 # no error occurs, and exec takes that as an indication of error...
5221 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5226 set newhead [exec git rev-parse HEAD]
5227 if {$newhead eq $oldhead} {
5229 error_popup "No changes committed"
5232 set allparents($newhead) $oldhead
5233 lappend allchildren($oldhead) $newhead
5234 set desc_heads($newhead) $mainhead
5235 if {[info exists anc_tags($oldhead)]} {
5236 set anc_tags($newhead) $anc_tags($oldhead)
5238 set desc_tags($newhead) {}
5239 if {[info exists commitrow($curview,$oldhead)]} {
5240 insertrow $commitrow($curview,$oldhead) $newhead
5241 if {$mainhead ne {}} {
5242 movedhead $newhead $mainhead
5250 # context menu for a head
5251 proc headmenu {x y id head} {
5252 global headmenuid headmenuhead headctxmenu
5255 set headmenuhead $head
5256 tk_popup $headctxmenu $x $y
5260 global headmenuid headmenuhead mainhead headids
5262 # check the tree is clean first??
5263 set oldmainhead $mainhead
5267 exec git checkout $headmenuhead
5273 set mainhead $headmenuhead
5274 if {[info exists headids($oldmainhead)]} {
5275 redrawtags $headids($oldmainhead)
5277 redrawtags $headmenuid
5282 global desc_heads headmenuid headmenuhead mainhead
5283 global headids idheads
5285 set head $headmenuhead
5287 if {$head eq $mainhead} {
5288 error_popup "Cannot delete the currently checked-out branch"
5291 if {$desc_heads($id) eq $head} {
5292 # the stuff on this branch isn't on any other branch
5293 if {![confirm_popup "The commits on branch $head aren't on any other\
5294 branch.\nReally delete branch $head?"]} return
5298 if {[catch {exec git branch -D $head} err]} {
5303 removedhead $id $head
5308 # Stuff for finding nearby tags
5309 proc getallcommits {} {
5310 global allcstart allcommits allcfd allids
5313 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5315 fconfigure $fd -blocking 0
5316 set allcommits "reading"
5321 proc discardallcommits {} {
5322 global allparents allchildren allcommits allcfd
5323 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5325 if {![info exists allcommits]} return
5326 if {$allcommits eq "reading"} {
5327 catch {close $allcfd}
5329 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5330 alldtags tagisdesc desc_heads} {
5335 proc restartgetall {fd} {
5338 fileevent $fd readable [list getallclines $fd]
5339 set allcstart [clock clicks -milliseconds]
5342 proc combine_dtags {l1 l2} {
5343 global tagisdesc notfirstd
5345 set res [lsort -unique [concat $l1 $l2]]
5346 for {set i 0} {$i < [llength $res]} {incr i} {
5347 set x [lindex $res $i]
5348 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5349 set y [lindex $res $j]
5350 if {[info exists tagisdesc($x,$y)]} {
5351 if {$tagisdesc($x,$y) > 0} {
5352 # x is a descendent of y, exclude x
5353 set res [lreplace $res $i $i]
5357 # y is a descendent of x, exclude y
5358 set res [lreplace $res $j $j]
5361 # no relation, keep going
5369 proc combine_atags {l1 l2} {
5372 set res [lsort -unique [concat $l1 $l2]]
5373 for {set i 0} {$i < [llength $res]} {incr i} {
5374 set x [lindex $res $i]
5375 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5376 set y [lindex $res $j]
5377 if {[info exists tagisdesc($x,$y)]} {
5378 if {$tagisdesc($x,$y) < 0} {
5379 # x is an ancestor of y, exclude x
5380 set res [lreplace $res $i $i]
5384 # y is an ancestor of x, exclude y
5385 set res [lreplace $res $j $j]
5388 # no relation, keep going
5396 proc forward_pass {id children} {
5397 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5401 foreach child $children {
5402 if {[info exists idtags($child)]} {
5403 set ctags [list $child]
5405 set ctags $desc_tags($child)
5409 } elseif {$ctags ne $dtags} {
5410 set dtags [combine_dtags $dtags $ctags]
5412 set cheads $desc_heads($child)
5413 if {$dheads eq {}} {
5415 } elseif {$cheads ne $dheads} {
5416 set dheads [lsort -unique [concat $dheads $cheads]]
5419 set desc_tags($id) $dtags
5420 if {[info exists idtags($id)]} {
5422 foreach tag $dtags {
5423 set adt [concat $adt $alldtags($tag)]
5425 set adt [lsort -unique $adt]
5426 set alldtags($id) $adt
5428 set tagisdesc($id,$tag) -1
5429 set tagisdesc($tag,$id) 1
5432 if {[info exists idheads($id)]} {
5433 set dheads [concat $dheads $idheads($id)]
5435 set desc_heads($id) $dheads
5438 proc getallclines {fd} {
5439 global allparents allchildren allcommits allcstart
5440 global desc_tags anc_tags idtags tagisdesc allids
5441 global idheads travindex
5443 while {[gets $fd line] >= 0} {
5444 set id [lindex $line 0]
5446 set olds [lrange $line 1 end]
5447 set allparents($id) $olds
5448 if {![info exists allchildren($id)]} {
5449 set allchildren($id) {}
5452 lappend allchildren($p) $id
5454 # compute nearest tagged descendents as we go
5455 # also compute descendent heads
5456 forward_pass $id $allchildren($id)
5457 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5458 fileevent $fd readable {}
5459 after idle restartgetall $fd
5464 set travindex [llength $allids]
5465 set allcommits "traversing"
5466 after idle restartatags
5467 if {[catch {close $fd} err]} {
5468 error_popup "Error reading full commit graph: $err.\n\
5469 Results may be incomplete."
5474 # walk backward through the tree and compute nearest tagged ancestors
5475 proc restartatags {} {
5476 global allids allparents idtags anc_tags travindex
5478 set t0 [clock clicks -milliseconds]
5480 while {[incr i -1] >= 0} {
5481 set id [lindex $allids $i]
5483 foreach p $allparents($id) {
5484 if {[info exists idtags($p)]} {
5487 set ptags $anc_tags($p)
5491 } elseif {$ptags ne $atags} {
5492 set atags [combine_atags $atags $ptags]
5495 set anc_tags($id) $atags
5496 if {[clock clicks -milliseconds] - $t0 >= 50} {
5498 after idle restartatags
5502 set allcommits "done"
5508 # update the desc_heads array for a new head just added
5509 proc addedhead {hid head} {
5510 global desc_heads allparents headids idheads
5512 set headids($head) $hid
5513 lappend idheads($hid) $head
5515 set todo [list $hid]
5516 while {$todo ne {}} {
5517 set do [lindex $todo 0]
5518 set todo [lrange $todo 1 end]
5519 if {![info exists desc_heads($do)] ||
5520 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5521 set oldheads $desc_heads($do)
5522 lappend desc_heads($do) $head
5523 set heads $desc_heads($do)
5525 set p $allparents($do)
5526 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5527 $desc_heads($p) ne $oldheads} break
5529 set desc_heads($do) $heads
5531 set todo [concat $todo $p]
5535 # update the desc_heads array for a head just removed
5536 proc removedhead {hid head} {
5537 global desc_heads allparents headids idheads
5539 unset headids($head)
5540 if {$idheads($hid) eq $head} {
5543 set i [lsearch -exact $idheads($hid) $head]
5545 set idheads($hid) [lreplace $idheads($hid) $i $i]
5549 set todo [list $hid]
5550 while {$todo ne {}} {
5551 set do [lindex $todo 0]
5552 set todo [lrange $todo 1 end]
5553 if {![info exists desc_heads($do)]} continue
5554 set i [lsearch -exact $desc_heads($do) $head]
5555 if {$i < 0} continue
5556 set oldheads $desc_heads($do)
5557 set heads [lreplace $desc_heads($do) $i $i]
5559 set desc_heads($do) $heads
5560 set p $allparents($do)
5561 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5562 $desc_heads($p) ne $oldheads} break
5565 set todo [concat $todo $p]
5569 # update things for a head moved to a child of its previous location
5570 proc movedhead {id name} {
5571 global headids idheads
5573 set oldid $headids($name)
5574 set headids($name) $id
5575 if {$idheads($oldid) eq $name} {
5576 unset idheads($oldid)
5578 set i [lsearch -exact $idheads($oldid) $name]
5580 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5583 lappend idheads($id) $name
5586 proc changedrefs {} {
5587 global desc_heads desc_tags anc_tags allcommits allids
5588 global allchildren allparents idtags travindex
5590 if {![info exists allcommits]} return
5591 catch {unset desc_heads}
5592 catch {unset desc_tags}
5593 catch {unset anc_tags}
5594 catch {unset alldtags}
5595 catch {unset tagisdesc}
5596 foreach id $allids {
5597 forward_pass $id $allchildren($id)
5599 if {$allcommits ne "reading"} {
5600 set travindex [llength $allids]
5601 if {$allcommits ne "traversing"} {
5602 set allcommits "traversing"
5603 after idle restartatags
5608 proc rereadrefs {} {
5609 global idtags idheads idotherrefs mainhead
5611 set refids [concat [array names idtags] \
5612 [array names idheads] [array names idotherrefs]]
5613 foreach id $refids {
5614 if {![info exists ref($id)]} {
5615 set ref($id) [listrefs $id]
5618 set oldmainhead $mainhead
5621 set refids [lsort -unique [concat $refids [array names idtags] \
5622 [array names idheads] [array names idotherrefs]]]
5623 foreach id $refids {
5624 set v [listrefs $id]
5625 if {![info exists ref($id)] || $ref($id) != $v ||
5626 ($id eq $oldmainhead && $id ne $mainhead) ||
5627 ($id eq $mainhead && $id ne $oldmainhead)} {
5633 proc listrefs {id} {
5634 global idtags idheads idotherrefs
5637 if {[info exists idtags($id)]} {
5641 if {[info exists idheads($id)]} {
5645 if {[info exists idotherrefs($id)]} {
5646 set z $idotherrefs($id)
5648 return [list $x $y $z]
5651 proc showtag {tag isnew} {
5652 global ctext tagcontents tagids linknum
5655 addtohistory [list showtag $tag 0]
5657 $ctext conf -state normal
5660 if {[info exists tagcontents($tag)]} {
5661 set text $tagcontents($tag)
5663 set text "Tag: $tag\nId: $tagids($tag)"
5665 appendwithlinks $text {}
5666 $ctext conf -state disabled
5677 global maxwidth maxgraphpct diffopts
5678 global oldprefs prefstop showneartags
5679 global bgcolor fgcolor ctext diffcolors
5683 if {[winfo exists $top]} {
5687 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5688 set oldprefs($v) [set $v]
5691 wm title $top "Gitk preferences"
5692 label $top.ldisp -text "Commit list display options"
5693 grid $top.ldisp - -sticky w -pady 10
5694 label $top.spacer -text " "
5695 label $top.maxwidthl -text "Maximum graph width (lines)" \
5697 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5698 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5699 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5701 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5702 grid x $top.maxpctl $top.maxpct -sticky w
5704 label $top.ddisp -text "Diff display options"
5705 grid $top.ddisp - -sticky w -pady 10
5706 label $top.diffoptl -text "Options for diff program" \
5708 entry $top.diffopt -width 20 -textvariable diffopts
5709 grid x $top.diffoptl $top.diffopt -sticky w
5711 label $top.ntag.l -text "Display nearby tags" -font optionfont
5712 checkbutton $top.ntag.b -variable showneartags
5713 pack $top.ntag.b $top.ntag.l -side left
5714 grid x $top.ntag -sticky w
5716 label $top.cdisp -text "Colors: press to choose"
5717 grid $top.cdisp - -sticky w -pady 10
5718 label $top.bg -padx 40 -relief sunk -background $bgcolor
5719 button $top.bgbut -text "Background" -font optionfont \
5720 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5721 grid x $top.bgbut $top.bg -sticky w
5722 label $top.fg -padx 40 -relief sunk -background $fgcolor
5723 button $top.fgbut -text "Foreground" -font optionfont \
5724 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5725 grid x $top.fgbut $top.fg -sticky w
5726 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5727 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5728 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5729 [list $ctext tag conf d0 -foreground]]
5730 grid x $top.diffoldbut $top.diffold -sticky w
5731 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5732 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5733 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5734 [list $ctext tag conf d1 -foreground]]
5735 grid x $top.diffnewbut $top.diffnew -sticky w
5736 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5737 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5738 -command [list choosecolor diffcolors 2 $top.hunksep \
5739 "diff hunk header" \
5740 [list $ctext tag conf hunksep -foreground]]
5741 grid x $top.hunksepbut $top.hunksep -sticky w
5744 button $top.buts.ok -text "OK" -command prefsok
5745 button $top.buts.can -text "Cancel" -command prefscan
5746 grid $top.buts.ok $top.buts.can
5747 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5748 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5749 grid $top.buts - - -pady 10 -sticky ew
5752 proc choosecolor {v vi w x cmd} {
5755 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5756 -title "Gitk: choose color for $x"]
5757 if {$c eq {}} return
5758 $w conf -background $c
5767 $w conf -background $c
5775 $w conf -foreground $c
5777 allcanvs itemconf text -fill $c
5778 $canv itemconf circle -outline $c
5782 global maxwidth maxgraphpct diffopts
5783 global oldprefs prefstop showneartags
5785 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5786 set $v $oldprefs($v)
5788 catch {destroy $prefstop}
5793 global maxwidth maxgraphpct
5794 global oldprefs prefstop showneartags
5796 catch {destroy $prefstop}
5798 if {$maxwidth != $oldprefs(maxwidth)
5799 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5801 } elseif {$showneartags != $oldprefs(showneartags)} {
5806 proc formatdate {d} {
5807 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5810 # This list of encoding names and aliases is distilled from
5811 # http://www.iana.org/assignments/character-sets.
5812 # Not all of them are supported by Tcl.
5813 set encoding_aliases {
5814 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5815 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5816 { ISO-10646-UTF-1 csISO10646UTF1 }
5817 { ISO_646.basic:1983 ref csISO646basic1983 }
5818 { INVARIANT csINVARIANT }
5819 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5820 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5821 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5822 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5823 { NATS-DANO iso-ir-9-1 csNATSDANO }
5824 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5825 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5826 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5827 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5828 { ISO-2022-KR csISO2022KR }
5830 { ISO-2022-JP csISO2022JP }
5831 { ISO-2022-JP-2 csISO2022JP2 }
5832 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5834 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5835 { IT iso-ir-15 ISO646-IT csISO15Italian }
5836 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5837 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5838 { greek7-old iso-ir-18 csISO18Greek7Old }
5839 { latin-greek iso-ir-19 csISO19LatinGreek }
5840 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5841 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5842 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5843 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5844 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5845 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5846 { INIS iso-ir-49 csISO49INIS }
5847 { INIS-8 iso-ir-50 csISO50INIS8 }
5848 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5849 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5850 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5851 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5852 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5853 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5855 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5856 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5857 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5858 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5859 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5860 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5861 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5862 { greek7 iso-ir-88 csISO88Greek7 }
5863 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5864 { iso-ir-90 csISO90 }
5865 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5866 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5867 csISO92JISC62991984b }
5868 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5869 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5870 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5871 csISO95JIS62291984handadd }
5872 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5873 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5874 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5875 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5877 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5878 { T.61-7bit iso-ir-102 csISO102T617bit }
5879 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5880 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5881 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5882 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5883 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5884 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5885 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5886 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5887 arabic csISOLatinArabic }
5888 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5889 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5890 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5891 greek greek8 csISOLatinGreek }
5892 { T.101-G2 iso-ir-128 csISO128T101G2 }
5893 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5895 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5896 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5897 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5898 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5899 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5900 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5901 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5902 csISOLatinCyrillic }
5903 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5904 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5905 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5906 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5907 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5908 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5909 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5910 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5911 { ISO_10367-box iso-ir-155 csISO10367Box }
5912 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5913 { latin-lap lap iso-ir-158 csISO158Lap }
5914 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5915 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5918 { JIS_X0201 X0201 csHalfWidthKatakana }
5919 { KSC5636 ISO646-KR csKSC5636 }
5920 { ISO-10646-UCS-2 csUnicode }
5921 { ISO-10646-UCS-4 csUCS4 }
5922 { DEC-MCS dec csDECMCS }
5923 { hp-roman8 roman8 r8 csHPRoman8 }
5924 { macintosh mac csMacintosh }
5925 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5927 { IBM038 EBCDIC-INT cp038 csIBM038 }
5928 { IBM273 CP273 csIBM273 }
5929 { IBM274 EBCDIC-BE CP274 csIBM274 }
5930 { IBM275 EBCDIC-BR cp275 csIBM275 }
5931 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5932 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5933 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5934 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5935 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5936 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5937 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5938 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5939 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5940 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5941 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5942 { IBM437 cp437 437 csPC8CodePage437 }
5943 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5944 { IBM775 cp775 csPC775Baltic }
5945 { IBM850 cp850 850 csPC850Multilingual }
5946 { IBM851 cp851 851 csIBM851 }
5947 { IBM852 cp852 852 csPCp852 }
5948 { IBM855 cp855 855 csIBM855 }
5949 { IBM857 cp857 857 csIBM857 }
5950 { IBM860 cp860 860 csIBM860 }
5951 { IBM861 cp861 861 cp-is csIBM861 }
5952 { IBM862 cp862 862 csPC862LatinHebrew }
5953 { IBM863 cp863 863 csIBM863 }
5954 { IBM864 cp864 csIBM864 }
5955 { IBM865 cp865 865 csIBM865 }
5956 { IBM866 cp866 866 csIBM866 }
5957 { IBM868 CP868 cp-ar csIBM868 }
5958 { IBM869 cp869 869 cp-gr csIBM869 }
5959 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5960 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5961 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5962 { IBM891 cp891 csIBM891 }
5963 { IBM903 cp903 csIBM903 }
5964 { IBM904 cp904 904 csIBBM904 }
5965 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5966 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5967 { IBM1026 CP1026 csIBM1026 }
5968 { EBCDIC-AT-DE csIBMEBCDICATDE }
5969 { EBCDIC-AT-DE-A csEBCDICATDEA }
5970 { EBCDIC-CA-FR csEBCDICCAFR }
5971 { EBCDIC-DK-NO csEBCDICDKNO }
5972 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5973 { EBCDIC-FI-SE csEBCDICFISE }
5974 { EBCDIC-FI-SE-A csEBCDICFISEA }
5975 { EBCDIC-FR csEBCDICFR }
5976 { EBCDIC-IT csEBCDICIT }
5977 { EBCDIC-PT csEBCDICPT }
5978 { EBCDIC-ES csEBCDICES }
5979 { EBCDIC-ES-A csEBCDICESA }
5980 { EBCDIC-ES-S csEBCDICESS }
5981 { EBCDIC-UK csEBCDICUK }
5982 { EBCDIC-US csEBCDICUS }
5983 { UNKNOWN-8BIT csUnknown8BiT }
5984 { MNEMONIC csMnemonic }
5989 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5990 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5991 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5992 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5993 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5994 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5995 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5996 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5997 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5998 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5999 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6000 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6001 { IBM1047 IBM-1047 }
6002 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6003 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6004 { UNICODE-1-1 csUnicode11 }
6007 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6008 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6010 { ISO-8859-15 ISO_8859-15 Latin-9 }
6011 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6012 { GBK CP936 MS936 windows-936 }
6013 { JIS_Encoding csJISEncoding }
6014 { Shift_JIS MS_Kanji csShiftJIS }
6015 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6017 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6018 { ISO-10646-UCS-Basic csUnicodeASCII }
6019 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6020 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6021 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6022 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6023 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6024 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6025 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6026 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6027 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6028 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6029 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6030 { Ventura-US csVenturaUS }
6031 { Ventura-International csVenturaInternational }
6032 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6033 { PC8-Turkish csPC8Turkish }
6034 { IBM-Symbols csIBMSymbols }
6035 { IBM-Thai csIBMThai }
6036 { HP-Legal csHPLegal }
6037 { HP-Pi-font csHPPiFont }
6038 { HP-Math8 csHPMath8 }
6039 { Adobe-Symbol-Encoding csHPPSMath }
6040 { HP-DeskTop csHPDesktop }
6041 { Ventura-Math csVenturaMath }
6042 { Microsoft-Publishing csMicrosoftPublishing }
6043 { Windows-31J csWindows31J }
6048 proc tcl_encoding {enc} {
6049 global encoding_aliases
6050 set names [encoding names]
6051 set lcnames [string tolower $names]
6052 set enc [string tolower $enc]
6053 set i [lsearch -exact $lcnames $enc]
6055 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6056 if {[regsub {^iso[-_]} $enc iso encx]} {
6057 set i [lsearch -exact $lcnames $encx]
6061 foreach l $encoding_aliases {
6062 set ll [string tolower $l]
6063 if {[lsearch -exact $ll $enc] < 0} continue
6064 # look through the aliases for one that tcl knows about
6066 set i [lsearch -exact $lcnames $e]
6068 if {[regsub {^iso[-_]} $e iso ex]} {
6069 set i [lsearch -exact $lcnames $ex]
6078 return [lindex $names $i]
6085 set diffopts "-U 5 -p"
6086 set wrcomcmd "git diff-tree --stdin -p --pretty"
6090 set gitencoding [exec git repo-config --get i18n.commitencoding]
6092 if {$gitencoding == ""} {
6093 set gitencoding "utf-8"
6095 set tclencoding [tcl_encoding $gitencoding]
6096 if {$tclencoding == {}} {
6097 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6100 set mainfont {Helvetica 9}
6101 set textfont {Courier 9}
6102 set uifont {Helvetica 9 bold}
6103 set findmergefiles 0
6111 set cmitmode "patch"
6112 set wrapcomment "none"
6115 set colors {green red blue magenta darkgrey brown orange}
6118 set diffcolors {red "#00a000" blue}
6120 catch {source ~/.gitk}
6122 font create optionfont -family sans-serif -size -12
6126 switch -regexp -- $arg {
6128 "^-d" { set datemode 1 }
6130 lappend revtreeargs $arg
6135 # check that we can find a .git directory somewhere...
6137 if {![file isdirectory $gitdir]} {
6138 show_error {} . "Cannot find the git directory \"$gitdir\"."
6142 set cmdline_files {}
6143 set i [lsearch -exact $revtreeargs "--"]
6145 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6146 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6147 } elseif {$revtreeargs ne {}} {
6149 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6150 set cmdline_files [split $f "\n"]
6151 set n [llength $cmdline_files]
6152 set revtreeargs [lrange $revtreeargs 0 end-$n]
6154 # unfortunately we get both stdout and stderr in $err,
6155 # so look for "fatal:".
6156 set i [string first "fatal:" $err]
6158 set err [string range $err [expr {$i + 6}] end]
6160 show_error {} . "Bad arguments to gitk:\n$err"
6169 set highlight_paths {}
6170 set searchdirn -forwards
6179 set selectedhlview None
6192 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6193 # create a view for the files/dirs specified on the command line
6197 set viewname(1) "Command line"
6198 set viewfiles(1) $cmdline_files
6199 set viewargs(1) $revtreeargs
6202 .bar.view entryconf 2 -state normal
6203 .bar.view entryconf 3 -state normal
6206 if {[info exists permviews]} {
6207 foreach v $permviews {
6210 set viewname($n) [lindex $v 0]
6211 set viewfiles($n) [lindex $v 1]
6212 set viewargs($n) [lindex $v 2]