2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 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 parse_args
{rargs
} {
23 set parse_args
[concat
--default HEAD
$rargs]
24 set parsed_args
[split [eval exec git-rev-parse
$parse_args] "\n"]
26 # if git-rev-parse failed for some reason...
30 set parsed_args
$rargs
35 proc start_rev_list
{rlargs
} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
39 set startmsecs
[clock clicks
-milliseconds]
40 set nextupdate
[expr {$startmsecs + 100}]
43 set order
"--topo-order"
45 set order
"--date-order"
48 set commfd
[open
[concat | git-rev-list
--header $order \
49 --parents --boundary $rlargs] r
]
51 puts stderr
"Error executing git-rev-list: $err"
55 fconfigure
$commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure
$commfd -encoding $tclencoding
59 fileevent
$commfd readable
[list getcommitlines
$commfd]
60 . config
-cursor watch
64 proc getcommits
{rargs
} {
65 global phase canv mainfont
68 start_rev_list
[parse_args
$rargs]
70 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
71 -font $mainfont -tags textitems
74 proc getcommitlines
{commfd
} {
75 global commitlisted nextupdate
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
80 set stuff
[read $commfd]
82 if {![eof
$commfd]} return
83 # set it blocking so we wait for the process to terminate
84 fconfigure
$commfd -blocking 1
85 if {![catch
{close
$commfd} err
]} {
86 after idle finishcommits
89 if {[string range
$err 0 4] == "usage"} {
91 "Gitk: error reading commits: bad arguments to git-rev-list.\
92 (Note: arguments to gitk are passed to git-rev-list\
93 to allow selection of commits to be displayed.)"
95 set err
"Error reading commits: $err"
103 set i
[string first
"\0" $stuff $start]
105 append leftover
[string range
$stuff $start end
]
110 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
113 set cmit
[string range
$stuff $start [expr {$i - 1}]]
115 set start
[expr {$i + 1}]
116 set j
[string first
"\n" $cmit]
120 set ids
[string range
$cmit 0 [expr {$j - 1}]]
121 if {[string range
$ids 0 0] == "-"} {
123 set ids
[string range
$ids 1 end
]
127 if {[string length
$id] != 40} {
135 if {[string length
$shortcmit] > 80} {
136 set shortcmit
"[string range $shortcmit 0 80]..."
138 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
141 set id
[lindex
$ids 0]
143 set olds
[lrange
$ids 1 end
]
144 if {[llength
$olds] > 1} {
145 set olds
[lsort
-unique $olds]
148 lappend children
($p) $id
153 lappend parentlist
$olds
154 if {[info exists children
($id)]} {
155 lappend childlist
$children($id)
159 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
160 set commitrow
($id) $commitidx
162 lappend displayorder
$id
163 lappend commitlisted
$listed
169 if {[clock clicks
-milliseconds] >= $nextupdate} {
174 proc doupdate
{reading
} {
175 global commfd nextupdate numcommits ncmupdate
178 fileevent
$commfd readable
{}
181 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
182 if {$numcommits < 100} {
183 set ncmupdate
[expr {$numcommits + 1}]
184 } elseif
{$numcommits < 10000} {
185 set ncmupdate
[expr {$numcommits + 10}]
187 set ncmupdate
[expr {$numcommits + 100}]
190 fileevent
$commfd readable
[list getcommitlines
$commfd]
194 proc readcommit
{id
} {
195 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
196 parsecommit
$id $contents 0
199 proc updatecommits
{rargs
} {
201 foreach v
{colormap selectedline matchinglines treediffs
202 mergefilelist currentid rowtextx commitrow
203 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
204 linesegends crossings cornercrossings
} {
213 proc parsecommit
{id contents listed
} {
214 global commitinfo cdate
223 set hdrend
[string first
"\n\n" $contents]
225 # should never happen...
226 set hdrend
[string length
$contents]
228 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
229 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
230 foreach line
[split $header "\n"] {
231 set tag
[lindex
$line 0]
232 if {$tag == "author"} {
233 set audate
[lindex
$line end-1
]
234 set auname
[lrange
$line 1 end-2
]
235 } elseif
{$tag == "committer"} {
236 set comdate
[lindex
$line end-1
]
237 set comname
[lrange
$line 1 end-2
]
241 # take the first line of the comment as the headline
242 set i
[string first
"\n" $comment]
244 set headline
[string trim
[string range
$comment 0 $i]]
246 set headline
$comment
249 # git-rev-list indents the comment by 4 spaces;
250 # if we got this via git-cat-file, add the indentation
252 foreach line
[split $comment "\n"] {
253 append newcomment
" "
254 append newcomment
$line
255 append newcomment
"\n"
257 set comment
$newcomment
259 if {$comdate != {}} {
260 set cdate
($id) $comdate
262 set commitinfo
($id) [list
$headline $auname $audate \
263 $comname $comdate $comment]
266 proc getcommit
{id
} {
267 global commitdata commitinfo
269 if {[info exists commitdata
($id)]} {
270 parsecommit
$id $commitdata($id) 1
273 if {![info exists commitinfo
($id)]} {
274 set commitinfo
($id) {"No commit information available"}
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
284 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
287 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
288 while {0 <= [set n
[gets
$refd line
]]} {
289 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
293 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
297 if {$type == "tags"} {
298 set tagids
($name) $id
299 lappend idtags
($id) $name
304 set commit
[exec git-rev-parse
"$id^0"]
305 if {"$commit" != "$id"} {
306 set tagids
($name) $commit
307 lappend idtags
($commit) $name
311 set tagcontents
($name) [exec git-cat-file tag
"$id"]
313 } elseif
{ $type == "heads" } {
314 set headids
($name) $id
315 lappend idheads
($id) $name
317 set otherrefids
($name) $id
318 lappend idotherrefs
($id) $name
324 proc error_popup msg
{
328 message
$w.m
-text $msg -justify center
-aspect 400
329 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
330 button
$w.ok
-text OK
-command "destroy $w"
331 pack
$w.ok
-side bottom
-fill x
332 bind $w <Visibility
> "grab $w; focus $w"
333 bind $w <Key-Return
> "destroy $w"
337 proc makewindow
{rargs
} {
338 global canv canv2 canv3 linespc charspc ctext cflist textfont
339 global findtype findtypemenu findloc findstring fstring geometry
340 global entries sha1entry sha1string sha1but
341 global maincursor textcursor curtextcursor
342 global rowctxmenu mergemax
345 .bar add cascade
-label "File" -menu .bar.
file
347 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
348 .bar.
file add
command -label "Reread references" -command rereadrefs
349 .bar.
file add
command -label "Quit" -command doquit
351 .bar add cascade
-label "Edit" -menu .bar.edit
352 .bar.edit add
command -label "Preferences" -command doprefs
354 .bar add cascade
-label "Help" -menu .bar.
help
355 .bar.
help add
command -label "About gitk" -command about
356 . configure
-menu .bar
358 if {![info exists geometry
(canv1
)]} {
359 set geometry
(canv1
) [expr {45 * $charspc}]
360 set geometry
(canv2
) [expr {30 * $charspc}]
361 set geometry
(canv3
) [expr {15 * $charspc}]
362 set geometry
(canvh
) [expr {25 * $linespc + 4}]
363 set geometry
(ctextw
) 80
364 set geometry
(ctexth
) 30
365 set geometry
(cflistw
) 30
367 panedwindow .ctop
-orient vertical
368 if {[info exists geometry
(width
)]} {
369 .ctop conf
-width $geometry(width
) -height $geometry(height
)
370 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
371 set geometry
(ctexth
) [expr {($texth - 8) /
372 [font metrics
$textfont -linespace]}]
376 pack .ctop.top.bar
-side bottom
-fill x
377 set cscroll .ctop.top.csb
378 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
379 pack
$cscroll -side right
-fill y
380 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
381 pack .ctop.top.clist
-side top
-fill both
-expand 1
383 set canv .ctop.top.clist.canv
384 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
386 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
387 .ctop.top.clist add
$canv
388 set canv2 .ctop.top.clist.canv2
389 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
390 -bg white
-bd 0 -yscrollincr $linespc
391 .ctop.top.clist add
$canv2
392 set canv3 .ctop.top.clist.canv3
393 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
394 -bg white
-bd 0 -yscrollincr $linespc
395 .ctop.top.clist add
$canv3
396 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
398 set sha1entry .ctop.top.bar.sha1
399 set entries
$sha1entry
400 set sha1but .ctop.top.bar.sha1label
401 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
402 -command gotocommit
-width 8
403 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
404 pack .ctop.top.bar.sha1label
-side left
405 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
406 trace add variable sha1string
write sha1change
407 pack
$sha1entry -side left
-pady 2
409 image create bitmap bm-left
-data {
410 #define left_width 16
411 #define left_height 16
412 static unsigned char left_bits
[] = {
413 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
414 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
415 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
417 image create bitmap bm-right
-data {
418 #define right_width 16
419 #define right_height 16
420 static unsigned char right_bits
[] = {
421 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
422 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
423 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
425 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
426 -state disabled
-width 26
427 pack .ctop.top.bar.leftbut
-side left
-fill y
428 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
429 -state disabled
-width 26
430 pack .ctop.top.bar.rightbut
-side left
-fill y
432 button .ctop.top.bar.findbut
-text "Find" -command dofind
433 pack .ctop.top.bar.findbut
-side left
435 set fstring .ctop.top.bar.findstring
436 lappend entries
$fstring
437 entry
$fstring -width 30 -font $textfont -textvariable findstring
438 pack
$fstring -side left
-expand 1 -fill x
440 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
441 findtype Exact IgnCase Regexp
]
442 set findloc
"All fields"
443 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
444 Comments Author Committer Files Pickaxe
445 pack .ctop.top.bar.findloc
-side right
446 pack .ctop.top.bar.findtype
-side right
447 # for making sure type==Exact whenever loc==Pickaxe
448 trace add variable findloc
write findlocchange
450 panedwindow .ctop.cdet
-orient horizontal
452 frame .ctop.cdet.left
453 set ctext .ctop.cdet.left.ctext
454 text
$ctext -bg white
-state disabled
-font $textfont \
455 -width $geometry(ctextw
) -height $geometry(ctexth
) \
456 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
457 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
458 pack .ctop.cdet.left.sb
-side right
-fill y
459 pack
$ctext -side left
-fill both
-expand 1
460 .ctop.cdet add .ctop.cdet.left
462 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
463 $ctext tag conf hunksep
-fore blue
464 $ctext tag conf d0
-fore red
465 $ctext tag conf d1
-fore "#00a000"
466 $ctext tag conf m0
-fore red
467 $ctext tag conf m1
-fore blue
468 $ctext tag conf m2
-fore green
469 $ctext tag conf m3
-fore purple
470 $ctext tag conf
m4 -fore brown
471 $ctext tag conf m5
-fore "#009090"
472 $ctext tag conf m6
-fore magenta
473 $ctext tag conf m7
-fore "#808000"
474 $ctext tag conf m8
-fore "#009000"
475 $ctext tag conf m9
-fore "#ff0080"
476 $ctext tag conf m10
-fore cyan
477 $ctext tag conf m11
-fore "#b07070"
478 $ctext tag conf m12
-fore "#70b0f0"
479 $ctext tag conf m13
-fore "#70f0b0"
480 $ctext tag conf m14
-fore "#f0b070"
481 $ctext tag conf m15
-fore "#ff70b0"
482 $ctext tag conf mmax
-fore darkgrey
484 $ctext tag conf mresult
-font [concat
$textfont bold
]
485 $ctext tag conf msep
-font [concat
$textfont bold
]
486 $ctext tag conf found
-back yellow
488 frame .ctop.cdet.right
489 set cflist .ctop.cdet.right.cfiles
490 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
491 -yscrollcommand ".ctop.cdet.right.sb set"
492 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
493 pack .ctop.cdet.right.sb
-side right
-fill y
494 pack
$cflist -side left
-fill both
-expand 1
495 .ctop.cdet add .ctop.cdet.right
496 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
498 pack .ctop
-side top
-fill both
-expand 1
500 bindall
<1> {selcanvline
%W
%x
%y
}
501 #bindall <B1-Motion> {selcanvline %W %x %y}
502 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
503 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
504 bindall
<2> "canvscan mark %W %x %y"
505 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
506 bind .
<Key-Up
> "selnextline -1"
507 bind .
<Key-Down
> "selnextline 1"
508 bind .
<Key-Right
> "goforw"
509 bind .
<Key-Left
> "goback"
510 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
511 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
512 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
513 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
514 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
515 bindkey p
"selnextline -1"
516 bindkey n
"selnextline 1"
519 bindkey i
"selnextline -1"
520 bindkey k
"selnextline 1"
523 bindkey b
"$ctext yview scroll -1 pages"
524 bindkey d
"$ctext yview scroll 18 units"
525 bindkey u
"$ctext yview scroll -18 units"
526 bindkey
/ {findnext
1}
527 bindkey
<Key-Return
> {findnext
0}
530 bind .
<Control-q
> doquit
531 bind .
<Control-f
> dofind
532 bind .
<Control-g
> {findnext
0}
533 bind .
<Control-r
> findprev
534 bind .
<Control-equal
> {incrfont
1}
535 bind .
<Control-KP_Add
> {incrfont
1}
536 bind .
<Control-minus
> {incrfont
-1}
537 bind .
<Control-KP_Subtract
> {incrfont
-1}
538 bind $cflist <<ListboxSelect>> listboxsel
539 bind . <Destroy> {savestuff %W}
540 bind . <Button-1> "click %W"
541 bind $fstring <Key-Return> dofind
542 bind $sha1entry <Key-Return> gotocommit
543 bind $sha1entry <<PasteSelection>> clearsha1
545 set maincursor [. cget -cursor]
546 set textcursor [$ctext cget -cursor]
547 set curtextcursor $textcursor
549 set rowctxmenu .rowctxmenu
550 menu $rowctxmenu -tearoff 0
551 $rowctxmenu add command -label "Diff this -> selected" \
552 -command {diffvssel 0}
553 $rowctxmenu add command -label "Diff selected -> this" \
554 -command {diffvssel 1}
555 $rowctxmenu add command -label "Make patch" -command mkpatch
556 $rowctxmenu add command -label "Create tag" -command mktag
557 $rowctxmenu add command -label "Write commit to file" -command writecommit
560 # mouse-2 makes all windows scan vertically, but only the one
561 # the cursor is in scans horizontally
562 proc canvscan {op w x y} {
563 global canv canv2 canv3
564 foreach c [list $canv $canv2 $canv3] {
573 proc scrollcanv {cscroll f0 f1} {
578 # when we make a key binding for the toplevel, make sure
579 # it doesn't get triggered when that key is pressed in the
580 # find string entry widget.
581 proc bindkey {ev script} {
584 set escript [bind Entry $ev]
585 if {$escript == {}} {
586 set escript [bind Entry <Key>]
589 bind $e $ev "$escript; break"
593 # set the focus back to the toplevel for any click outside
604 global canv canv2 canv3 ctext cflist mainfont textfont
605 global stuffsaved findmergefiles maxgraphpct
608 if {$stuffsaved} return
609 if {![winfo viewable .]} return
611 set f [open "~/.gitk-new" w]
612 puts $f [list set mainfont $mainfont]
613 puts $f [list set textfont $textfont]
614 puts $f [list set findmergefiles $findmergefiles]
615 puts $f [list set maxgraphpct $maxgraphpct]
616 puts $f [list set maxwidth $maxwidth]
617 puts $f "set geometry(width) [winfo width .ctop]"
618 puts $f "set geometry(height) [winfo height .ctop]"
619 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
620 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
621 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
622 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
623 set wid [expr {([winfo width $ctext] - 8) \
624 / [font measure $textfont "0"]}]
625 puts $f "set geometry(ctextw) $wid"
626 set wid [expr {([winfo width $cflist] - 11) \
627 / [font measure [$cflist cget -font] "0"]}]
628 puts $f "set geometry(cflistw) $wid"
630 file rename -force "~/.gitk-new" "~/.gitk"
635 proc resizeclistpanes {win w} {
637 if {[info exists oldwidth($win)]} {
638 set s0 [$win sash coord 0]
639 set s1 [$win sash coord 1]
641 set sash0 [expr {int($w/2 - 2)}]
642 set sash1 [expr {int($w*5/6 - 2)}]
644 set factor [expr {1.0 * $w / $oldwidth($win)}]
645 set sash0 [expr {int($factor * [lindex $s0 0])}]
646 set sash1 [expr {int($factor * [lindex $s1 0])}]
650 if {$sash1 < $sash0 + 20} {
651 set sash1 [expr {$sash0 + 20}]
653 if {$sash1 > $w - 10} {
654 set sash1 [expr {$w - 10}]
655 if {$sash0 > $sash1 - 20} {
656 set sash0 [expr {$sash1 - 20}]
660 $win sash place 0 $sash0 [lindex $s0 1]
661 $win sash place 1 $sash1 [lindex $s1 1]
663 set oldwidth($win) $w
666 proc resizecdetpanes {win w} {
668 if {[info exists oldwidth($win)]} {
669 set s0 [$win sash coord 0]
671 set sash0 [expr {int($w*3/4 - 2)}]
673 set factor [expr {1.0 * $w / $oldwidth($win)}]
674 set sash0 [expr {int($factor * [lindex $s0 0])}]
678 if {$sash0 > $w - 15} {
679 set sash0 [expr {$w - 15}]
682 $win sash place 0 $sash0 [lindex $s0 1]
684 set oldwidth($win) $w
688 global canv canv2 canv3
694 proc bindall {event action} {
695 global canv canv2 canv3
696 bind $canv $event $action
697 bind $canv2 $event $action
698 bind $canv3 $event $action
703 if {[winfo exists $w]} {
708 wm title $w "About gitk"
710 Gitk - a commit viewer for git
712 Copyright © 2005-2006 Paul Mackerras
714 Use and redistribute under the terms of the GNU General Public License} \
715 -justify center -aspect 400
716 pack $w.m -side top -fill x -padx 20 -pady 20
717 button $w.ok -text Close -command "destroy $w"
718 pack $w.ok -side bottom
721 proc shortids {ids} {
724 if {[llength $id] > 1} {
725 lappend res [shortids $id]
726 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
727 lappend res [string range $id 0 7]
735 proc incrange {l x o} {
740 lset l $x [expr {$e + $o}]
749 for {} {$n > 0} {incr n -1} {
755 proc usedinrange {id l1 l2} {
756 global children commitrow
758 if {[info exists commitrow($id)]} {
759 set r $commitrow($id)
760 if {$l1 <= $r && $r <= $l2} {
761 return [expr {$r - $l1 + 1}]
764 foreach c $children($id) {
765 if {[info exists commitrow($c)]} {
767 if {$l1 <= $r && $r <= $l2} {
768 return [expr {$r - $l1 + 1}]
775 proc sanity {row {full 0}} {
776 global rowidlist rowoffsets
779 set ids [lindex $rowidlist $row]
782 if {$id eq {}} continue
783 if {$col < [llength $ids] - 1 &&
784 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
785 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
787 set o [lindex $rowoffsets $row $col]
793 if {[lindex $rowidlist $y $x] != $id} {
794 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
795 puts " id=[shortids $id] check started at row $row"
796 for {set i $row} {$i >= $y} {incr i -1} {
797 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
802 set o [lindex $rowoffsets $y $x]
807 proc makeuparrow {oid x y z} {
808 global rowidlist rowoffsets uparrowlen idrowranges
810 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
813 set off0 [lindex $rowoffsets $y]
814 for {set x0 $x} {1} {incr x0} {
815 if {$x0 >= [llength $off0]} {
816 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
819 set z [lindex $off0 $x0]
825 set z [expr {$x0 - $x}]
826 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
827 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
829 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
830 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
831 lappend idrowranges($oid) $y
835 global rowidlist rowoffsets displayorder commitlisted
836 global rowlaidout rowoptim
837 global idinlist rowchk
838 global commitidx numcommits canvxmax canv
840 global parentlist childlist children
848 catch {unset children}
852 catch {unset idinlist}
856 set canvxmax [$canv cget -width]
859 proc setcanvscroll {} {
860 global canv canv2 canv3 numcommits linespc canvxmax canvy0
862 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
863 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
864 $canv2 conf -scrollregion [list 0 0 0 $ymax]
865 $canv3 conf -scrollregion [list 0 0 0 $ymax]
868 proc visiblerows {} {
869 global canv numcommits linespc
871 set ymax [lindex [$canv cget -scrollregion] 3]
872 if {$ymax eq {} || $ymax == 0} return
874 set y0 [expr {int([lindex $f 0] * $ymax)}]
875 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
879 set y1 [expr {int([lindex $f 1] * $ymax)}]
880 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
881 if {$r1 >= $numcommits} {
882 set r1 [expr {$numcommits - 1}]
884 return [list $r0 $r1]
888 global rowlaidout rowoptim commitidx numcommits optim_delay
892 set rowlaidout [layoutrows $row $commitidx 0]
893 set orow [expr {$rowlaidout - $uparrowlen - 1}]
894 if {$orow > $rowoptim} {
895 checkcrossings $rowoptim $orow
896 optimize_rows $rowoptim 0 $orow
899 set canshow [expr {$rowoptim - $optim_delay}]
900 if {$canshow > $numcommits} {
905 proc showstuff {canshow} {
907 global linesegends idrowranges idrangedrawn
909 if {$numcommits == 0} {
915 set numcommits $canshow
917 set rows [visiblerows]
918 set r0 [lindex $rows 0]
919 set r1 [lindex $rows 1]
920 for {set r $row} {$r < $canshow} {incr r} {
921 if {[info exists linesegends($r)]} {
922 foreach id $linesegends($r) {
924 foreach {s e} $idrowranges($id) {
926 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
927 && ![info exists idrangedrawn($id,$i)]} {
929 set idrangedrawn($id,$i) 1
935 if {$canshow > $r1} {
938 while {$row < $canshow} {
944 proc layoutrows {row endrow last} {
945 global rowidlist rowoffsets displayorder
946 global uparrowlen downarrowlen maxwidth mingaplen
947 global childlist parentlist
948 global idrowranges linesegends
950 global idinlist rowchk
952 set idlist [lindex $rowidlist $row]
953 set offs [lindex $rowoffsets $row]
954 while {$row < $endrow} {
955 set id [lindex $displayorder $row]
958 foreach p [lindex $parentlist $row] {
959 if {![info exists idinlist($p)]} {
961 } elseif {!$idinlist($p)} {
965 set nev [expr {[llength $idlist] + [llength $newolds]
966 + [llength $oldolds] - $maxwidth + 1}]
968 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
969 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
970 set i [lindex $idlist $x]
971 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
972 set r [usedinrange $i [expr {$row - $downarrowlen}] \
973 [expr {$row + $uparrowlen + $mingaplen}]]
975 set idlist [lreplace $idlist $x $x]
976 set offs [lreplace $offs $x $x]
977 set offs [incrange $offs $x 1]
979 set rm1 [expr {$row - 1}]
980 lappend linesegends($rm1) $i
981 lappend idrowranges($i) $rm1
982 if {[incr nev -1] <= 0} break
985 set rowchk($id) [expr {$row + $r}]
988 lset rowidlist $row $idlist
989 lset rowoffsets $row $offs
991 set col [lsearch -exact $idlist $id]
993 set col [llength $idlist]
995 lset rowidlist $row $idlist
997 if {[lindex $childlist $row] ne {}} {
998 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1002 lset rowoffsets $row $offs
1004 makeuparrow $id $col $row $z
1009 if {[info exists idrowranges($id)]} {
1010 lappend idrowranges($id) $row
1013 set offs [ntimes [llength $idlist] 0]
1014 set l [llength $newolds]
1015 set idlist [eval lreplace \$idlist $col $col $newolds]
1018 set offs [lrange $offs 0 [expr {$col - 1}]]
1019 foreach x $newolds {
1024 set tmp [expr {[llength $idlist] - [llength $offs]}]
1026 set offs [concat $offs [ntimes $tmp $o]]
1031 foreach i $newolds {
1033 set idrowranges($i) $row
1036 foreach oid $oldolds {
1037 set idinlist($oid) 1
1038 set idlist [linsert $idlist $col $oid]
1039 set offs [linsert $offs $col $o]
1040 makeuparrow $oid $col $row $o
1043 lappend rowidlist $idlist
1044 lappend rowoffsets $offs
1049 proc addextraid {id row} {
1050 global displayorder commitrow commitinfo
1052 global parentlist childlist children
1055 lappend displayorder $id
1056 lappend parentlist {}
1057 set commitrow($id) $row
1059 if {![info exists commitinfo($id)]} {
1060 set commitinfo($id) {"No commit information available"}
1062 if {[info exists children($id)]} {
1063 lappend childlist $children($id)
1065 lappend childlist {}
1069 proc layouttail {} {
1070 global rowidlist rowoffsets idinlist commitidx
1074 set idlist [lindex $rowidlist $row]
1075 while {$idlist ne {}} {
1076 set col [expr {[llength $idlist] - 1}]
1077 set id [lindex $idlist $col]
1080 lappend idrowranges($id) $row
1082 set offs [ntimes $col 0]
1083 set idlist [lreplace $idlist $col $col]
1084 lappend rowidlist $idlist
1085 lappend rowoffsets $offs
1088 foreach id [array names idinlist] {
1090 lset rowidlist $row [list $id]
1091 lset rowoffsets $row 0
1092 makeuparrow $id 0 $row 0
1093 lappend idrowranges($id) $row
1095 lappend rowidlist {}
1096 lappend rowoffsets {}
1100 proc insert_pad {row col npad} {
1101 global rowidlist rowoffsets
1103 set pad [ntimes $npad {}]
1104 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1105 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1106 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1109 proc optimize_rows {row col endrow} {
1110 global rowidlist rowoffsets idrowranges linesegends displayorder
1112 for {} {$row < $endrow} {incr row} {
1113 set idlist [lindex $rowidlist $row]
1114 set offs [lindex $rowoffsets $row]
1116 for {} {$col < [llength $offs]} {incr col} {
1117 if {[lindex $idlist $col] eq {}} {
1121 set z [lindex $offs $col]
1122 if {$z eq {}} continue
1124 set x0 [expr {$col + $z}]
1125 set y0 [expr {$row - 1}]
1126 set z0 [lindex $rowoffsets $y0 $x0]
1128 set id [lindex $idlist $col]
1129 if {[info exists idrowranges($id)] &&
1130 $y0 > [lindex $idrowranges($id) 0]} {
1134 if {$z < -1 || ($z < 0 && $isarrow)} {
1135 set npad [expr {-1 - $z + $isarrow}]
1136 set offs [incrange $offs $col $npad]
1137 insert_pad $y0 $x0 $npad
1139 optimize_rows $y0 $x0 $row
1141 set z [lindex $offs $col]
1142 set x0 [expr {$col + $z}]
1143 set z0 [lindex $rowoffsets $y0 $x0]
1144 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1145 set npad [expr {$z - 1 + $isarrow}]
1146 set y1 [expr {$row + 1}]
1147 set offs2 [lindex $rowoffsets $y1]
1151 if {$z eq {} || $x1 + $z < $col} continue
1152 if {$x1 + $z > $col} {
1155 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1158 set pad [ntimes $npad {}]
1159 set idlist [eval linsert \$idlist $col $pad]
1160 set tmp [eval linsert \$offs $col $pad]
1162 set offs [incrange $tmp $col [expr {-$npad}]]
1163 set z [lindex $offs $col]
1166 if {$z0 eq {} && !$isarrow} {
1167 # this line links to its first child on row $row-2
1168 set rm2 [expr {$row - 2}]
1169 set id [lindex $displayorder $rm2]
1170 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1172 set z0 [expr {$xc - $x0}]
1175 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1176 insert_pad $y0 $x0 1
1177 set offs [incrange $offs $col 1]
1178 optimize_rows $y0 [expr {$x0 + 1}] $row
1183 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1184 set o [lindex $offs $col]
1186 # check if this is the link to the first child
1187 set id [lindex $idlist $col]
1188 if {[info exists idrowranges($id)] &&
1189 $row == [lindex $idrowranges($id) 0]} {
1190 # it is, work out offset to child
1191 set y0 [expr {$row - 1}]
1192 set id [lindex $displayorder $y0]
1193 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1195 set o [expr {$x0 - $col}]
1199 if {$o eq {} || $o <= 0} break
1201 if {$o ne {} && [incr col] < [llength $idlist]} {
1202 set y1 [expr {$row + 1}]
1203 set offs2 [lindex $rowoffsets $y1]
1207 if {$z eq {} || $x1 + $z < $col} continue
1208 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1211 set idlist [linsert $idlist $col {}]
1212 set tmp [linsert $offs $col {}]
1214 set offs [incrange $tmp $col -1]
1217 lset rowidlist $row $idlist
1218 lset rowoffsets $row $offs
1224 global canvx0 linespc
1225 return [expr {$canvx0 + $col * $linespc}]
1229 global canvy0 linespc
1230 return [expr {$canvy0 + $row * $linespc}]
1233 proc linewidth {id} {
1234 global thickerline lthickness
1237 if {[info exists thickerline] && $id eq $thickerline} {
1238 set wid [expr {2 * $lthickness}]
1243 proc drawlineseg {id i} {
1244 global rowoffsets rowidlist idrowranges
1246 global canv colormap linespc
1248 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1249 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1250 if {$startrow == $row} return
1253 set col [lsearch -exact [lindex $rowidlist $row] $id]
1255 puts "oops: drawline: id $id not on row $row"
1261 set o [lindex $rowoffsets $row $col]
1264 # changing direction
1265 set x [xc $row $col]
1267 lappend coords $x $y
1273 set x [xc $row $col]
1275 lappend coords $x $y
1277 # draw the link to the first child as part of this line
1279 set child [lindex $displayorder $row]
1280 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1282 set x [xc $row $ccol]
1284 if {$ccol < $col - 1} {
1285 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1286 } elseif {$ccol > $col + 1} {
1287 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1289 lappend coords $x $y
1292 if {[llength $coords] < 4} return
1293 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1295 # This line has an arrow at the lower end: check if the arrow is
1296 # on a diagonal segment, and if so, work around the Tk 8.4
1297 # refusal to draw arrows on diagonal lines.
1298 set x0 [lindex $coords 0]
1299 set x1 [lindex $coords 2]
1301 set y0 [lindex $coords 1]
1302 set y1 [lindex $coords 3]
1303 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1304 # we have a nearby vertical segment, just trim off the diag bit
1305 set coords [lrange $coords 2 end]
1307 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1308 set xi [expr {$x0 - $slope * $linespc / 2}]
1309 set yi [expr {$y0 - $linespc / 2}]
1310 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1314 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1315 set arrow [lindex {none first last both} $arrow]
1316 set t [$canv create line $coords -width [linewidth $id] \
1317 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1322 proc drawparentlinks {id row col olds} {
1323 global rowidlist canv colormap idrowranges
1325 set row2 [expr {$row + 1}]
1326 set x [xc $row $col]
1329 set ids [lindex $rowidlist $row2]
1330 # rmx = right-most X coord used
1333 set i [lsearch -exact $ids $p]
1335 puts "oops, parent $p of $id not in list"
1338 set x2 [xc $row2 $i]
1342 if {[info exists idrowranges($p)] &&
1343 $row2 == [lindex $idrowranges($p) 0] &&
1344 $row2 < [lindex $idrowranges($p) 1]} {
1345 # drawlineseg will do this one for us
1349 # should handle duplicated parents here...
1350 set coords [list $x $y]
1351 if {$i < $col - 1} {
1352 lappend coords [xc $row [expr {$i + 1}]] $y
1353 } elseif {$i > $col + 1} {
1354 lappend coords [xc $row [expr {$i - 1}]] $y
1356 lappend coords $x2 $y2
1357 set t [$canv create line $coords -width [linewidth $p] \
1358 -fill $colormap($p) -tags lines.$p]
1365 proc drawlines {id} {
1366 global colormap canv
1367 global idrowranges idrangedrawn
1368 global childlist iddrawn commitrow rowidlist
1370 $canv delete lines.$id
1371 set nr [expr {[llength $idrowranges($id)] / 2}]
1372 for {set i 0} {$i < $nr} {incr i} {
1373 if {[info exists idrangedrawn($id,$i)]} {
1377 foreach child [lindex $childlist $commitrow($id)] {
1378 if {[info exists iddrawn($child)]} {
1379 set row $commitrow($child)
1380 set col [lsearch -exact [lindex $rowidlist $row] $child]
1382 drawparentlinks $child $row $col [list $id]
1388 proc drawcmittext {id row col rmx} {
1389 global linespc canv canv2 canv3 canvy0
1390 global commitlisted commitinfo rowidlist
1391 global rowtextx idpos idtags idheads idotherrefs
1392 global linehtag linentag linedtag
1393 global mainfont namefont canvxmax
1395 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1396 set x [xc $row $col]
1398 set orad [expr {$linespc / 3}]
1399 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1400 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1401 -fill $ofill -outline black -width 1]
1403 $canv bind $t <1> {selcanvline {} %x %y}
1404 set xt [xc $row [llength [lindex $rowidlist $row]]]
1408 set rowtextx($row) $xt
1409 set idpos($id) [list $x $xt $y]
1410 if {[info exists idtags($id)] || [info exists idheads($id)]
1411 || [info exists idotherrefs($id)]} {
1412 set xt [drawtags $id $x $xt $y]
1414 set headline [lindex $commitinfo($id) 0]
1415 set name [lindex $commitinfo($id) 1]
1416 set date [lindex $commitinfo($id) 2]
1417 set date [formatdate $date]
1418 set linehtag($row) [$canv create text $xt $y -anchor w \
1419 -text $headline -font $mainfont ]
1420 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1421 set linentag($row) [$canv2 create text 3 $y -anchor w \
1422 -text $name -font $namefont]
1423 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1424 -text $date -font $mainfont]
1425 set xr [expr {$xt + [font measure $mainfont $headline]}]
1426 if {$xr > $canvxmax} {
1432 proc drawcmitrow {row} {
1433 global displayorder rowidlist
1434 global idrowranges idrangedrawn iddrawn
1435 global commitinfo commitlisted parentlist numcommits
1437 if {$row >= $numcommits} return
1438 foreach id [lindex $rowidlist $row] {
1439 if {![info exists idrowranges($id)]} continue
1441 foreach {s e} $idrowranges($id) {
1443 if {$row < $s} continue
1446 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1448 set idrangedrawn($id,$i) 1
1455 set id [lindex $displayorder $row]
1456 if {[info exists iddrawn($id)]} return
1457 set col [lsearch -exact [lindex $rowidlist $row] $id]
1459 puts "oops, row $row id $id not in list"
1462 if {![info exists commitinfo($id)]} {
1466 set olds [lindex $parentlist $row]
1468 set rmx [drawparentlinks $id $row $col $olds]
1472 drawcmittext $id $row $col $rmx
1476 proc drawfrac {f0 f1} {
1477 global numcommits canv
1480 set ymax [lindex [$canv cget -scrollregion] 3]
1481 if {$ymax eq {} || $ymax == 0} return
1482 set y0 [expr {int($f0 * $ymax)}]
1483 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1487 set y1 [expr {int($f1 * $ymax)}]
1488 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1489 if {$endrow >= $numcommits} {
1490 set endrow [expr {$numcommits - 1}]
1492 for {} {$row <= $endrow} {incr row} {
1497 proc drawvisible {} {
1499 eval drawfrac [$canv yview]
1502 proc clear_display {} {
1503 global iddrawn idrangedrawn
1506 catch {unset iddrawn}
1507 catch {unset idrangedrawn}
1510 proc assigncolor {id} {
1511 global colormap colors nextcolor
1512 global commitrow parentlist children childlist
1513 global cornercrossings crossings
1515 if {[info exists colormap($id)]} return
1516 set ncolors [llength $colors]
1517 if {[info exists commitrow($id)]} {
1518 set kids [lindex $childlist $commitrow($id)]
1519 } elseif {[info exists children($id)]} {
1520 set kids $children($id)
1524 if {[llength $kids] == 1} {
1525 set child [lindex $kids 0]
1526 if {[info exists colormap($child)]
1527 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1528 set colormap($id) $colormap($child)
1533 if {[info exists cornercrossings($id)]} {
1534 foreach x $cornercrossings($id) {
1535 if {[info exists colormap($x)]
1536 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1537 lappend badcolors $colormap($x)
1540 if {[llength $badcolors] >= $ncolors} {
1544 set origbad $badcolors
1545 if {[llength $badcolors] < $ncolors - 1} {
1546 if {[info exists crossings($id)]} {
1547 foreach x $crossings($id) {
1548 if {[info exists colormap($x)]
1549 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1550 lappend badcolors $colormap($x)
1553 if {[llength $badcolors] >= $ncolors} {
1554 set badcolors $origbad
1557 set origbad $badcolors
1559 if {[llength $badcolors] < $ncolors - 1} {
1560 foreach child $kids {
1561 if {[info exists colormap($child)]
1562 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1563 lappend badcolors $colormap($child)
1565 foreach p [lindex $parentlist $commitrow($child)] {
1566 if {[info exists colormap($p)]
1567 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1568 lappend badcolors $colormap($p)
1572 if {[llength $badcolors] >= $ncolors} {
1573 set badcolors $origbad
1576 for {set i 0} {$i <= $ncolors} {incr i} {
1577 set c [lindex $colors $nextcolor]
1578 if {[incr nextcolor] >= $ncolors} {
1581 if {[lsearch -exact $badcolors $c]} break
1583 set colormap($id) $c
1586 proc bindline {t id} {
1589 $canv bind $t <Enter> "lineenter %x %y $id"
1590 $canv bind $t <Motion> "linemotion %x %y $id"
1591 $canv bind $t <Leave> "lineleave $id"
1592 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1595 proc drawtags {id x xt y1} {
1596 global idtags idheads idotherrefs
1597 global linespc lthickness
1598 global canv mainfont commitrow rowtextx
1603 if {[info exists idtags($id)]} {
1604 set marks $idtags($id)
1605 set ntags [llength $marks]
1607 if {[info exists idheads($id)]} {
1608 set marks [concat $marks $idheads($id)]
1609 set nheads [llength $idheads($id)]
1611 if {[info exists idotherrefs($id)]} {
1612 set marks [concat $marks $idotherrefs($id)]
1618 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1619 set yt [expr {$y1 - 0.5 * $linespc}]
1620 set yb [expr {$yt + $linespc - 1}]
1623 foreach tag $marks {
1624 set wid [font measure $mainfont $tag]
1627 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1629 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1630 -width $lthickness -fill black -tags tag.$id]
1632 foreach tag $marks x $xvals wid $wvals {
1633 set xl [expr {$x + $delta}]
1634 set xr [expr {$x + $delta + $wid + $lthickness}]
1635 if {[incr ntags -1] >= 0} {
1637 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1638 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1639 -width 1 -outline black -fill yellow -tags tag.$id]
1640 $canv bind $t <1> [list showtag $tag 1]
1641 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1643 # draw a head or other ref
1644 if {[incr nheads -1] >= 0} {
1649 set xl [expr {$xl - $delta/2}]
1650 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1651 -width 1 -outline black -fill $col -tags tag.$id
1653 set t [$canv create text $xl $y1 -anchor w -text $tag \
1654 -font $mainfont -tags tag.$id]
1656 $canv bind $t <1> [list showtag $tag 1]
1662 proc checkcrossings {row endrow} {
1663 global displayorder parentlist rowidlist
1665 for {} {$row < $endrow} {incr row} {
1666 set id [lindex $displayorder $row]
1667 set i [lsearch -exact [lindex $rowidlist $row] $id]
1668 if {$i < 0} continue
1669 set idlist [lindex $rowidlist [expr {$row+1}]]
1670 foreach p [lindex $parentlist $row] {
1671 set j [lsearch -exact $idlist $p]
1674 notecrossings $row $p $j $i [expr {$j+1}]
1675 } elseif {$j > $i + 1} {
1676 notecrossings $row $p $i $j [expr {$j-1}]
1683 proc notecrossings {row id lo hi corner} {
1684 global rowidlist crossings cornercrossings
1686 for {set i $lo} {[incr i] < $hi} {} {
1687 set p [lindex [lindex $rowidlist $row] $i]
1688 if {$p == {}} continue
1689 if {$i == $corner} {
1690 if {![info exists cornercrossings($id)]
1691 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1692 lappend cornercrossings($id) $p
1694 if {![info exists cornercrossings($p)]
1695 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1696 lappend cornercrossings($p) $id
1699 if {![info exists crossings($id)]
1700 || [lsearch -exact $crossings($id) $p] < 0} {
1701 lappend crossings($id) $p
1703 if {![info exists crossings($p)]
1704 || [lsearch -exact $crossings($p) $id] < 0} {
1705 lappend crossings($p) $id
1711 proc xcoord {i level ln} {
1712 global canvx0 xspc1 xspc2
1714 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1715 if {$i > 0 && $i == $level} {
1716 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1717 } elseif {$i > $level} {
1718 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1723 proc finishcommits {} {
1724 global commitidx phase
1725 global canv mainfont ctext maincursor textcursor
1726 global findinprogress
1728 if {$commitidx > 0} {
1732 $canv create text 3 3 -anchor nw -text "No commits selected" \
1733 -font $mainfont -tags textitems
1735 if {![info exists findinprogress]} {
1736 . config -cursor $maincursor
1737 settextcursor $textcursor
1742 # Don't change the text pane cursor if it is currently the hand cursor,
1743 # showing that we are over a sha1 ID link.
1744 proc settextcursor {c} {
1745 global ctext curtextcursor
1747 if {[$ctext cget -cursor] == $curtextcursor} {
1748 $ctext config -cursor $c
1750 set curtextcursor $c
1756 global canvy0 numcommits linespc
1757 global rowlaidout commitidx
1760 layoutrows $rowlaidout $commitidx 1
1762 optimize_rows $row 0 $commitidx
1763 showstuff $commitidx
1765 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1766 puts "overall $drawmsecs ms for $numcommits commits"
1769 proc findmatches {f} {
1770 global findtype foundstring foundstrlen
1771 if {$findtype == "Regexp"} {
1772 set matches [regexp -indices -all -inline $foundstring $f]
1774 if {$findtype == "IgnCase"} {
1775 set str [string tolower $f]
1781 while {[set j [string first $foundstring $str $i]] >= 0} {
1782 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1783 set i [expr {$j + $foundstrlen}]
1790 global findtype findloc findstring markedmatches commitinfo
1791 global numcommits displayorder linehtag linentag linedtag
1792 global mainfont namefont canv canv2 canv3 selectedline
1793 global matchinglines foundstring foundstrlen matchstring
1799 set matchinglines {}
1800 if {$findloc == "Pickaxe"} {
1804 if {$findtype == "IgnCase"} {
1805 set foundstring [string tolower $findstring]
1807 set foundstring $findstring
1809 set foundstrlen [string length $findstring]
1810 if {$foundstrlen == 0} return
1811 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1812 set matchstring "*$matchstring*"
1813 if {$findloc == "Files"} {
1817 if {![info exists selectedline]} {
1820 set oldsel $selectedline
1823 set fldtypes {Headline Author Date Committer CDate Comment}
1825 foreach id $displayorder {
1826 set d $commitdata($id)
1828 if {$findtype == "Regexp"} {
1829 set doesmatch [regexp $foundstring $d]
1830 } elseif {$findtype == "IgnCase"} {
1831 set doesmatch [string match -nocase $matchstring $d]
1833 set doesmatch [string match $matchstring $d]
1835 if {!$doesmatch} continue
1836 if {![info exists commitinfo($id)]} {
1839 set info $commitinfo($id)
1841 foreach f $info ty $fldtypes {
1842 if {$findloc != "All fields" && $findloc != $ty} {
1845 set matches [findmatches $f]
1846 if {$matches == {}} continue
1848 if {$ty == "Headline"} {
1850 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1851 } elseif {$ty == "Author"} {
1853 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1854 } elseif {$ty == "Date"} {
1856 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1860 lappend matchinglines $l
1861 if {!$didsel && $l > $oldsel} {
1867 if {$matchinglines == {}} {
1869 } elseif {!$didsel} {
1870 findselectline [lindex $matchinglines 0]
1874 proc findselectline {l} {
1875 global findloc commentend ctext
1877 if {$findloc == "All fields" || $findloc == "Comments"} {
1878 # highlight the matches in the comments
1879 set f [$ctext get 1.0 $commentend]
1880 set matches [findmatches $f]
1881 foreach match $matches {
1882 set start [lindex $match 0]
1883 set end [expr {[lindex $match 1] + 1}]
1884 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1889 proc findnext {restart} {
1890 global matchinglines selectedline
1891 if {![info exists matchinglines]} {
1897 if {![info exists selectedline]} return
1898 foreach l $matchinglines {
1899 if {$l > $selectedline} {
1908 global matchinglines selectedline
1909 if {![info exists matchinglines]} {
1913 if {![info exists selectedline]} return
1915 foreach l $matchinglines {
1916 if {$l >= $selectedline} break
1920 findselectline $prev
1926 proc findlocchange {name ix op} {
1927 global findloc findtype findtypemenu
1928 if {$findloc == "Pickaxe"} {
1934 $findtypemenu entryconf 1 -state $state
1935 $findtypemenu entryconf 2 -state $state
1938 proc stopfindproc {{done 0}} {
1939 global findprocpid findprocfile findids
1940 global ctext findoldcursor phase maincursor textcursor
1941 global findinprogress
1943 catch {unset findids}
1944 if {[info exists findprocpid]} {
1946 catch {exec kill $findprocpid}
1948 catch {close $findprocfile}
1951 if {[info exists findinprogress]} {
1952 unset findinprogress
1953 if {$phase != "incrdraw"} {
1954 . config -cursor $maincursor
1955 settextcursor $textcursor
1960 proc findpatches {} {
1961 global findstring selectedline numcommits
1962 global findprocpid findprocfile
1963 global finddidsel ctext displayorder findinprogress
1964 global findinsertpos
1966 if {$numcommits == 0} return
1968 # make a list of all the ids to search, starting at the one
1969 # after the selected line (if any)
1970 if {[info exists selectedline]} {
1976 for {set i 0} {$i < $numcommits} {incr i} {
1977 if {[incr l] >= $numcommits} {
1980 append inputids [lindex $displayorder $l] "\n"
1984 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1987 error_popup "Error starting search process: $err"
1991 set findinsertpos end
1993 set findprocpid [pid $f]
1994 fconfigure $f -blocking 0
1995 fileevent $f readable readfindproc
1997 . config -cursor watch
1999 set findinprogress 1
2002 proc readfindproc {} {
2003 global findprocfile finddidsel
2004 global commitrow matchinglines findinsertpos
2006 set n [gets $findprocfile line]
2008 if {[eof $findprocfile]} {
2016 if {![regexp {^[0-9a-f]{40}} $line id]} {
2017 error_popup "Can't parse git-diff-tree output: $line"
2021 if {![info exists commitrow($id)]} {
2022 puts stderr "spurious id: $id"
2025 set l $commitrow($id)
2029 proc insertmatch {l id} {
2030 global matchinglines findinsertpos finddidsel
2032 if {$findinsertpos == "end"} {
2033 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2034 set matchinglines [linsert $matchinglines 0 $l]
2037 lappend matchinglines $l
2040 set matchinglines [linsert $matchinglines $findinsertpos $l]
2051 global selectedline numcommits displayorder ctext
2052 global ffileline finddidsel parentlist
2053 global findinprogress findstartline findinsertpos
2054 global treediffs fdiffid fdiffsneeded fdiffpos
2055 global findmergefiles
2057 if {$numcommits == 0} return
2059 if {[info exists selectedline]} {
2060 set l [expr {$selectedline + 1}]
2065 set findstartline $l
2069 set id [lindex $displayorder $l]
2070 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2071 if {![info exists treediffs($id)]} {
2072 append diffsneeded "$id\n"
2073 lappend fdiffsneeded $id
2076 if {[incr l] >= $numcommits} {
2079 if {$l == $findstartline} break
2082 # start off a git-diff-tree process if needed
2083 if {$diffsneeded ne {}} {
2085 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2087 error_popup "Error starting search process: $err"
2090 catch {unset fdiffid}
2092 fconfigure $df -blocking 0
2093 fileevent $df readable [list readfilediffs $df]
2097 set findinsertpos end
2098 set id [lindex $displayorder $l]
2099 . config -cursor watch
2101 set findinprogress 1
2106 proc readfilediffs {df} {
2107 global findid fdiffid fdiffs
2109 set n [gets $df line]
2113 if {[catch {close $df} err]} {
2116 error_popup "Error in git-diff-tree: $err"
2117 } elseif {[info exists findid]} {
2121 error_popup "Couldn't find diffs for $id"
2126 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2127 # start of a new string of diffs
2131 } elseif {[string match ":*" $line]} {
2132 lappend fdiffs [lindex $line 5]
2136 proc donefilediff {} {
2137 global fdiffid fdiffs treediffs findid
2138 global fdiffsneeded fdiffpos
2140 if {[info exists fdiffid]} {
2141 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2142 && $fdiffpos < [llength $fdiffsneeded]} {
2143 # git-diff-tree doesn't output anything for a commit
2144 # which doesn't change anything
2145 set nullid [lindex $fdiffsneeded $fdiffpos]
2146 set treediffs($nullid) {}
2147 if {[info exists findid] && $nullid eq $findid} {
2155 if {![info exists treediffs($fdiffid)]} {
2156 set treediffs($fdiffid) $fdiffs
2158 if {[info exists findid] && $fdiffid eq $findid} {
2165 proc findcont {id} {
2166 global findid treediffs parentlist
2167 global ffileline findstartline finddidsel
2168 global displayorder numcommits matchinglines findinprogress
2169 global findmergefiles
2173 set id [lindex $displayorder $l]
2174 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2175 if {![info exists treediffs($id)]} {
2181 foreach f $treediffs($id) {
2182 set x [findmatches $f]
2192 if {[incr l] >= $numcommits} {
2195 if {$l == $findstartline} break
2203 # mark a commit as matching by putting a yellow background
2204 # behind the headline
2205 proc markheadline {l id} {
2206 global canv mainfont linehtag
2209 set bbox [$canv bbox $linehtag($l)]
2210 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2214 # mark the bits of a headline, author or date that match a find string
2215 proc markmatches {canv l str tag matches font} {
2216 set bbox [$canv bbox $tag]
2217 set x0 [lindex $bbox 0]
2218 set y0 [lindex $bbox 1]
2219 set y1 [lindex $bbox 3]
2220 foreach match $matches {
2221 set start [lindex $match 0]
2222 set end [lindex $match 1]
2223 if {$start > $end} continue
2224 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2225 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2226 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2227 [expr {$x0+$xlen+2}] $y1 \
2228 -outline {} -tags matches -fill yellow]
2233 proc unmarkmatches {} {
2234 global matchinglines findids
2235 allcanvs delete matches
2236 catch {unset matchinglines}
2237 catch {unset findids}
2240 proc selcanvline {w x y} {
2241 global canv canvy0 ctext linespc
2243 set ymax [lindex [$canv cget -scrollregion] 3]
2244 if {$ymax == {}} return
2245 set yfrac [lindex [$canv yview] 0]
2246 set y [expr {$y + $yfrac * $ymax}]
2247 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2252 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2258 proc commit_descriptor {p} {
2261 if {[info exists commitinfo($p)]} {
2262 set l [lindex $commitinfo($p) 0]
2267 # append some text to the ctext widget, and make any SHA1 ID
2268 # that we know about be a clickable link.
2269 proc appendwithlinks {text} {
2270 global ctext commitrow linknum
2272 set start [$ctext index "end - 1c"]
2273 $ctext insert end $text
2274 $ctext insert end "\n"
2275 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2279 set linkid [string range $text $s $e]
2280 if {![info exists commitrow($linkid)]} continue
2282 $ctext tag add link "$start + $s c" "$start + $e c"
2283 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2284 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2287 $ctext tag conf link -foreground blue -underline 1
2288 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2289 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2292 proc selectline {l isnew} {
2293 global canv canv2 canv3 ctext commitinfo selectedline
2294 global displayorder linehtag linentag linedtag
2295 global canvy0 linespc parentlist childlist
2296 global cflist currentid sha1entry
2297 global commentend idtags linknum
2298 global mergemax numcommits
2302 if {$l < 0 || $l >= $numcommits} return
2303 set y [expr {$canvy0 + $l * $linespc}]
2304 set ymax [lindex [$canv cget -scrollregion] 3]
2305 set ytop [expr {$y - $linespc - 1}]
2306 set ybot [expr {$y + $linespc + 1}]
2307 set wnow [$canv yview]
2308 set wtop [expr {[lindex $wnow 0] * $ymax}]
2309 set wbot [expr {[lindex $wnow 1] * $ymax}]
2310 set wh [expr {$wbot - $wtop}]
2312 if {$ytop < $wtop} {
2313 if {$ybot < $wtop} {
2314 set newtop [expr {$y - $wh / 2.0}]
2317 if {$newtop > $wtop - $linespc} {
2318 set newtop [expr {$wtop - $linespc}]
2321 } elseif {$ybot > $wbot} {
2322 if {$ytop > $wbot} {
2323 set newtop [expr {$y - $wh / 2.0}]
2325 set newtop [expr {$ybot - $wh}]
2326 if {$newtop < $wtop + $linespc} {
2327 set newtop [expr {$wtop + $linespc}]
2331 if {$newtop != $wtop} {
2335 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2339 if {![info exists linehtag($l)]} return
2341 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2342 -tags secsel -fill [$canv cget -selectbackground]]
2344 $canv2 delete secsel
2345 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2346 -tags secsel -fill [$canv2 cget -selectbackground]]
2348 $canv3 delete secsel
2349 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2350 -tags secsel -fill [$canv3 cget -selectbackground]]
2354 addtohistory [list selectline $l 0]
2359 set id [lindex $displayorder $l]
2361 $sha1entry delete 0 end
2362 $sha1entry insert 0 $id
2363 $sha1entry selection from 0
2364 $sha1entry selection to end
2366 $ctext conf -state normal
2367 $ctext delete 0.0 end
2369 $ctext mark set fmark.0 0.0
2370 $ctext mark gravity fmark.0 left
2371 set info $commitinfo($id)
2372 set date [formatdate [lindex $info 2]]
2373 $ctext insert end "Author: [lindex $info 1] $date\n"
2374 set date [formatdate [lindex $info 4]]
2375 $ctext insert end "Committer: [lindex $info 3] $date\n"
2376 if {[info exists idtags($id)]} {
2377 $ctext insert end "Tags:"
2378 foreach tag $idtags($id) {
2379 $ctext insert end " $tag"
2381 $ctext insert end "\n"
2385 set olds [lindex $parentlist $l]
2386 if {[llength $olds] > 1} {
2389 if {$np >= $mergemax} {
2394 $ctext insert end "Parent: " $tag
2395 appendwithlinks [commit_descriptor $p]
2400 append comment "Parent: [commit_descriptor $p]\n"
2404 foreach c [lindex $childlist $l] {
2405 append comment "Child: [commit_descriptor $c]\n"
2408 append comment [lindex $info 5]
2410 # make anything that looks like a SHA1 ID be a clickable link
2411 appendwithlinks $comment
2413 $ctext tag delete Comments
2414 $ctext tag remove found 1.0 end
2415 $ctext conf -state disabled
2416 set commentend [$ctext index "end - 1c"]
2418 $cflist delete 0 end
2419 $cflist insert end "Comments"
2420 if {[llength $olds] <= 1} {
2427 proc selnextline {dir} {
2429 if {![info exists selectedline]} return
2430 set l [expr {$selectedline + $dir}]
2435 proc unselectline {} {
2438 catch {unset selectedline}
2439 allcanvs delete secsel
2442 proc addtohistory {cmd} {
2443 global history historyindex
2445 if {$historyindex > 0
2446 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2450 if {$historyindex < [llength $history]} {
2451 set history [lreplace $history $historyindex end $cmd]
2453 lappend history $cmd
2456 if {$historyindex > 1} {
2457 .ctop.top.bar.leftbut conf -state normal
2459 .ctop.top.bar.leftbut conf -state disabled
2461 .ctop.top.bar.rightbut conf -state disabled
2465 global history historyindex
2467 if {$historyindex > 1} {
2468 incr historyindex -1
2469 set cmd [lindex $history [expr {$historyindex - 1}]]
2471 .ctop.top.bar.rightbut conf -state normal
2473 if {$historyindex <= 1} {
2474 .ctop.top.bar.leftbut conf -state disabled
2479 global history historyindex
2481 if {$historyindex < [llength $history]} {
2482 set cmd [lindex $history $historyindex]
2485 .ctop.top.bar.leftbut conf -state normal
2487 if {$historyindex >= [llength $history]} {
2488 .ctop.top.bar.rightbut conf -state disabled
2492 proc mergediff {id l} {
2493 global diffmergeid diffopts mdifffd
2494 global difffilestart diffids
2499 catch {unset difffilestart}
2500 # this doesn't seem to actually affect anything...
2501 set env(GIT_DIFF_OPTS) $diffopts
2502 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2503 if {[catch {set mdf [open $cmd r]} err]} {
2504 error_popup "Error getting merge diffs: $err"
2507 fconfigure $mdf -blocking 0
2508 set mdifffd($id) $mdf
2509 set np [llength [lindex $parentlist $l]]
2510 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2511 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2514 proc getmergediffline {mdf id np} {
2515 global diffmergeid ctext cflist nextupdate mergemax
2516 global difffilestart mdifffd
2518 set n [gets $mdf line]
2525 if {![info exists diffmergeid] || $id != $diffmergeid
2526 || $mdf != $mdifffd($id)} {
2529 $ctext conf -state normal
2530 if {[regexp {^diff --cc (.*)} $line match fname]} {
2531 # start of a new file
2532 $ctext insert end "\n"
2533 set here [$ctext index "end - 1c"]
2534 set i [$cflist index end]
2535 $ctext mark set fmark.$i $here
2536 $ctext mark gravity fmark.$i left
2537 set difffilestart([expr {$i-1}]) $here
2538 $cflist insert end $fname
2539 set l [expr {(78 - [string length $fname]) / 2}]
2540 set pad [string range "----------------------------------------" 1 $l]
2541 $ctext insert end "$pad $fname $pad\n" filesep
2542 } elseif {[regexp {^@@} $line]} {
2543 $ctext insert end "$line\n" hunksep
2544 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2547 # parse the prefix - one ' ', '-' or '+' for each parent
2552 for {set j 0} {$j < $np} {incr j} {
2553 set c [string range $line $j $j]
2556 } elseif {$c == "-"} {
2558 } elseif {$c == "+"} {
2567 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2568 # line doesn't appear in result, parents in $minuses have the line
2569 set num [lindex $minuses 0]
2570 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2571 # line appears in result, parents in $pluses don't have the line
2572 lappend tags mresult
2573 set num [lindex $spaces 0]
2576 if {$num >= $mergemax} {
2581 $ctext insert end "$line\n" $tags
2583 $ctext conf -state disabled
2584 if {[clock clicks -milliseconds] >= $nextupdate} {
2586 fileevent $mdf readable {}
2588 fileevent $mdf readable [list getmergediffline $mdf $id]
2592 proc startdiff {ids} {
2593 global treediffs diffids treepending diffmergeid
2596 catch {unset diffmergeid}
2597 if {![info exists treediffs($ids)]} {
2598 if {![info exists treepending]} {
2606 proc addtocflist {ids} {
2607 global treediffs cflist
2608 foreach f $treediffs($ids) {
2609 $cflist insert end $f
2614 proc gettreediffs {ids} {
2615 global treediff treepending
2616 set treepending $ids
2619 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2621 fconfigure $gdtf -blocking 0
2622 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2625 proc gettreediffline {gdtf ids} {
2626 global treediff treediffs treepending diffids diffmergeid
2628 set n [gets $gdtf line]
2630 if {![eof $gdtf]} return
2632 set treediffs($ids) $treediff
2634 if {$ids != $diffids} {
2635 if {![info exists diffmergeid]} {
2636 gettreediffs $diffids
2643 set file [lindex $line 5]
2644 lappend treediff $file
2647 proc getblobdiffs {ids} {
2648 global diffopts blobdifffd diffids env curdifftag curtagstart
2649 global difffilestart nextupdate diffinhdr treediffs
2651 set env(GIT_DIFF_OPTS) $diffopts
2652 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2653 if {[catch {set bdf [open $cmd r]} err]} {
2654 puts "error getting diffs: $err"
2658 fconfigure $bdf -blocking 0
2659 set blobdifffd($ids) $bdf
2660 set curdifftag Comments
2662 catch {unset difffilestart}
2663 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2664 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2667 proc getblobdiffline {bdf ids} {
2668 global diffids blobdifffd ctext curdifftag curtagstart
2669 global diffnexthead diffnextnote difffilestart
2670 global nextupdate diffinhdr treediffs
2672 set n [gets $bdf line]
2676 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2677 $ctext tag add $curdifftag $curtagstart end
2682 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2685 $ctext conf -state normal
2686 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2687 # start of a new file
2688 $ctext insert end "\n"
2689 $ctext tag add $curdifftag $curtagstart end
2690 set curtagstart [$ctext index "end - 1c"]
2692 set here [$ctext index "end - 1c"]
2693 set i [lsearch -exact $treediffs($diffids) $fname]
2695 set difffilestart($i) $here
2697 $ctext mark set fmark.$i $here
2698 $ctext mark gravity fmark.$i left
2700 if {$newname != $fname} {
2701 set i [lsearch -exact $treediffs($diffids) $newname]
2703 set difffilestart($i) $here
2705 $ctext mark set fmark.$i $here
2706 $ctext mark gravity fmark.$i left
2709 set curdifftag "f:$fname"
2710 $ctext tag delete $curdifftag
2711 set l [expr {(78 - [string length $header]) / 2}]
2712 set pad [string range "----------------------------------------" 1 $l]
2713 $ctext insert end "$pad $header $pad\n" filesep
2715 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2717 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2719 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2720 $line match f1l f1c f2l f2c rest]} {
2721 $ctext insert end "$line\n" hunksep
2724 set x [string range $line 0 0]
2725 if {$x == "-" || $x == "+"} {
2726 set tag [expr {$x == "+"}]
2727 $ctext insert end "$line\n" d$tag
2728 } elseif {$x == " "} {
2729 $ctext insert end "$line\n"
2730 } elseif {$diffinhdr || $x == "\\"} {
2731 # e.g. "\ No newline at end of file"
2732 $ctext insert end "$line\n" filesep
2734 # Something else we don't recognize
2735 if {$curdifftag != "Comments"} {
2736 $ctext insert end "\n"
2737 $ctext tag add $curdifftag $curtagstart end
2738 set curtagstart [$ctext index "end - 1c"]
2739 set curdifftag Comments
2741 $ctext insert end "$line\n" filesep
2744 $ctext conf -state disabled
2745 if {[clock clicks -milliseconds] >= $nextupdate} {
2747 fileevent $bdf readable {}
2749 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2754 global difffilestart ctext
2755 set here [$ctext index @0,0]
2756 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2757 if {[$ctext compare $difffilestart($i) > $here]} {
2758 if {![info exists pos]
2759 || [$ctext compare $difffilestart($i) < $pos]} {
2760 set pos $difffilestart($i)
2764 if {[info exists pos]} {
2769 proc listboxsel {} {
2770 global ctext cflist currentid
2771 if {![info exists currentid]} return
2772 set sel [lsort [$cflist curselection]]
2773 if {$sel eq {}} return
2774 set first [lindex $sel 0]
2775 catch {$ctext yview fmark.$first}
2779 global linespc charspc canvx0 canvy0 mainfont
2780 global xspc1 xspc2 lthickness
2782 set linespc [font metrics $mainfont -linespace]
2783 set charspc [font measure $mainfont "m"]
2784 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2785 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2786 set lthickness [expr {int($linespc / 9) + 1}]
2787 set xspc1(0) $linespc
2795 set ymax [lindex [$canv cget -scrollregion] 3]
2796 if {$ymax eq {} || $ymax == 0} return
2797 set span [$canv yview]
2800 allcanvs yview moveto [lindex $span 0]
2802 if {[info exists selectedline]} {
2803 selectline $selectedline 0
2807 proc incrfont {inc} {
2808 global mainfont namefont textfont ctext canv phase
2809 global stopped entries
2811 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2812 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2813 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2815 $ctext conf -font $textfont
2816 $ctext tag conf filesep -font [concat $textfont bold]
2817 foreach e $entries {
2818 $e conf -font $mainfont
2820 if {$phase == "getcommits"} {
2821 $canv itemconf textitems -font $mainfont
2827 global sha1entry sha1string
2828 if {[string length $sha1string] == 40} {
2829 $sha1entry delete 0 end
2833 proc sha1change {n1 n2 op} {
2834 global sha1string currentid sha1but
2835 if {$sha1string == {}
2836 || ([info exists currentid] && $sha1string == $currentid)} {
2841 if {[$sha1but cget -state] == $state} return
2842 if {$state == "normal"} {
2843 $sha1but conf -state normal -relief raised -text "Goto: "
2845 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2849 proc gotocommit {} {
2850 global sha1string currentid commitrow tagids
2851 global displayorder numcommits
2853 if {$sha1string == {}
2854 || ([info exists currentid] && $sha1string == $currentid)} return
2855 if {[info exists tagids($sha1string)]} {
2856 set id $tagids($sha1string)
2858 set id [string tolower $sha1string]
2859 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2861 foreach i $displayorder {
2862 if {[string match $id* $i]} {
2866 if {$matches ne {}} {
2867 if {[llength $matches] > 1} {
2868 error_popup "Short SHA1 id $id is ambiguous"
2871 set id [lindex $matches 0]
2875 if {[info exists commitrow($id)]} {
2876 selectline $commitrow($id) 1
2879 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2884 error_popup "$type $sha1string is not known"
2887 proc lineenter {x y id} {
2888 global hoverx hovery hoverid hovertimer
2889 global commitinfo canv
2891 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2895 if {[info exists hovertimer]} {
2896 after cancel $hovertimer
2898 set hovertimer [after 500 linehover]
2902 proc linemotion {x y id} {
2903 global hoverx hovery hoverid hovertimer
2905 if {[info exists hoverid] && $id == $hoverid} {
2908 if {[info exists hovertimer]} {
2909 after cancel $hovertimer
2911 set hovertimer [after 500 linehover]
2915 proc lineleave {id} {
2916 global hoverid hovertimer canv
2918 if {[info exists hoverid] && $id == $hoverid} {
2920 if {[info exists hovertimer]} {
2921 after cancel $hovertimer
2929 global hoverx hovery hoverid hovertimer
2930 global canv linespc lthickness
2931 global commitinfo mainfont
2933 set text [lindex $commitinfo($hoverid) 0]
2934 set ymax [lindex [$canv cget -scrollregion] 3]
2935 if {$ymax == {}} return
2936 set yfrac [lindex [$canv yview] 0]
2937 set x [expr {$hoverx + 2 * $linespc}]
2938 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2939 set x0 [expr {$x - 2 * $lthickness}]
2940 set y0 [expr {$y - 2 * $lthickness}]
2941 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2942 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2943 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2944 -fill \#ffff80 -outline black -width 1 -tags hover]
2946 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2950 proc clickisonarrow {id y} {
2951 global lthickness idrowranges
2953 set thresh [expr {2 * $lthickness + 6}]
2954 set n [expr {[llength $idrowranges($id)] - 1}]
2955 for {set i 1} {$i < $n} {incr i} {
2956 set row [lindex $idrowranges($id) $i]
2957 if {abs([yc $row] - $y) < $thresh} {
2964 proc arrowjump {id n y} {
2965 global idrowranges canv
2967 # 1 <-> 2, 3 <-> 4, etc...
2968 set n [expr {(($n - 1) ^ 1) + 1}]
2969 set row [lindex $idrowranges($id) $n]
2971 set ymax [lindex [$canv cget -scrollregion] 3]
2972 if {$ymax eq {} || $ymax <= 0} return
2973 set view [$canv yview]
2974 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2975 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2979 allcanvs yview moveto $yfrac
2982 proc lineclick {x y id isnew} {
2983 global ctext commitinfo childlist commitrow cflist canv thickerline
2985 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2990 # draw this line thicker than normal
2994 set ymax [lindex [$canv cget -scrollregion] 3]
2995 if {$ymax eq {}} return
2996 set yfrac [lindex [$canv yview] 0]
2997 set y [expr {$y + $yfrac * $ymax}]
2999 set dirn [clickisonarrow $id $y]
3001 arrowjump $id $dirn $y
3006 addtohistory [list lineclick $x $y $id 0]
3008 # fill the details pane with info about this line
3009 $ctext conf -state normal
3010 $ctext delete 0.0 end
3011 $ctext tag conf link -foreground blue -underline 1
3012 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3013 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3014 $ctext insert end "Parent:\t"
3015 $ctext insert end $id [list link link0]
3016 $ctext tag bind link0 <1> [list selbyid $id]
3017 set info $commitinfo($id)
3018 $ctext insert end "\n\t[lindex $info 0]\n"
3019 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3020 set date [formatdate [lindex $info 2]]
3021 $ctext insert end "\tDate:\t$date\n"
3022 set kids [lindex $childlist $commitrow($id)]
3024 $ctext insert end "\nChildren:"
3026 foreach child $kids {
3028 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3029 set info $commitinfo($child)
3030 $ctext insert end "\n\t"
3031 $ctext insert end $child [list link link$i]
3032 $ctext tag bind link$i <1> [list selbyid $child]
3033 $ctext insert end "\n\t[lindex $info 0]"
3034 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3035 set date [formatdate [lindex $info 2]]
3036 $ctext insert end "\n\tDate:\t$date\n"
3039 $ctext conf -state disabled
3041 $cflist delete 0 end
3044 proc normalline {} {
3046 if {[info exists thickerline]} {
3055 if {[info exists commitrow($id)]} {
3056 selectline $commitrow($id) 1
3062 if {![info exists startmstime]} {
3063 set startmstime [clock clicks -milliseconds]
3065 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3068 proc rowmenu {x y id} {
3069 global rowctxmenu commitrow selectedline rowmenuid
3071 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3076 $rowctxmenu entryconfigure 0 -state $state
3077 $rowctxmenu entryconfigure 1 -state $state
3078 $rowctxmenu entryconfigure 2 -state $state
3080 tk_popup $rowctxmenu $x $y
3083 proc diffvssel {dirn} {
3084 global rowmenuid selectedline displayorder
3086 if {![info exists selectedline]} return
3088 set oldid [lindex $displayorder $selectedline]
3089 set newid $rowmenuid
3091 set oldid $rowmenuid
3092 set newid [lindex $displayorder $selectedline]
3094 addtohistory [list doseldiff $oldid $newid]
3095 doseldiff $oldid $newid
3098 proc doseldiff {oldid newid} {
3102 $ctext conf -state normal
3103 $ctext delete 0.0 end
3104 $ctext mark set fmark.0 0.0
3105 $ctext mark gravity fmark.0 left
3106 $cflist delete 0 end
3107 $cflist insert end "Top"
3108 $ctext insert end "From "
3109 $ctext tag conf link -foreground blue -underline 1
3110 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3111 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3112 $ctext tag bind link0 <1> [list selbyid $oldid]
3113 $ctext insert end $oldid [list link link0]
3114 $ctext insert end "\n "
3115 $ctext insert end [lindex $commitinfo($oldid) 0]
3116 $ctext insert end "\n\nTo "
3117 $ctext tag bind link1 <1> [list selbyid $newid]
3118 $ctext insert end $newid [list link link1]
3119 $ctext insert end "\n "
3120 $ctext insert end [lindex $commitinfo($newid) 0]
3121 $ctext insert end "\n"
3122 $ctext conf -state disabled
3123 $ctext tag delete Comments
3124 $ctext tag remove found 1.0 end
3125 startdiff [list $oldid $newid]
3129 global rowmenuid currentid commitinfo patchtop patchnum
3131 if {![info exists currentid]} return
3132 set oldid $currentid
3133 set oldhead [lindex $commitinfo($oldid) 0]
3134 set newid $rowmenuid
3135 set newhead [lindex $commitinfo($newid) 0]
3138 catch {destroy $top}
3140 label $top.title -text "Generate patch"
3141 grid $top.title - -pady 10
3142 label $top.from -text "From:"
3143 entry $top.fromsha1 -width 40 -relief flat
3144 $top.fromsha1 insert 0 $oldid
3145 $top.fromsha1 conf -state readonly
3146 grid $top.from $top.fromsha1 -sticky w
3147 entry $top.fromhead -width 60 -relief flat
3148 $top.fromhead insert 0 $oldhead
3149 $top.fromhead conf -state readonly
3150 grid x $top.fromhead -sticky w
3151 label $top.to -text "To:"
3152 entry $top.tosha1 -width 40 -relief flat
3153 $top.tosha1 insert 0 $newid
3154 $top.tosha1 conf -state readonly
3155 grid $top.to $top.tosha1 -sticky w
3156 entry $top.tohead -width 60 -relief flat
3157 $top.tohead insert 0 $newhead
3158 $top.tohead conf -state readonly
3159 grid x $top.tohead -sticky w
3160 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3161 grid $top.rev x -pady 10
3162 label $top.flab -text "Output file:"
3163 entry $top.fname -width 60
3164 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3166 grid $top.flab $top.fname -sticky w
3168 button $top.buts.gen -text "Generate" -command mkpatchgo
3169 button $top.buts.can -text "Cancel" -command mkpatchcan
3170 grid $top.buts.gen $top.buts.can
3171 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3172 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3173 grid $top.buts - -pady 10 -sticky ew
3177 proc mkpatchrev {} {
3180 set oldid [$patchtop.fromsha1 get]
3181 set oldhead [$patchtop.fromhead get]
3182 set newid [$patchtop.tosha1 get]
3183 set newhead [$patchtop.tohead get]
3184 foreach e [list fromsha1 fromhead tosha1 tohead] \
3185 v [list $newid $newhead $oldid $oldhead] {
3186 $patchtop.$e conf -state normal
3187 $patchtop.$e delete 0 end
3188 $patchtop.$e insert 0 $v
3189 $patchtop.$e conf -state readonly
3196 set oldid [$patchtop.fromsha1 get]
3197 set newid [$patchtop.tosha1 get]
3198 set fname [$patchtop.fname get]
3199 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3200 error_popup "Error creating patch: $err"
3202 catch {destroy $patchtop}
3206 proc mkpatchcan {} {
3209 catch {destroy $patchtop}
3214 global rowmenuid mktagtop commitinfo
3218 catch {destroy $top}
3220 label $top.title -text "Create tag"
3221 grid $top.title - -pady 10
3222 label $top.id -text "ID:"
3223 entry $top.sha1 -width 40 -relief flat
3224 $top.sha1 insert 0 $rowmenuid
3225 $top.sha1 conf -state readonly
3226 grid $top.id $top.sha1 -sticky w
3227 entry $top.head -width 60 -relief flat
3228 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3229 $top.head conf -state readonly
3230 grid x $top.head -sticky w
3231 label $top.tlab -text "Tag name:"
3232 entry $top.tag -width 60
3233 grid $top.tlab $top.tag -sticky w
3235 button $top.buts.gen -text "Create" -command mktaggo
3236 button $top.buts.can -text "Cancel" -command mktagcan
3237 grid $top.buts.gen $top.buts.can
3238 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3239 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3240 grid $top.buts - -pady 10 -sticky ew
3245 global mktagtop env tagids idtags
3247 set id [$mktagtop.sha1 get]
3248 set tag [$mktagtop.tag get]
3250 error_popup "No tag name specified"
3253 if {[info exists tagids($tag)]} {
3254 error_popup "Tag \"$tag\" already exists"
3259 set fname [file join $dir "refs/tags" $tag]
3260 set f [open $fname w]
3264 error_popup "Error creating tag: $err"
3268 set tagids($tag) $id
3269 lappend idtags($id) $tag
3273 proc redrawtags {id} {
3274 global canv linehtag commitrow idpos selectedline
3276 if {![info exists commitrow($id)]} return
3277 drawcmitrow $commitrow($id)
3278 $canv delete tag.$id
3279 set xt [eval drawtags $id $idpos($id)]
3280 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3281 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3282 selectline $selectedline 0
3289 catch {destroy $mktagtop}
3298 proc writecommit {} {
3299 global rowmenuid wrcomtop commitinfo wrcomcmd
3301 set top .writecommit
3303 catch {destroy $top}
3305 label $top.title -text "Write commit to file"
3306 grid $top.title - -pady 10
3307 label $top.id -text "ID:"
3308 entry $top.sha1 -width 40 -relief flat
3309 $top.sha1 insert 0 $rowmenuid
3310 $top.sha1 conf -state readonly
3311 grid $top.id $top.sha1 -sticky w
3312 entry $top.head -width 60 -relief flat
3313 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3314 $top.head conf -state readonly
3315 grid x $top.head -sticky w
3316 label $top.clab -text "Command:"
3317 entry $top.cmd -width 60 -textvariable wrcomcmd
3318 grid $top.clab $top.cmd -sticky w -pady 10
3319 label $top.flab -text "Output file:"
3320 entry $top.fname -width 60
3321 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3322 grid $top.flab $top.fname -sticky w
3324 button $top.buts.gen -text "Write" -command wrcomgo
3325 button $top.buts.can -text "Cancel" -command wrcomcan
3326 grid $top.buts.gen $top.buts.can
3327 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3328 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3329 grid $top.buts - -pady 10 -sticky ew
3336 set id [$wrcomtop.sha1 get]
3337 set cmd "echo $id | [$wrcomtop.cmd get]"
3338 set fname [$wrcomtop.fname get]
3339 if {[catch {exec sh -c $cmd >$fname &} err]} {
3340 error_popup "Error writing commit: $err"
3342 catch {destroy $wrcomtop}
3349 catch {destroy $wrcomtop}
3353 proc listrefs {id} {
3354 global idtags idheads idotherrefs
3357 if {[info exists idtags($id)]} {
3361 if {[info exists idheads($id)]} {
3365 if {[info exists idotherrefs($id)]} {
3366 set z $idotherrefs($id)
3368 return [list $x $y $z]
3371 proc rereadrefs {} {
3372 global idtags idheads idotherrefs
3373 global tagids headids otherrefids
3375 set refids [concat [array names idtags] \
3376 [array names idheads] [array names idotherrefs]]
3377 foreach id $refids {
3378 if {![info exists ref($id)]} {
3379 set ref($id) [listrefs $id]
3383 set refids [lsort -unique [concat $refids [array names idtags] \
3384 [array names idheads] [array names idotherrefs]]]
3385 foreach id $refids {
3386 set v [listrefs $id]
3387 if {![info exists ref($id)] || $ref($id) != $v} {
3393 proc showtag {tag isnew} {
3394 global ctext cflist tagcontents tagids linknum
3397 addtohistory [list showtag $tag 0]
3399 $ctext conf -state normal
3400 $ctext delete 0.0 end
3402 if {[info exists tagcontents($tag)]} {
3403 set text $tagcontents($tag)
3405 set text "Tag: $tag\nId: $tagids($tag)"
3407 appendwithlinks $text
3408 $ctext conf -state disabled
3409 $cflist delete 0 end
3419 global maxwidth maxgraphpct diffopts findmergefiles
3420 global oldprefs prefstop
3424 if {[winfo exists $top]} {
3428 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3429 set oldprefs($v) [set $v]
3432 wm title $top "Gitk preferences"
3433 label $top.ldisp -text "Commit list display options"
3434 grid $top.ldisp - -sticky w -pady 10
3435 label $top.spacer -text " "
3436 label $top.maxwidthl -text "Maximum graph width (lines)" \
3438 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3439 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3440 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3442 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3443 grid x $top.maxpctl $top.maxpct -sticky w
3444 checkbutton $top.findm -variable findmergefiles
3445 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3447 grid $top.findm $top.findml - -sticky w
3448 label $top.ddisp -text "Diff display options"
3449 grid $top.ddisp - -sticky w -pady 10
3450 label $top.diffoptl -text "Options for diff program" \
3452 entry $top.diffopt -width 20 -textvariable diffopts
3453 grid x $top.diffoptl $top.diffopt -sticky w
3455 button $top.buts.ok -text "OK" -command prefsok
3456 button $top.buts.can -text "Cancel" -command prefscan
3457 grid $top.buts.ok $top.buts.can
3458 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3459 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3460 grid $top.buts - - -pady 10 -sticky ew
3464 global maxwidth maxgraphpct diffopts findmergefiles
3465 global oldprefs prefstop
3467 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3468 set $v $oldprefs($v)
3470 catch {destroy $prefstop}
3475 global maxwidth maxgraphpct
3476 global oldprefs prefstop
3478 catch {destroy $prefstop}
3480 if {$maxwidth != $oldprefs(maxwidth)
3481 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3486 proc formatdate {d} {
3487 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3490 # This list of encoding names and aliases is distilled from
3491 # http://www.iana.org/assignments/character-sets.
3492 # Not all of them are supported by Tcl.
3493 set encoding_aliases {
3494 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3495 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3496 { ISO-10646-UTF-1 csISO10646UTF1 }
3497 { ISO_646.basic:1983 ref csISO646basic1983 }
3498 { INVARIANT csINVARIANT }
3499 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3500 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3501 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3502 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3503 { NATS-DANO iso-ir-9-1 csNATSDANO }
3504 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3505 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3506 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3507 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3508 { ISO-2022-KR csISO2022KR }
3510 { ISO-2022-JP csISO2022JP }
3511 { ISO-2022-JP-2 csISO2022JP2 }
3512 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3514 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3515 { IT iso-ir-15 ISO646-IT csISO15Italian }
3516 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3517 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3518 { greek7-old iso-ir-18 csISO18Greek7Old }
3519 { latin-greek iso-ir-19 csISO19LatinGreek }
3520 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3521 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3522 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3523 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3524 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3525 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3526 { INIS iso-ir-49 csISO49INIS }
3527 { INIS-8 iso-ir-50 csISO50INIS8 }
3528 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3529 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3530 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3531 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3532 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3533 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3535 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3536 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3537 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3538 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3539 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3540 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3541 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3542 { greek7 iso-ir-88 csISO88Greek7 }
3543 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3544 { iso-ir-90 csISO90 }
3545 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3546 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3547 csISO92JISC62991984b }
3548 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3549 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3550 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3551 csISO95JIS62291984handadd }
3552 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3553 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3554 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3555 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3557 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3558 { T.61-7bit iso-ir-102 csISO102T617bit }
3559 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3560 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3561 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3562 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3563 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3564 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3565 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3566 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3567 arabic csISOLatinArabic }
3568 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3569 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3570 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3571 greek greek8 csISOLatinGreek }
3572 { T.101-G2 iso-ir-128 csISO128T101G2 }
3573 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3575 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3576 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3577 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3578 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3579 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3580 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3581 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3582 csISOLatinCyrillic }
3583 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3584 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3585 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3586 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3587 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3588 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3589 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3590 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3591 { ISO_10367-box iso-ir-155 csISO10367Box }
3592 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3593 { latin-lap lap iso-ir-158 csISO158Lap }
3594 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3595 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3598 { JIS_X0201 X0201 csHalfWidthKatakana }
3599 { KSC5636 ISO646-KR csKSC5636 }
3600 { ISO-10646-UCS-2 csUnicode }
3601 { ISO-10646-UCS-4 csUCS4 }
3602 { DEC-MCS dec csDECMCS }
3603 { hp-roman8 roman8 r8 csHPRoman8 }
3604 { macintosh mac csMacintosh }
3605 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3607 { IBM038 EBCDIC-INT cp038 csIBM038 }
3608 { IBM273 CP273 csIBM273 }
3609 { IBM274 EBCDIC-BE CP274 csIBM274 }
3610 { IBM275 EBCDIC-BR cp275 csIBM275 }
3611 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3612 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3613 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3614 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3615 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3616 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3617 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3618 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3619 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3620 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3621 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3622 { IBM437 cp437 437 csPC8CodePage437 }
3623 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3624 { IBM775 cp775 csPC775Baltic }
3625 { IBM850 cp850 850 csPC850Multilingual }
3626 { IBM851 cp851 851 csIBM851 }
3627 { IBM852 cp852 852 csPCp852 }
3628 { IBM855 cp855 855 csIBM855 }
3629 { IBM857 cp857 857 csIBM857 }
3630 { IBM860 cp860 860 csIBM860 }
3631 { IBM861 cp861 861 cp-is csIBM861 }
3632 { IBM862 cp862 862 csPC862LatinHebrew }
3633 { IBM863 cp863 863 csIBM863 }
3634 { IBM864 cp864 csIBM864 }
3635 { IBM865 cp865 865 csIBM865 }
3636 { IBM866 cp866 866 csIBM866 }
3637 { IBM868 CP868 cp-ar csIBM868 }
3638 { IBM869 cp869 869 cp-gr csIBM869 }
3639 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3640 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3641 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3642 { IBM891 cp891 csIBM891 }
3643 { IBM903 cp903 csIBM903 }
3644 { IBM904 cp904 904 csIBBM904 }
3645 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3646 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3647 { IBM1026 CP1026 csIBM1026 }
3648 { EBCDIC-AT-DE csIBMEBCDICATDE }
3649 { EBCDIC-AT-DE-A csEBCDICATDEA }
3650 { EBCDIC-CA-FR csEBCDICCAFR }
3651 { EBCDIC-DK-NO csEBCDICDKNO }
3652 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3653 { EBCDIC-FI-SE csEBCDICFISE }
3654 { EBCDIC-FI-SE-A csEBCDICFISEA }
3655 { EBCDIC-FR csEBCDICFR }
3656 { EBCDIC-IT csEBCDICIT }
3657 { EBCDIC-PT csEBCDICPT }
3658 { EBCDIC-ES csEBCDICES }
3659 { EBCDIC-ES-A csEBCDICESA }
3660 { EBCDIC-ES-S csEBCDICESS }
3661 { EBCDIC-UK csEBCDICUK }
3662 { EBCDIC-US csEBCDICUS }
3663 { UNKNOWN-8BIT csUnknown8BiT }
3664 { MNEMONIC csMnemonic }
3669 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3670 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3671 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3672 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3673 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3674 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3675 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3676 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3677 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3678 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3679 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3680 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3681 { IBM1047 IBM-1047 }
3682 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3683 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3684 { UNICODE-1-1 csUnicode11 }
3687 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3688 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3690 { ISO-8859-15 ISO_8859-15 Latin-9 }
3691 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3692 { GBK CP936 MS936 windows-936 }
3693 { JIS_Encoding csJISEncoding }
3694 { Shift_JIS MS_Kanji csShiftJIS }
3695 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3697 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3698 { ISO-10646-UCS-Basic csUnicodeASCII }
3699 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3700 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3701 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3702 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3703 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3704 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3705 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3706 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3707 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3708 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3709 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3710 { Ventura-US csVenturaUS }
3711 { Ventura-International csVenturaInternational }
3712 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3713 { PC8-Turkish csPC8Turkish }
3714 { IBM-Symbols csIBMSymbols }
3715 { IBM-Thai csIBMThai }
3716 { HP-Legal csHPLegal }
3717 { HP-Pi-font csHPPiFont }
3718 { HP-Math8 csHPMath8 }
3719 { Adobe-Symbol-Encoding csHPPSMath }
3720 { HP-DeskTop csHPDesktop }
3721 { Ventura-Math csVenturaMath }
3722 { Microsoft-Publishing csMicrosoftPublishing }
3723 { Windows-31J csWindows31J }
3728 proc tcl_encoding {enc} {
3729 global encoding_aliases
3730 set names [encoding names]
3731 set lcnames [string tolower $names]
3732 set enc [string tolower $enc]
3733 set i [lsearch -exact $lcnames $enc]
3735 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3736 if {[regsub {^iso[-_]} $enc iso encx]} {
3737 set i [lsearch -exact $lcnames $encx]
3741 foreach l $encoding_aliases {
3742 set ll [string tolower $l]
3743 if {[lsearch -exact $ll $enc] < 0} continue
3744 # look through the aliases for one that tcl knows about
3746 set i [lsearch -exact $lcnames $e]
3748 if {[regsub {^iso[-_]} $e iso ex]} {
3749 set i [lsearch -exact $lcnames $ex]
3758 return [lindex $names $i]
3765 set diffopts "-U 5 -p"
3766 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3770 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3772 if {$gitencoding == ""} {
3773 set gitencoding "utf-8"
3775 set tclencoding [tcl_encoding $gitencoding]
3776 if {$tclencoding == {}} {
3777 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3780 set mainfont {Helvetica 9}
3781 set textfont {Courier 9}
3782 set findmergefiles 0
3791 set colors {green red blue magenta darkgrey brown orange}
3793 catch {source ~/.gitk}
3795 set namefont $mainfont
3797 font create optionfont -family sans-serif -size -12
3801 switch -regexp -- $arg {
3803 "^-d" { set datemode 1 }
3805 lappend revtreeargs $arg
3810 # check that we can find a .git directory somewhere...
3812 if {![file isdirectory $gitdir]} {
3813 error_popup "Cannot find the git directory \"$gitdir\"."
3826 makewindow $revtreeargs
3828 getcommits $revtreeargs