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 \
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 parents cdate children nchildren
76 global commitlisted commitinfo phase nextupdate
77 global stopped leftover
79 global displayorder commitidx commitrow
81 set stuff
[read $commfd]
83 if {![eof
$commfd]} return
84 # set it blocking so we wait for the process to terminate
85 fconfigure
$commfd -blocking 1
86 if {![catch
{close
$commfd} err
]} {
87 after idle finishcommits
90 if {[string range
$err 0 4] == "usage"} {
92 "Gitk: error reading commits: bad arguments to git-rev-list.\
93 (Note: arguments to gitk are passed to git-rev-list\
94 to allow selection of commits to be displayed.)"
96 set err
"Error reading commits: $err"
104 set i
[string first
"\0" $stuff $start]
106 append leftover
[string range
$stuff $start end
]
111 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
114 set cmit
[string range
$stuff $start [expr {$i - 1}]]
116 set start
[expr {$i + 1}]
117 set j
[string first
"\n" $cmit]
120 set ids
[string range
$cmit 0 [expr {$j - 1}]]
123 if {[string length
$id] != 40} {
131 if {[string length
$shortcmit] > 80} {
132 set shortcmit
"[string range $shortcmit 0 80]..."
134 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
137 set id
[lindex
$ids 0]
138 set olds
[lrange
$ids 1 end
]
139 set cmit
[string range
$cmit [expr {$j + 1}] end
]
140 set commitlisted
($id) 1
141 updatechildren
$id [lrange
$ids 1 end
]
142 if {![info exists commitinfo
($id)]} {
143 parsecommit
$id $cmit 1
145 set commitrow
($id) $commitidx
147 lappend displayorder
$id
153 if {[clock clicks
-milliseconds] >= $nextupdate} {
158 proc doupdate
{reading
} {
159 global commfd nextupdate numcommits ncmupdate
162 fileevent
$commfd readable
{}
165 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
166 if {$numcommits < 100} {
167 set ncmupdate
[expr {$numcommits + 1}]
168 } elseif
{$numcommits < 10000} {
169 set ncmupdate
[expr {$numcommits + 10}]
171 set ncmupdate
[expr {$numcommits + 100}]
174 fileevent
$commfd readable
[list getcommitlines
$commfd]
178 proc readcommit
{id
} {
179 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
180 updatechildren
$id {}
181 parsecommit
$id $contents 0
184 proc updatecommits
{rargs
} {
186 foreach v
{children nchildren parents nparents commitlisted
187 colormap selectedline matchinglines treediffs
188 mergefilelist currentid rowtextx commitrow
189 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
190 linesegends crossings cornercrossings
} {
199 proc updatechildren
{id olds
} {
200 global children nchildren parents nparents
202 if {![info exists nchildren
($id)]} {
206 set parents
($id) $olds
207 set nparents
($id) [llength
$olds]
209 if {![info exists nchildren
($p)]} {
210 set children
($p) [list
$id]
212 } elseif
{[lsearch
-exact $children($p) $id] < 0} {
213 lappend children
($p) $id
219 proc parsecommit
{id contents listed
} {
220 global commitinfo cdate
229 set hdrend
[string first
"\n\n" $contents]
231 # should never happen...
232 set hdrend
[string length
$contents]
234 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
235 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
236 foreach line
[split $header "\n"] {
237 set tag
[lindex
$line 0]
238 if {$tag == "author"} {
239 set audate
[lindex
$line end-1
]
240 set auname
[lrange
$line 1 end-2
]
241 } elseif
{$tag == "committer"} {
242 set comdate
[lindex
$line end-1
]
243 set comname
[lrange
$line 1 end-2
]
247 # take the first line of the comment as the headline
248 set i
[string first
"\n" $comment]
250 set headline
[string trim
[string range
$comment 0 $i]]
252 set headline
$comment
255 # git-rev-list indents the comment by 4 spaces;
256 # if we got this via git-cat-file, add the indentation
258 foreach line
[split $comment "\n"] {
259 append newcomment
" "
260 append newcomment
$line
261 append newcomment
"\n"
263 set comment
$newcomment
265 if {$comdate != {}} {
266 set cdate
($id) $comdate
268 set commitinfo
($id) [list
$headline $auname $audate \
269 $comname $comdate $comment]
273 global tagids idtags headids idheads tagcontents
274 global otherrefids idotherrefs
276 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
279 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
280 while {0 <= [set n
[gets
$refd line
]]} {
281 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
285 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
289 if {$type == "tags"} {
290 set tagids
($name) $id
291 lappend idtags
($id) $name
296 set commit
[exec git-rev-parse
"$id^0"]
297 if {"$commit" != "$id"} {
298 set tagids
($name) $commit
299 lappend idtags
($commit) $name
303 set tagcontents
($name) [exec git-cat-file tag
"$id"]
305 } elseif
{ $type == "heads" } {
306 set headids
($name) $id
307 lappend idheads
($id) $name
309 set otherrefids
($name) $id
310 lappend idotherrefs
($id) $name
316 proc error_popup msg
{
320 message
$w.m
-text $msg -justify center
-aspect 400
321 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
322 button
$w.ok
-text OK
-command "destroy $w"
323 pack
$w.ok
-side bottom
-fill x
324 bind $w <Visibility
> "grab $w; focus $w"
328 proc makewindow
{rargs
} {
329 global canv canv2 canv3 linespc charspc ctext cflist textfont
330 global findtype findtypemenu findloc findstring fstring geometry
331 global entries sha1entry sha1string sha1but
332 global maincursor textcursor curtextcursor
333 global rowctxmenu mergemax
336 .bar add cascade
-label "File" -menu .bar.
file
338 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
339 .bar.
file add
command -label "Reread references" -command rereadrefs
340 .bar.
file add
command -label "Quit" -command doquit
342 .bar add cascade
-label "Edit" -menu .bar.edit
343 .bar.edit add
command -label "Preferences" -command doprefs
345 .bar add cascade
-label "Help" -menu .bar.
help
346 .bar.
help add
command -label "About gitk" -command about
347 . configure
-menu .bar
349 if {![info exists geometry
(canv1
)]} {
350 set geometry
(canv1
) [expr {45 * $charspc}]
351 set geometry
(canv2
) [expr {30 * $charspc}]
352 set geometry
(canv3
) [expr {15 * $charspc}]
353 set geometry
(canvh
) [expr {25 * $linespc + 4}]
354 set geometry
(ctextw
) 80
355 set geometry
(ctexth
) 30
356 set geometry
(cflistw
) 30
358 panedwindow .ctop
-orient vertical
359 if {[info exists geometry
(width
)]} {
360 .ctop conf
-width $geometry(width
) -height $geometry(height
)
361 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
362 set geometry
(ctexth
) [expr {($texth - 8) /
363 [font metrics
$textfont -linespace]}]
367 pack .ctop.top.bar
-side bottom
-fill x
368 set cscroll .ctop.top.csb
369 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
370 pack
$cscroll -side right
-fill y
371 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
372 pack .ctop.top.clist
-side top
-fill both
-expand 1
374 set canv .ctop.top.clist.canv
375 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
377 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
378 .ctop.top.clist add
$canv
379 set canv2 .ctop.top.clist.canv2
380 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
381 -bg white
-bd 0 -yscrollincr $linespc
382 .ctop.top.clist add
$canv2
383 set canv3 .ctop.top.clist.canv3
384 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
385 -bg white
-bd 0 -yscrollincr $linespc
386 .ctop.top.clist add
$canv3
387 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
389 set sha1entry .ctop.top.bar.sha1
390 set entries
$sha1entry
391 set sha1but .ctop.top.bar.sha1label
392 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
393 -command gotocommit
-width 8
394 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
395 pack .ctop.top.bar.sha1label
-side left
396 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
397 trace add variable sha1string
write sha1change
398 pack
$sha1entry -side left
-pady 2
400 image create bitmap bm-left
-data {
401 #define left_width 16
402 #define left_height 16
403 static unsigned char left_bits
[] = {
404 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
405 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
406 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
408 image create bitmap bm-right
-data {
409 #define right_width 16
410 #define right_height 16
411 static unsigned char right_bits
[] = {
412 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
413 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
414 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
416 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
417 -state disabled
-width 26
418 pack .ctop.top.bar.leftbut
-side left
-fill y
419 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
420 -state disabled
-width 26
421 pack .ctop.top.bar.rightbut
-side left
-fill y
423 button .ctop.top.bar.findbut
-text "Find" -command dofind
424 pack .ctop.top.bar.findbut
-side left
426 set fstring .ctop.top.bar.findstring
427 lappend entries
$fstring
428 entry
$fstring -width 30 -font $textfont -textvariable findstring
429 pack
$fstring -side left
-expand 1 -fill x
431 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
432 findtype Exact IgnCase Regexp
]
433 set findloc
"All fields"
434 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
435 Comments Author Committer Files Pickaxe
436 pack .ctop.top.bar.findloc
-side right
437 pack .ctop.top.bar.findtype
-side right
438 # for making sure type==Exact whenever loc==Pickaxe
439 trace add variable findloc
write findlocchange
441 panedwindow .ctop.cdet
-orient horizontal
443 frame .ctop.cdet.left
444 set ctext .ctop.cdet.left.ctext
445 text
$ctext -bg white
-state disabled
-font $textfont \
446 -width $geometry(ctextw
) -height $geometry(ctexth
) \
447 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
448 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
449 pack .ctop.cdet.left.sb
-side right
-fill y
450 pack
$ctext -side left
-fill both
-expand 1
451 .ctop.cdet add .ctop.cdet.left
453 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
454 $ctext tag conf hunksep
-fore blue
455 $ctext tag conf d0
-fore red
456 $ctext tag conf d1
-fore "#00a000"
457 $ctext tag conf m0
-fore red
458 $ctext tag conf m1
-fore blue
459 $ctext tag conf m2
-fore green
460 $ctext tag conf m3
-fore purple
461 $ctext tag conf
m4 -fore brown
462 $ctext tag conf m5
-fore "#009090"
463 $ctext tag conf m6
-fore magenta
464 $ctext tag conf m7
-fore "#808000"
465 $ctext tag conf m8
-fore "#009000"
466 $ctext tag conf m9
-fore "#ff0080"
467 $ctext tag conf m10
-fore cyan
468 $ctext tag conf m11
-fore "#b07070"
469 $ctext tag conf m12
-fore "#70b0f0"
470 $ctext tag conf m13
-fore "#70f0b0"
471 $ctext tag conf m14
-fore "#f0b070"
472 $ctext tag conf m15
-fore "#ff70b0"
473 $ctext tag conf mmax
-fore darkgrey
475 $ctext tag conf mresult
-font [concat
$textfont bold
]
476 $ctext tag conf msep
-font [concat
$textfont bold
]
477 $ctext tag conf found
-back yellow
479 frame .ctop.cdet.right
480 set cflist .ctop.cdet.right.cfiles
481 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
482 -yscrollcommand ".ctop.cdet.right.sb set"
483 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
484 pack .ctop.cdet.right.sb
-side right
-fill y
485 pack
$cflist -side left
-fill both
-expand 1
486 .ctop.cdet add .ctop.cdet.right
487 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
489 pack .ctop
-side top
-fill both
-expand 1
491 bindall
<1> {selcanvline
%W
%x
%y
}
492 #bindall <B1-Motion> {selcanvline %W %x %y}
493 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
494 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
495 bindall
<2> "allcanvs scan mark 0 %y"
496 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
497 bind .
<Key-Up
> "selnextline -1"
498 bind .
<Key-Down
> "selnextline 1"
499 bind .
<Key-Right
> "goforw"
500 bind .
<Key-Left
> "goback"
501 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
502 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
503 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
504 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
505 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
506 bindkey p
"selnextline -1"
507 bindkey n
"selnextline 1"
510 bindkey i
"selnextline -1"
511 bindkey k
"selnextline 1"
514 bindkey b
"$ctext yview scroll -1 pages"
515 bindkey d
"$ctext yview scroll 18 units"
516 bindkey u
"$ctext yview scroll -18 units"
517 bindkey
/ {findnext
1}
518 bindkey
<Key-Return
> {findnext
0}
521 bind .
<Control-q
> doquit
522 bind .
<Control-f
> dofind
523 bind .
<Control-g
> {findnext
0}
524 bind .
<Control-r
> findprev
525 bind .
<Control-equal
> {incrfont
1}
526 bind .
<Control-KP_Add
> {incrfont
1}
527 bind .
<Control-minus
> {incrfont
-1}
528 bind .
<Control-KP_Subtract
> {incrfont
-1}
529 bind $cflist <<ListboxSelect>> listboxsel
530 bind . <Destroy> {savestuff %W}
531 bind . <Button-1> "click %W"
532 bind $fstring <Key-Return> dofind
533 bind $sha1entry <Key-Return> gotocommit
534 bind $sha1entry <<PasteSelection>> clearsha1
536 set maincursor [. cget -cursor]
537 set textcursor [$ctext cget -cursor]
538 set curtextcursor $textcursor
540 set rowctxmenu .rowctxmenu
541 menu $rowctxmenu -tearoff 0
542 $rowctxmenu add command -label "Diff this -> selected" \
543 -command {diffvssel 0}
544 $rowctxmenu add command -label "Diff selected -> this" \
545 -command {diffvssel 1}
546 $rowctxmenu add command -label "Make patch" -command mkpatch
547 $rowctxmenu add command -label "Create tag" -command mktag
548 $rowctxmenu add command -label "Write commit to file" -command writecommit
551 proc scrollcanv {cscroll f0 f1} {
556 # when we make a key binding for the toplevel, make sure
557 # it doesn't get triggered when that key is pressed in the
558 # find string entry widget.
559 proc bindkey {ev script} {
562 set escript [bind Entry $ev]
563 if {$escript == {}} {
564 set escript [bind Entry <Key>]
567 bind $e $ev "$escript; break"
571 # set the focus back to the toplevel for any click outside
582 global canv canv2 canv3 ctext cflist mainfont textfont
583 global stuffsaved findmergefiles maxgraphpct
586 if {$stuffsaved} return
587 if {![winfo viewable .]} return
589 set f [open "~/.gitk-new" w]
590 puts $f [list set mainfont $mainfont]
591 puts $f [list set textfont $textfont]
592 puts $f [list set findmergefiles $findmergefiles]
593 puts $f [list set maxgraphpct $maxgraphpct]
594 puts $f [list set maxwidth $maxwidth]
595 puts $f "set geometry(width) [winfo width .ctop]"
596 puts $f "set geometry(height) [winfo height .ctop]"
597 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
598 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
599 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
600 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
601 set wid [expr {([winfo width $ctext] - 8) \
602 / [font measure $textfont "0"]}]
603 puts $f "set geometry(ctextw) $wid"
604 set wid [expr {([winfo width $cflist] - 11) \
605 / [font measure [$cflist cget -font] "0"]}]
606 puts $f "set geometry(cflistw) $wid"
608 file rename -force "~/.gitk-new" "~/.gitk"
613 proc resizeclistpanes {win w} {
615 if {[info exists oldwidth($win)]} {
616 set s0 [$win sash coord 0]
617 set s1 [$win sash coord 1]
619 set sash0 [expr {int($w/2 - 2)}]
620 set sash1 [expr {int($w*5/6 - 2)}]
622 set factor [expr {1.0 * $w / $oldwidth($win)}]
623 set sash0 [expr {int($factor * [lindex $s0 0])}]
624 set sash1 [expr {int($factor * [lindex $s1 0])}]
628 if {$sash1 < $sash0 + 20} {
629 set sash1 [expr {$sash0 + 20}]
631 if {$sash1 > $w - 10} {
632 set sash1 [expr {$w - 10}]
633 if {$sash0 > $sash1 - 20} {
634 set sash0 [expr {$sash1 - 20}]
638 $win sash place 0 $sash0 [lindex $s0 1]
639 $win sash place 1 $sash1 [lindex $s1 1]
641 set oldwidth($win) $w
644 proc resizecdetpanes {win w} {
646 if {[info exists oldwidth($win)]} {
647 set s0 [$win sash coord 0]
649 set sash0 [expr {int($w*3/4 - 2)}]
651 set factor [expr {1.0 * $w / $oldwidth($win)}]
652 set sash0 [expr {int($factor * [lindex $s0 0])}]
656 if {$sash0 > $w - 15} {
657 set sash0 [expr {$w - 15}]
660 $win sash place 0 $sash0 [lindex $s0 1]
662 set oldwidth($win) $w
666 global canv canv2 canv3
672 proc bindall {event action} {
673 global canv canv2 canv3
674 bind $canv $event $action
675 bind $canv2 $event $action
676 bind $canv3 $event $action
681 if {[winfo exists $w]} {
686 wm title $w "About gitk"
688 Gitk - a commit viewer for git
690 Copyright © 2005-2006 Paul Mackerras
692 Use and redistribute under the terms of the GNU General Public License} \
693 -justify center -aspect 400
694 pack $w.m -side top -fill x -padx 20 -pady 20
695 button $w.ok -text Close -command "destroy $w"
696 pack $w.ok -side bottom
699 proc shortids {ids} {
702 if {[llength $id] > 1} {
703 lappend res [shortids $id]
704 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
705 lappend res [string range $id 0 7]
713 proc incrange {l x o} {
718 lset l $x [expr {$e + $o}]
727 for {} {$n > 0} {incr n -1} {
733 proc usedinrange {id l1 l2} {
734 global children commitrow
736 if {[info exists commitrow($id)]} {
737 set r $commitrow($id)
738 if {$l1 <= $r && $r <= $l2} {
739 return [expr {$r - $l1 + 1}]
742 foreach c $children($id) {
743 if {[info exists commitrow($c)]} {
745 if {$l1 <= $r && $r <= $l2} {
746 return [expr {$r - $l1 + 1}]
753 proc sanity {row {full 0}} {
754 global rowidlist rowoffsets
757 set ids [lindex $rowidlist $row]
760 if {$id eq {}} continue
761 if {$col < [llength $ids] - 1 &&
762 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
763 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
765 set o [lindex $rowoffsets $row $col]
771 if {[lindex $rowidlist $y $x] != $id} {
772 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
773 puts " id=[shortids $id] check started at row $row"
774 for {set i $row} {$i >= $y} {incr i -1} {
775 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
780 set o [lindex $rowoffsets $y $x]
785 proc makeuparrow {oid x y z} {
786 global rowidlist rowoffsets uparrowlen idrowranges
788 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
791 set off0 [lindex $rowoffsets $y]
792 for {set x0 $x} {1} {incr x0} {
793 if {$x0 >= [llength $off0]} {
794 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
797 set z [lindex $off0 $x0]
803 set z [expr {$x0 - $x}]
804 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
805 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
807 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
808 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
809 lappend idrowranges($oid) $y
813 global rowidlist rowoffsets displayorder
814 global rowlaidout rowoptim
815 global idinlist rowchk
816 global commitidx numcommits
825 catch {unset idinlist}
831 proc visiblerows {} {
832 global canv numcommits linespc
834 set ymax [lindex [$canv cget -scrollregion] 3]
835 if {$ymax eq {} || $ymax == 0} return
837 set y0 [expr {int([lindex $f 0] * $ymax)}]
838 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
842 set y1 [expr {int([lindex $f 1] * $ymax)}]
843 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
844 if {$r1 >= $numcommits} {
845 set r1 [expr {$numcommits - 1}]
847 return [list $r0 $r1]
851 global rowlaidout rowoptim commitidx numcommits optim_delay
855 set rowlaidout [layoutrows $row $commitidx 0]
856 set orow [expr {$rowlaidout - $uparrowlen - 1}]
857 if {$orow > $rowoptim} {
858 checkcrossings $rowoptim $orow
859 optimize_rows $rowoptim 0 $orow
862 set canshow [expr {$rowoptim - $optim_delay}]
863 if {$canshow > $numcommits} {
868 proc showstuff {canshow} {
870 global canvy0 linespc
871 global linesegends idrowranges idrangedrawn
873 if {$numcommits == 0} {
879 set numcommits $canshow
880 allcanvs conf -scrollregion \
881 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
882 set rows [visiblerows]
883 set r0 [lindex $rows 0]
884 set r1 [lindex $rows 1]
885 for {set r $row} {$r < $canshow} {incr r} {
886 if {[info exists linesegends($r)]} {
887 foreach id $linesegends($r) {
889 foreach {s e} $idrowranges($id) {
891 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
892 && ![info exists idrangedrawn($id,$i)]} {
894 set idrangedrawn($id,$i) 1
900 if {$canshow > $r1} {
903 while {$row < $canshow} {
909 proc layoutrows {row endrow last} {
910 global rowidlist rowoffsets displayorder
911 global uparrowlen downarrowlen maxwidth mingaplen
912 global nchildren parents nparents
913 global idrowranges linesegends
915 global idinlist rowchk
917 set idlist [lindex $rowidlist $row]
918 set offs [lindex $rowoffsets $row]
919 while {$row < $endrow} {
920 set id [lindex $displayorder $row]
923 foreach p $parents($id) {
924 if {![info exists idinlist($p)]} {
926 } elseif {!$idinlist($p)} {
930 set nev [expr {[llength $idlist] + [llength $newolds]
931 + [llength $oldolds] - $maxwidth + 1}]
933 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
934 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
935 set i [lindex $idlist $x]
936 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
937 set r [usedinrange $i [expr {$row - $downarrowlen}] \
938 [expr {$row + $uparrowlen + $mingaplen}]]
940 set idlist [lreplace $idlist $x $x]
941 set offs [lreplace $offs $x $x]
942 set offs [incrange $offs $x 1]
944 lappend linesegends($row) $i
945 lappend idrowranges($i) [expr {$row-1}]
946 if {[incr nev -1] <= 0} break
949 set rowchk($id) [expr {$row + $r}]
952 lset rowidlist $row $idlist
953 lset rowoffsets $row $offs
955 set col [lsearch -exact $idlist $id]
957 set col [llength $idlist]
959 lset rowidlist $row $idlist
961 if {$nchildren($id) > 0} {
962 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
966 lset rowoffsets $row $offs
968 makeuparrow $id $col $row $z
973 if {[info exists idrowranges($id)]} {
974 lappend linesegends($row) $id
975 lappend idrowranges($id) $row
978 set offs [ntimes [llength $idlist] 0]
979 set l [llength $newolds]
980 set idlist [eval lreplace \$idlist $col $col $newolds]
983 set offs [lrange $offs 0 [expr {$col - 1}]]
989 set tmp [expr {[llength $idlist] - [llength $offs]}]
991 set offs [concat $offs [ntimes $tmp $o]]
998 set idrowranges($i) $row
1001 foreach oid $oldolds {
1002 set idinlist($oid) 1
1003 set idlist [linsert $idlist $col $oid]
1004 set offs [linsert $offs $col $o]
1005 makeuparrow $oid $col $row $o
1008 lappend rowidlist $idlist
1009 lappend rowoffsets $offs
1014 proc addextraid {id row} {
1015 global displayorder commitrow commitinfo nparents
1019 lappend displayorder $id
1020 set commitrow($id) $row
1022 if {![info exists commitinfo($id)]} {
1023 set commitinfo($id) {"No commit information available"}
1028 proc layouttail {} {
1029 global rowidlist rowoffsets idinlist commitidx
1030 global idrowranges linesegends
1033 set idlist [lindex $rowidlist $row]
1034 while {$idlist ne {}} {
1035 set col [expr {[llength $idlist] - 1}]
1036 set id [lindex $idlist $col]
1039 lappend linesegends($row) $id
1040 lappend idrowranges($id) $row
1042 set offs [ntimes $col 0]
1043 set idlist [lreplace $idlist $col $col]
1044 lappend rowidlist $idlist
1045 lappend rowoffsets $offs
1048 foreach id [array names idinlist] {
1050 lset rowidlist $row [list $id]
1051 lset rowoffsets $row 0
1052 makeuparrow $id 0 $row 0
1053 lappend linesegends($row) $id
1054 lappend idrowranges($id) $row
1056 lappend rowidlist {}
1057 lappend rowoffsets {}
1061 proc insert_pad {row col npad} {
1062 global rowidlist rowoffsets
1064 set pad [ntimes $npad {}]
1065 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1066 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1067 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1070 proc optimize_rows {row col endrow} {
1071 global rowidlist rowoffsets idrowranges
1073 for {} {$row < $endrow} {incr row} {
1074 set idlist [lindex $rowidlist $row]
1075 set offs [lindex $rowoffsets $row]
1077 for {} {$col < [llength $offs]} {incr col} {
1078 if {[lindex $idlist $col] eq {}} {
1082 set z [lindex $offs $col]
1083 if {$z eq {}} continue
1085 set x0 [expr {$col + $z}]
1086 set y0 [expr {$row - 1}]
1087 set z0 [lindex $rowoffsets $y0 $x0]
1089 set id [lindex $idlist $col]
1090 if {[info exists idrowranges($id)] &&
1091 $y0 > [lindex $idrowranges($id) 0]} {
1095 if {$z < -1 || ($z < 0 && $isarrow)} {
1096 set npad [expr {-1 - $z + $isarrow}]
1097 set offs [incrange $offs $col $npad]
1098 insert_pad $y0 $x0 $npad
1100 optimize_rows $y0 $x0 $row
1102 set z [lindex $offs $col]
1103 set x0 [expr {$col + $z}]
1104 set z0 [lindex $rowoffsets $y0 $x0]
1105 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1106 set npad [expr {$z - 1 + $isarrow}]
1107 set y1 [expr {$row + 1}]
1108 set offs2 [lindex $rowoffsets $y1]
1112 if {$z eq {} || $x1 + $z < $col} continue
1113 if {$x1 + $z > $col} {
1116 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1119 set pad [ntimes $npad {}]
1120 set idlist [eval linsert \$idlist $col $pad]
1121 set tmp [eval linsert \$offs $col $pad]
1123 set offs [incrange $tmp $col [expr {-$npad}]]
1124 set z [lindex $offs $col]
1127 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1128 insert_pad $y0 $x0 1
1129 set offs [incrange $offs $col 1]
1130 optimize_rows $y0 [expr {$x0 + 1}] $row
1134 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1135 set o [lindex $offs $col]
1136 if {$o eq {} || $o <= 0} break
1138 if {[incr col] < [llength $idlist]} {
1139 set y1 [expr {$row + 1}]
1140 set offs2 [lindex $rowoffsets $y1]
1144 if {$z eq {} || $x1 + $z < $col} continue
1145 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1148 set idlist [linsert $idlist $col {}]
1149 set tmp [linsert $offs $col {}]
1151 set offs [incrange $tmp $col -1]
1154 lset rowidlist $row $idlist
1155 lset rowoffsets $row $offs
1161 global canvx0 linespc
1162 return [expr {$canvx0 + $col * $linespc}]
1166 global canvy0 linespc
1167 return [expr {$canvy0 + $row * $linespc}]
1170 proc drawlineseg {id i wid} {
1171 global rowoffsets rowidlist idrowranges
1172 global canv colormap lthickness
1174 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1175 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1176 if {$startrow == $row} return
1179 set col [lsearch -exact [lindex $rowidlist $row] $id]
1181 puts "oops: drawline: id $id not on row $row"
1187 set o [lindex $rowoffsets $row $col]
1190 # changing direction
1191 set x [xc $row $col]
1193 lappend coords $x $y
1199 if {$coords eq {}} return
1200 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1201 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1202 set arrow [lindex {none first last both} $arrow]
1203 set wid [expr {$wid * $lthickness}]
1204 set x [xc $row $col]
1206 lappend coords $x $y
1207 set t [$canv create line $coords -width $wid \
1208 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1213 proc drawparentlinks {id row col olds wid} {
1214 global rowidlist canv colormap lthickness
1216 set row2 [expr {$row + 1}]
1217 set x [xc $row $col]
1220 set ids [lindex $rowidlist $row2]
1221 # rmx = right-most X coord used
1223 set wid [expr {$wid * $lthickness}]
1225 set i [lsearch -exact $ids $p]
1227 puts "oops, parent $p of $id not in list"
1231 # should handle duplicated parents here...
1232 set coords [list $x $y]
1233 if {$i < $col - 1} {
1234 lappend coords [xc $row [expr {$i + 1}]] $y
1235 } elseif {$i > $col + 1} {
1236 lappend coords [xc $row [expr {$i - 1}]] $y
1238 set x2 [xc $row2 $i]
1242 lappend coords $x2 $y2
1243 set t [$canv create line $coords -width $wid \
1244 -fill $colormap($p) -tags lines.$p]
1251 proc drawlines {id xtra} {
1252 global colormap canv
1253 global idrowranges idrangedrawn
1254 global children iddrawn commitrow rowidlist
1256 $canv delete lines.$id
1257 set wid [expr {$xtra + 1}]
1258 set nr [expr {[llength $idrowranges($id)] / 2}]
1259 for {set i 0} {$i < $nr} {incr i} {
1260 if {[info exists idrangedrawn($id,$i)]} {
1261 drawlineseg $id $i $wid
1264 if {[info exists children($id)]} {
1265 foreach child $children($id) {
1266 if {[info exists iddrawn($child)]} {
1267 set row $commitrow($child)
1268 set col [lsearch -exact [lindex $rowidlist $row] $child]
1270 drawparentlinks $child $row $col [list $id] $wid
1277 proc drawcmittext {id row col rmx} {
1278 global linespc canv canv2 canv3 canvy0
1279 global commitlisted commitinfo rowidlist
1280 global rowtextx idpos idtags idheads idotherrefs
1281 global linehtag linentag linedtag
1282 global mainfont namefont
1284 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1285 set x [xc $row $col]
1287 set orad [expr {$linespc / 3}]
1288 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1289 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1290 -fill $ofill -outline black -width 1]
1292 $canv bind $t <1> {selcanvline {} %x %y}
1293 set xt [xc $row [llength [lindex $rowidlist $row]]]
1297 set rowtextx($row) $xt
1298 set idpos($id) [list $x $xt $y]
1299 if {[info exists idtags($id)] || [info exists idheads($id)]
1300 || [info exists idotherrefs($id)]} {
1301 set xt [drawtags $id $x $xt $y]
1303 set headline [lindex $commitinfo($id) 0]
1304 set name [lindex $commitinfo($id) 1]
1305 set date [lindex $commitinfo($id) 2]
1306 set date [formatdate $date]
1307 set linehtag($row) [$canv create text $xt $y -anchor w \
1308 -text $headline -font $mainfont ]
1309 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1310 set linentag($row) [$canv2 create text 3 $y -anchor w \
1311 -text $name -font $namefont]
1312 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1313 -text $date -font $mainfont]
1316 proc drawcmitrow {row} {
1317 global displayorder rowidlist
1318 global idrowranges idrangedrawn iddrawn
1319 global commitinfo commitlisted parents numcommits
1321 if {$row >= $numcommits} return
1322 foreach id [lindex $rowidlist $row] {
1323 if {![info exists idrowranges($id)]} continue
1325 foreach {s e} $idrowranges($id) {
1327 if {$row < $s} continue
1330 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1331 drawlineseg $id $i 1
1332 set idrangedrawn($id,$i) 1
1339 set id [lindex $displayorder $row]
1340 if {[info exists iddrawn($id)]} return
1341 set col [lsearch -exact [lindex $rowidlist $row] $id]
1343 puts "oops, row $row id $id not in list"
1346 if {![info exists commitinfo($id)]} {
1348 if {![info exists commitinfo($id)]} {
1349 set commitinfo($id) {"No commit information available"}
1354 if {[info exists commitlisted($id)] && [info exists parents($id)]
1355 && $parents($id) ne {}} {
1356 set rmx [drawparentlinks $id $row $col $parents($id) 1]
1360 drawcmittext $id $row $col $rmx
1364 proc drawfrac {f0 f1} {
1365 global numcommits canv
1368 set ymax [lindex [$canv cget -scrollregion] 3]
1369 if {$ymax eq {} || $ymax == 0} return
1370 set y0 [expr {int($f0 * $ymax)}]
1371 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1375 set y1 [expr {int($f1 * $ymax)}]
1376 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1377 if {$endrow >= $numcommits} {
1378 set endrow [expr {$numcommits - 1}]
1380 for {} {$row <= $endrow} {incr row} {
1385 proc drawvisible {} {
1387 eval drawfrac [$canv yview]
1390 proc clear_display {} {
1391 global iddrawn idrangedrawn
1394 catch {unset iddrawn}
1395 catch {unset idrangedrawn}
1398 proc assigncolor {id} {
1399 global colormap colors nextcolor
1400 global parents nparents children nchildren
1401 global cornercrossings crossings
1403 if {[info exists colormap($id)]} return
1404 set ncolors [llength $colors]
1405 if {$nchildren($id) == 1} {
1406 set child [lindex $children($id) 0]
1407 if {[info exists colormap($child)]
1408 && $nparents($child) == 1} {
1409 set colormap($id) $colormap($child)
1414 if {[info exists cornercrossings($id)]} {
1415 foreach x $cornercrossings($id) {
1416 if {[info exists colormap($x)]
1417 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1418 lappend badcolors $colormap($x)
1421 if {[llength $badcolors] >= $ncolors} {
1425 set origbad $badcolors
1426 if {[llength $badcolors] < $ncolors - 1} {
1427 if {[info exists crossings($id)]} {
1428 foreach x $crossings($id) {
1429 if {[info exists colormap($x)]
1430 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1431 lappend badcolors $colormap($x)
1434 if {[llength $badcolors] >= $ncolors} {
1435 set badcolors $origbad
1438 set origbad $badcolors
1440 if {[llength $badcolors] < $ncolors - 1} {
1441 foreach child $children($id) {
1442 if {[info exists colormap($child)]
1443 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1444 lappend badcolors $colormap($child)
1446 if {[info exists parents($child)]} {
1447 foreach p $parents($child) {
1448 if {[info exists colormap($p)]
1449 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1450 lappend badcolors $colormap($p)
1455 if {[llength $badcolors] >= $ncolors} {
1456 set badcolors $origbad
1459 for {set i 0} {$i <= $ncolors} {incr i} {
1460 set c [lindex $colors $nextcolor]
1461 if {[incr nextcolor] >= $ncolors} {
1464 if {[lsearch -exact $badcolors $c]} break
1466 set colormap($id) $c
1469 proc bindline {t id} {
1472 $canv bind $t <Enter> "lineenter %x %y $id"
1473 $canv bind $t <Motion> "linemotion %x %y $id"
1474 $canv bind $t <Leave> "lineleave $id"
1475 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1478 proc drawtags {id x xt y1} {
1479 global idtags idheads idotherrefs
1480 global linespc lthickness
1481 global canv mainfont commitrow rowtextx
1486 if {[info exists idtags($id)]} {
1487 set marks $idtags($id)
1488 set ntags [llength $marks]
1490 if {[info exists idheads($id)]} {
1491 set marks [concat $marks $idheads($id)]
1492 set nheads [llength $idheads($id)]
1494 if {[info exists idotherrefs($id)]} {
1495 set marks [concat $marks $idotherrefs($id)]
1501 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1502 set yt [expr {$y1 - 0.5 * $linespc}]
1503 set yb [expr {$yt + $linespc - 1}]
1506 foreach tag $marks {
1507 set wid [font measure $mainfont $tag]
1510 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1512 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1513 -width $lthickness -fill black -tags tag.$id]
1515 foreach tag $marks x $xvals wid $wvals {
1516 set xl [expr {$x + $delta}]
1517 set xr [expr {$x + $delta + $wid + $lthickness}]
1518 if {[incr ntags -1] >= 0} {
1520 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1521 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1522 -width 1 -outline black -fill yellow -tags tag.$id]
1523 $canv bind $t <1> [list showtag $tag 1]
1524 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1526 # draw a head or other ref
1527 if {[incr nheads -1] >= 0} {
1532 set xl [expr {$xl - $delta/2}]
1533 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1534 -width 1 -outline black -fill $col -tags tag.$id
1536 set t [$canv create text $xl $y1 -anchor w -text $tag \
1537 -font $mainfont -tags tag.$id]
1539 $canv bind $t <1> [list showtag $tag 1]
1545 proc checkcrossings {row endrow} {
1546 global displayorder parents rowidlist
1548 for {} {$row < $endrow} {incr row} {
1549 set id [lindex $displayorder $row]
1550 set i [lsearch -exact [lindex $rowidlist $row] $id]
1551 if {$i < 0} continue
1552 set idlist [lindex $rowidlist [expr {$row+1}]]
1553 foreach p $parents($id) {
1554 set j [lsearch -exact $idlist $p]
1557 notecrossings $row $p $j $i [expr {$j+1}]
1558 } elseif {$j > $i + 1} {
1559 notecrossings $row $p $i $j [expr {$j-1}]
1566 proc notecrossings {row id lo hi corner} {
1567 global rowidlist crossings cornercrossings
1569 for {set i $lo} {[incr i] < $hi} {} {
1570 set p [lindex [lindex $rowidlist $row] $i]
1571 if {$p == {}} continue
1572 if {$i == $corner} {
1573 if {![info exists cornercrossings($id)]
1574 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1575 lappend cornercrossings($id) $p
1577 if {![info exists cornercrossings($p)]
1578 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1579 lappend cornercrossings($p) $id
1582 if {![info exists crossings($id)]
1583 || [lsearch -exact $crossings($id) $p] < 0} {
1584 lappend crossings($id) $p
1586 if {![info exists crossings($p)]
1587 || [lsearch -exact $crossings($p) $id] < 0} {
1588 lappend crossings($p) $id
1594 proc xcoord {i level ln} {
1595 global canvx0 xspc1 xspc2
1597 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1598 if {$i > 0 && $i == $level} {
1599 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1600 } elseif {$i > $level} {
1601 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1606 proc finishcommits {} {
1608 global canv mainfont ctext maincursor textcursor
1610 if {$phase == "incrdraw"} {
1614 $canv create text 3 3 -anchor nw -text "No commits selected" \
1615 -font $mainfont -tags textitems
1618 . config -cursor $maincursor
1619 settextcursor $textcursor
1622 # Don't change the text pane cursor if it is currently the hand cursor,
1623 # showing that we are over a sha1 ID link.
1624 proc settextcursor {c} {
1625 global ctext curtextcursor
1627 if {[$ctext cget -cursor] == $curtextcursor} {
1628 $ctext config -cursor $c
1630 set curtextcursor $c
1637 global canvy0 numcommits linespc
1638 global rowlaidout commitidx
1641 layoutrows $rowlaidout $commitidx 1
1643 optimize_rows $row 0 $commitidx
1644 showstuff $commitidx
1647 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1648 #puts "overall $drawmsecs ms for $numcommits commits"
1651 proc findmatches {f} {
1652 global findtype foundstring foundstrlen
1653 if {$findtype == "Regexp"} {
1654 set matches [regexp -indices -all -inline $foundstring $f]
1656 if {$findtype == "IgnCase"} {
1657 set str [string tolower $f]
1663 while {[set j [string first $foundstring $str $i]] >= 0} {
1664 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1665 set i [expr {$j + $foundstrlen}]
1672 global findtype findloc findstring markedmatches commitinfo
1673 global numcommits displayorder linehtag linentag linedtag
1674 global mainfont namefont canv canv2 canv3 selectedline
1675 global matchinglines foundstring foundstrlen
1680 set matchinglines {}
1681 if {$findloc == "Pickaxe"} {
1685 if {$findtype == "IgnCase"} {
1686 set foundstring [string tolower $findstring]
1688 set foundstring $findstring
1690 set foundstrlen [string length $findstring]
1691 if {$foundstrlen == 0} return
1692 if {$findloc == "Files"} {
1696 if {![info exists selectedline]} {
1699 set oldsel $selectedline
1702 set fldtypes {Headline Author Date Committer CDate Comment}
1703 for {set l 0} {$l < $numcommits} {incr l} {
1704 set id [lindex $displayorder $l]
1705 set info $commitinfo($id)
1707 foreach f $info ty $fldtypes {
1708 if {$findloc != "All fields" && $findloc != $ty} {
1711 set matches [findmatches $f]
1712 if {$matches == {}} continue
1714 if {$ty == "Headline"} {
1716 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1717 } elseif {$ty == "Author"} {
1719 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1720 } elseif {$ty == "Date"} {
1722 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1726 lappend matchinglines $l
1727 if {!$didsel && $l > $oldsel} {
1733 if {$matchinglines == {}} {
1735 } elseif {!$didsel} {
1736 findselectline [lindex $matchinglines 0]
1740 proc findselectline {l} {
1741 global findloc commentend ctext
1743 if {$findloc == "All fields" || $findloc == "Comments"} {
1744 # highlight the matches in the comments
1745 set f [$ctext get 1.0 $commentend]
1746 set matches [findmatches $f]
1747 foreach match $matches {
1748 set start [lindex $match 0]
1749 set end [expr {[lindex $match 1] + 1}]
1750 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1755 proc findnext {restart} {
1756 global matchinglines selectedline
1757 if {![info exists matchinglines]} {
1763 if {![info exists selectedline]} return
1764 foreach l $matchinglines {
1765 if {$l > $selectedline} {
1774 global matchinglines selectedline
1775 if {![info exists matchinglines]} {
1779 if {![info exists selectedline]} return
1781 foreach l $matchinglines {
1782 if {$l >= $selectedline} break
1786 findselectline $prev
1792 proc findlocchange {name ix op} {
1793 global findloc findtype findtypemenu
1794 if {$findloc == "Pickaxe"} {
1800 $findtypemenu entryconf 1 -state $state
1801 $findtypemenu entryconf 2 -state $state
1804 proc stopfindproc {{done 0}} {
1805 global findprocpid findprocfile findids
1806 global ctext findoldcursor phase maincursor textcursor
1807 global findinprogress
1809 catch {unset findids}
1810 if {[info exists findprocpid]} {
1812 catch {exec kill $findprocpid}
1814 catch {close $findprocfile}
1817 if {[info exists findinprogress]} {
1818 unset findinprogress
1819 if {$phase != "incrdraw"} {
1820 . config -cursor $maincursor
1821 settextcursor $textcursor
1826 proc findpatches {} {
1827 global findstring selectedline numcommits
1828 global findprocpid findprocfile
1829 global finddidsel ctext displayorder findinprogress
1830 global findinsertpos
1832 if {$numcommits == 0} return
1834 # make a list of all the ids to search, starting at the one
1835 # after the selected line (if any)
1836 if {[info exists selectedline]} {
1842 for {set i 0} {$i < $numcommits} {incr i} {
1843 if {[incr l] >= $numcommits} {
1846 append inputids [lindex $displayorder $l] "\n"
1850 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1853 error_popup "Error starting search process: $err"
1857 set findinsertpos end
1859 set findprocpid [pid $f]
1860 fconfigure $f -blocking 0
1861 fileevent $f readable readfindproc
1863 . config -cursor watch
1865 set findinprogress 1
1868 proc readfindproc {} {
1869 global findprocfile finddidsel
1870 global commitrow matchinglines findinsertpos
1872 set n [gets $findprocfile line]
1874 if {[eof $findprocfile]} {
1882 if {![regexp {^[0-9a-f]{40}} $line id]} {
1883 error_popup "Can't parse git-diff-tree output: $line"
1887 if {![info exists commitrow($id)]} {
1888 puts stderr "spurious id: $id"
1891 set l $commitrow($id)
1895 proc insertmatch {l id} {
1896 global matchinglines findinsertpos finddidsel
1898 if {$findinsertpos == "end"} {
1899 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1900 set matchinglines [linsert $matchinglines 0 $l]
1903 lappend matchinglines $l
1906 set matchinglines [linsert $matchinglines $findinsertpos $l]
1917 global selectedline numcommits displayorder ctext
1918 global ffileline finddidsel parents nparents
1919 global findinprogress findstartline findinsertpos
1920 global treediffs fdiffid fdiffsneeded fdiffpos
1921 global findmergefiles
1923 if {$numcommits == 0} return
1925 if {[info exists selectedline]} {
1926 set l [expr {$selectedline + 1}]
1931 set findstartline $l
1935 set id [lindex $displayorder $l]
1936 if {$findmergefiles || $nparents($id) == 1} {
1937 if {![info exists treediffs($id)]} {
1938 append diffsneeded "$id\n"
1939 lappend fdiffsneeded $id
1942 if {[incr l] >= $numcommits} {
1945 if {$l == $findstartline} break
1948 # start off a git-diff-tree process if needed
1949 if {$diffsneeded ne {}} {
1951 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1953 error_popup "Error starting search process: $err"
1956 catch {unset fdiffid}
1958 fconfigure $df -blocking 0
1959 fileevent $df readable [list readfilediffs $df]
1963 set findinsertpos end
1964 set id [lindex $displayorder $l]
1965 . config -cursor watch
1967 set findinprogress 1
1972 proc readfilediffs {df} {
1973 global findid fdiffid fdiffs
1975 set n [gets $df line]
1979 if {[catch {close $df} err]} {
1982 error_popup "Error in git-diff-tree: $err"
1983 } elseif {[info exists findid]} {
1987 error_popup "Couldn't find diffs for $id"
1992 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
1993 # start of a new string of diffs
1997 } elseif {[string match ":*" $line]} {
1998 lappend fdiffs [lindex $line 5]
2002 proc donefilediff {} {
2003 global fdiffid fdiffs treediffs findid
2004 global fdiffsneeded fdiffpos
2006 if {[info exists fdiffid]} {
2007 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2008 && $fdiffpos < [llength $fdiffsneeded]} {
2009 # git-diff-tree doesn't output anything for a commit
2010 # which doesn't change anything
2011 set nullid [lindex $fdiffsneeded $fdiffpos]
2012 set treediffs($nullid) {}
2013 if {[info exists findid] && $nullid eq $findid} {
2021 if {![info exists treediffs($fdiffid)]} {
2022 set treediffs($fdiffid) $fdiffs
2024 if {[info exists findid] && $fdiffid eq $findid} {
2031 proc findcont {id} {
2032 global findid treediffs parents nparents
2033 global ffileline findstartline finddidsel
2034 global displayorder numcommits matchinglines findinprogress
2035 global findmergefiles
2039 if {$findmergefiles || $nparents($id) == 1} {
2040 if {![info exists treediffs($id)]} {
2046 foreach f $treediffs($id) {
2047 set x [findmatches $f]
2057 if {[incr l] >= $numcommits} {
2060 if {$l == $findstartline} break
2061 set id [lindex $displayorder $l]
2069 # mark a commit as matching by putting a yellow background
2070 # behind the headline
2071 proc markheadline {l id} {
2072 global canv mainfont linehtag commitinfo
2075 set bbox [$canv bbox $linehtag($l)]
2076 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2080 # mark the bits of a headline, author or date that match a find string
2081 proc markmatches {canv l str tag matches font} {
2082 set bbox [$canv bbox $tag]
2083 set x0 [lindex $bbox 0]
2084 set y0 [lindex $bbox 1]
2085 set y1 [lindex $bbox 3]
2086 foreach match $matches {
2087 set start [lindex $match 0]
2088 set end [lindex $match 1]
2089 if {$start > $end} continue
2090 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2091 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2092 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2093 [expr {$x0+$xlen+2}] $y1 \
2094 -outline {} -tags matches -fill yellow]
2099 proc unmarkmatches {} {
2100 global matchinglines findids
2101 allcanvs delete matches
2102 catch {unset matchinglines}
2103 catch {unset findids}
2106 proc selcanvline {w x y} {
2107 global canv canvy0 ctext linespc
2109 set ymax [lindex [$canv cget -scrollregion] 3]
2110 if {$ymax == {}} return
2111 set yfrac [lindex [$canv yview] 0]
2112 set y [expr {$y + $yfrac * $ymax}]
2113 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2118 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2124 proc commit_descriptor {p} {
2127 if {[info exists commitinfo($p)]} {
2128 set l [lindex $commitinfo($p) 0]
2133 # append some text to the ctext widget, and make any SHA1 ID
2134 # that we know about be a clickable link.
2135 proc appendwithlinks {text} {
2136 global ctext commitrow linknum
2138 set start [$ctext index "end - 1c"]
2139 $ctext insert end $text
2140 $ctext insert end "\n"
2141 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2145 set linkid [string range $text $s $e]
2146 if {![info exists commitrow($linkid)]} continue
2148 $ctext tag add link "$start + $s c" "$start + $e c"
2149 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2150 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2153 $ctext tag conf link -foreground blue -underline 1
2154 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2155 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2158 proc selectline {l isnew} {
2159 global canv canv2 canv3 ctext commitinfo selectedline
2160 global displayorder linehtag linentag linedtag
2161 global canvy0 linespc parents nparents children
2162 global cflist currentid sha1entry
2163 global commentend idtags linknum
2164 global mergemax numcommits
2168 if {$l < 0 || $l >= $numcommits} return
2169 set y [expr {$canvy0 + $l * $linespc}]
2170 set ymax [lindex [$canv cget -scrollregion] 3]
2171 set ytop [expr {$y - $linespc - 1}]
2172 set ybot [expr {$y + $linespc + 1}]
2173 set wnow [$canv yview]
2174 set wtop [expr {[lindex $wnow 0] * $ymax}]
2175 set wbot [expr {[lindex $wnow 1] * $ymax}]
2176 set wh [expr {$wbot - $wtop}]
2178 if {$ytop < $wtop} {
2179 if {$ybot < $wtop} {
2180 set newtop [expr {$y - $wh / 2.0}]
2183 if {$newtop > $wtop - $linespc} {
2184 set newtop [expr {$wtop - $linespc}]
2187 } elseif {$ybot > $wbot} {
2188 if {$ytop > $wbot} {
2189 set newtop [expr {$y - $wh / 2.0}]
2191 set newtop [expr {$ybot - $wh}]
2192 if {$newtop < $wtop + $linespc} {
2193 set newtop [expr {$wtop + $linespc}]
2197 if {$newtop != $wtop} {
2201 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2205 if {![info exists linehtag($l)]} return
2207 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2208 -tags secsel -fill [$canv cget -selectbackground]]
2210 $canv2 delete secsel
2211 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2212 -tags secsel -fill [$canv2 cget -selectbackground]]
2214 $canv3 delete secsel
2215 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2216 -tags secsel -fill [$canv3 cget -selectbackground]]
2220 addtohistory [list selectline $l 0]
2225 set id [lindex $displayorder $l]
2227 $sha1entry delete 0 end
2228 $sha1entry insert 0 $id
2229 $sha1entry selection from 0
2230 $sha1entry selection to end
2232 $ctext conf -state normal
2233 $ctext delete 0.0 end
2235 $ctext mark set fmark.0 0.0
2236 $ctext mark gravity fmark.0 left
2237 set info $commitinfo($id)
2238 set date [formatdate [lindex $info 2]]
2239 $ctext insert end "Author: [lindex $info 1] $date\n"
2240 set date [formatdate [lindex $info 4]]
2241 $ctext insert end "Committer: [lindex $info 3] $date\n"
2242 if {[info exists idtags($id)]} {
2243 $ctext insert end "Tags:"
2244 foreach tag $idtags($id) {
2245 $ctext insert end " $tag"
2247 $ctext insert end "\n"
2251 if {$nparents($id) > 1} {
2253 foreach p $parents($id) {
2254 if {$np >= $mergemax} {
2259 $ctext insert end "Parent: " $tag
2260 appendwithlinks [commit_descriptor $p]
2264 if {[info exists parents($id)]} {
2265 foreach p $parents($id) {
2266 append comment "Parent: [commit_descriptor $p]\n"
2271 if {[info exists children($id)]} {
2272 foreach c $children($id) {
2273 append comment "Child: [commit_descriptor $c]\n"
2277 append comment [lindex $info 5]
2279 # make anything that looks like a SHA1 ID be a clickable link
2280 appendwithlinks $comment
2282 $ctext tag delete Comments
2283 $ctext tag remove found 1.0 end
2284 $ctext conf -state disabled
2285 set commentend [$ctext index "end - 1c"]
2287 $cflist delete 0 end
2288 $cflist insert end "Comments"
2289 if {$nparents($id) == 1} {
2291 } elseif {$nparents($id) > 1} {
2296 proc selnextline {dir} {
2298 if {![info exists selectedline]} return
2299 set l [expr {$selectedline + $dir}]
2304 proc unselectline {} {
2307 catch {unset selectedline}
2308 allcanvs delete secsel
2311 proc addtohistory {cmd} {
2312 global history historyindex
2314 if {$historyindex > 0
2315 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2319 if {$historyindex < [llength $history]} {
2320 set history [lreplace $history $historyindex end $cmd]
2322 lappend history $cmd
2325 if {$historyindex > 1} {
2326 .ctop.top.bar.leftbut conf -state normal
2328 .ctop.top.bar.leftbut conf -state disabled
2330 .ctop.top.bar.rightbut conf -state disabled
2334 global history historyindex
2336 if {$historyindex > 1} {
2337 incr historyindex -1
2338 set cmd [lindex $history [expr {$historyindex - 1}]]
2340 .ctop.top.bar.rightbut conf -state normal
2342 if {$historyindex <= 1} {
2343 .ctop.top.bar.leftbut conf -state disabled
2348 global history historyindex
2350 if {$historyindex < [llength $history]} {
2351 set cmd [lindex $history $historyindex]
2354 .ctop.top.bar.leftbut conf -state normal
2356 if {$historyindex >= [llength $history]} {
2357 .ctop.top.bar.rightbut conf -state disabled
2361 proc mergediff {id} {
2362 global parents diffmergeid diffopts mdifffd
2363 global difffilestart
2366 catch {unset difffilestart}
2367 # this doesn't seem to actually affect anything...
2368 set env(GIT_DIFF_OPTS) $diffopts
2369 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2370 if {[catch {set mdf [open $cmd r]} err]} {
2371 error_popup "Error getting merge diffs: $err"
2374 fconfigure $mdf -blocking 0
2375 set mdifffd($id) $mdf
2376 fileevent $mdf readable [list getmergediffline $mdf $id]
2377 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2380 proc getmergediffline {mdf id} {
2381 global diffmergeid ctext cflist nextupdate nparents mergemax
2382 global difffilestart
2384 set n [gets $mdf line]
2391 if {![info exists diffmergeid] || $id != $diffmergeid} {
2394 $ctext conf -state normal
2395 if {[regexp {^diff --cc (.*)} $line match fname]} {
2396 # start of a new file
2397 $ctext insert end "\n"
2398 set here [$ctext index "end - 1c"]
2399 set i [$cflist index end]
2400 $ctext mark set fmark.$i $here
2401 $ctext mark gravity fmark.$i left
2402 set difffilestart([expr {$i-1}]) $here
2403 $cflist insert end $fname
2404 set l [expr {(78 - [string length $fname]) / 2}]
2405 set pad [string range "----------------------------------------" 1 $l]
2406 $ctext insert end "$pad $fname $pad\n" filesep
2407 } elseif {[regexp {^@@} $line]} {
2408 $ctext insert end "$line\n" hunksep
2409 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2412 # parse the prefix - one ' ', '-' or '+' for each parent
2413 set np $nparents($id)
2418 for {set j 0} {$j < $np} {incr j} {
2419 set c [string range $line $j $j]
2422 } elseif {$c == "-"} {
2424 } elseif {$c == "+"} {
2433 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2434 # line doesn't appear in result, parents in $minuses have the line
2435 set num [lindex $minuses 0]
2436 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2437 # line appears in result, parents in $pluses don't have the line
2438 lappend tags mresult
2439 set num [lindex $spaces 0]
2442 if {$num >= $mergemax} {
2447 $ctext insert end "$line\n" $tags
2449 $ctext conf -state disabled
2450 if {[clock clicks -milliseconds] >= $nextupdate} {
2452 fileevent $mdf readable {}
2454 fileevent $mdf readable [list getmergediffline $mdf $id]
2458 proc startdiff {ids} {
2459 global treediffs diffids treepending diffmergeid
2462 catch {unset diffmergeid}
2463 if {![info exists treediffs($ids)]} {
2464 if {![info exists treepending]} {
2472 proc addtocflist {ids} {
2473 global treediffs cflist
2474 foreach f $treediffs($ids) {
2475 $cflist insert end $f
2480 proc gettreediffs {ids} {
2481 global treediff parents treepending
2482 set treepending $ids
2485 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2487 fconfigure $gdtf -blocking 0
2488 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2491 proc gettreediffline {gdtf ids} {
2492 global treediff treediffs treepending diffids diffmergeid
2494 set n [gets $gdtf line]
2496 if {![eof $gdtf]} return
2498 set treediffs($ids) $treediff
2500 if {$ids != $diffids} {
2501 gettreediffs $diffids
2503 if {[info exists diffmergeid]} {
2511 set file [lindex $line 5]
2512 lappend treediff $file
2515 proc getblobdiffs {ids} {
2516 global diffopts blobdifffd diffids env curdifftag curtagstart
2517 global difffilestart nextupdate diffinhdr treediffs
2519 set env(GIT_DIFF_OPTS) $diffopts
2520 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2521 if {[catch {set bdf [open $cmd r]} err]} {
2522 puts "error getting diffs: $err"
2526 fconfigure $bdf -blocking 0
2527 set blobdifffd($ids) $bdf
2528 set curdifftag Comments
2530 catch {unset difffilestart}
2531 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2532 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2535 proc getblobdiffline {bdf ids} {
2536 global diffids blobdifffd ctext curdifftag curtagstart
2537 global diffnexthead diffnextnote difffilestart
2538 global nextupdate diffinhdr treediffs
2540 set n [gets $bdf line]
2544 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2545 $ctext tag add $curdifftag $curtagstart end
2550 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2553 $ctext conf -state normal
2554 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2555 # start of a new file
2556 $ctext insert end "\n"
2557 $ctext tag add $curdifftag $curtagstart end
2558 set curtagstart [$ctext index "end - 1c"]
2560 set here [$ctext index "end - 1c"]
2561 set i [lsearch -exact $treediffs($diffids) $fname]
2563 set difffilestart($i) $here
2565 $ctext mark set fmark.$i $here
2566 $ctext mark gravity fmark.$i left
2568 if {$newname != $fname} {
2569 set i [lsearch -exact $treediffs($diffids) $newname]
2571 set difffilestart($i) $here
2573 $ctext mark set fmark.$i $here
2574 $ctext mark gravity fmark.$i left
2577 set curdifftag "f:$fname"
2578 $ctext tag delete $curdifftag
2579 set l [expr {(78 - [string length $header]) / 2}]
2580 set pad [string range "----------------------------------------" 1 $l]
2581 $ctext insert end "$pad $header $pad\n" filesep
2583 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2585 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2586 $line match f1l f1c f2l f2c rest]} {
2587 $ctext insert end "$line\n" hunksep
2590 set x [string range $line 0 0]
2591 if {$x == "-" || $x == "+"} {
2592 set tag [expr {$x == "+"}]
2593 $ctext insert end "$line\n" d$tag
2594 } elseif {$x == " "} {
2595 $ctext insert end "$line\n"
2596 } elseif {$diffinhdr || $x == "\\"} {
2597 # e.g. "\ No newline at end of file"
2598 $ctext insert end "$line\n" filesep
2600 # Something else we don't recognize
2601 if {$curdifftag != "Comments"} {
2602 $ctext insert end "\n"
2603 $ctext tag add $curdifftag $curtagstart end
2604 set curtagstart [$ctext index "end - 1c"]
2605 set curdifftag Comments
2607 $ctext insert end "$line\n" filesep
2610 $ctext conf -state disabled
2611 if {[clock clicks -milliseconds] >= $nextupdate} {
2613 fileevent $bdf readable {}
2615 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2620 global difffilestart ctext
2621 set here [$ctext index @0,0]
2622 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2623 if {[$ctext compare $difffilestart($i) > $here]} {
2624 if {![info exists pos]
2625 || [$ctext compare $difffilestart($i) < $pos]} {
2626 set pos $difffilestart($i)
2630 if {[info exists pos]} {
2635 proc listboxsel {} {
2636 global ctext cflist currentid
2637 if {![info exists currentid]} return
2638 set sel [lsort [$cflist curselection]]
2639 if {$sel eq {}} return
2640 set first [lindex $sel 0]
2641 catch {$ctext yview fmark.$first}
2645 global linespc charspc canvx0 canvy0 mainfont
2646 global xspc1 xspc2 lthickness
2648 set linespc [font metrics $mainfont -linespace]
2649 set charspc [font measure $mainfont "m"]
2650 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2651 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2652 set lthickness [expr {int($linespc / 9) + 1}]
2653 set xspc1(0) $linespc
2658 global canv canvy0 linespc numcommits
2661 set ymax [lindex [$canv cget -scrollregion] 3]
2662 if {$ymax eq {} || $ymax == 0} return
2663 set span [$canv yview]
2665 allcanvs conf -scrollregion \
2666 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2667 allcanvs yview moveto [lindex $span 0]
2669 if {[info exists selectedline]} {
2670 selectline $selectedline 0
2674 proc incrfont {inc} {
2675 global mainfont namefont textfont ctext canv phase
2676 global stopped entries
2678 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2679 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2680 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2682 $ctext conf -font $textfont
2683 $ctext tag conf filesep -font [concat $textfont bold]
2684 foreach e $entries {
2685 $e conf -font $mainfont
2687 if {$phase == "getcommits"} {
2688 $canv itemconf textitems -font $mainfont
2694 global sha1entry sha1string
2695 if {[string length $sha1string] == 40} {
2696 $sha1entry delete 0 end
2700 proc sha1change {n1 n2 op} {
2701 global sha1string currentid sha1but
2702 if {$sha1string == {}
2703 || ([info exists currentid] && $sha1string == $currentid)} {
2708 if {[$sha1but cget -state] == $state} return
2709 if {$state == "normal"} {
2710 $sha1but conf -state normal -relief raised -text "Goto: "
2712 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2716 proc gotocommit {} {
2717 global sha1string currentid commitrow tagids
2718 global displayorder numcommits
2720 if {$sha1string == {}
2721 || ([info exists currentid] && $sha1string == $currentid)} return
2722 if {[info exists tagids($sha1string)]} {
2723 set id $tagids($sha1string)
2725 set id [string tolower $sha1string]
2726 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2728 for {set l 0} {$l < $numcommits} {incr l} {
2729 if {[string match $id* [lindex $displayorder $l]]} {
2730 lappend matches [lindex $displayorder $l]
2733 if {$matches ne {}} {
2734 if {[llength $matches] > 1} {
2735 error_popup "Short SHA1 id $id is ambiguous"
2738 set id [lindex $matches 0]
2742 if {[info exists commitrow($id)]} {
2743 selectline $commitrow($id) 1
2746 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2751 error_popup "$type $sha1string is not known"
2754 proc lineenter {x y id} {
2755 global hoverx hovery hoverid hovertimer
2756 global commitinfo canv
2758 if {![info exists commitinfo($id)]} return
2762 if {[info exists hovertimer]} {
2763 after cancel $hovertimer
2765 set hovertimer [after 500 linehover]
2769 proc linemotion {x y id} {
2770 global hoverx hovery hoverid hovertimer
2772 if {[info exists hoverid] && $id == $hoverid} {
2775 if {[info exists hovertimer]} {
2776 after cancel $hovertimer
2778 set hovertimer [after 500 linehover]
2782 proc lineleave {id} {
2783 global hoverid hovertimer canv
2785 if {[info exists hoverid] && $id == $hoverid} {
2787 if {[info exists hovertimer]} {
2788 after cancel $hovertimer
2796 global hoverx hovery hoverid hovertimer
2797 global canv linespc lthickness
2798 global commitinfo mainfont
2800 set text [lindex $commitinfo($hoverid) 0]
2801 set ymax [lindex [$canv cget -scrollregion] 3]
2802 if {$ymax == {}} return
2803 set yfrac [lindex [$canv yview] 0]
2804 set x [expr {$hoverx + 2 * $linespc}]
2805 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2806 set x0 [expr {$x - 2 * $lthickness}]
2807 set y0 [expr {$y - 2 * $lthickness}]
2808 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2809 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2810 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2811 -fill \#ffff80 -outline black -width 1 -tags hover]
2813 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2817 proc clickisonarrow {id y} {
2818 global lthickness idrowranges
2820 set thresh [expr {2 * $lthickness + 6}]
2821 set n [expr {[llength $idrowranges($id)] - 1}]
2822 for {set i 1} {$i < $n} {incr i} {
2823 set row [lindex $idrowranges($id) $i]
2824 if {abs([yc $row] - $y) < $thresh} {
2831 proc arrowjump {id n y} {
2832 global idrowranges canv
2834 # 1 <-> 2, 3 <-> 4, etc...
2835 set n [expr {(($n - 1) ^ 1) + 1}]
2836 set row [lindex $idrowranges($id) $n]
2838 set ymax [lindex [$canv cget -scrollregion] 3]
2839 if {$ymax eq {} || $ymax <= 0} return
2840 set view [$canv yview]
2841 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2842 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2846 allcanvs yview moveto $yfrac
2849 proc lineclick {x y id isnew} {
2850 global ctext commitinfo children cflist canv thickerline
2856 # draw this line thicker than normal
2860 set ymax [lindex [$canv cget -scrollregion] 3]
2861 if {$ymax eq {}} return
2862 set yfrac [lindex [$canv yview] 0]
2863 set y [expr {$y + $yfrac * $ymax}]
2865 set dirn [clickisonarrow $id $y]
2867 arrowjump $id $dirn $y
2872 addtohistory [list lineclick $x $y $id 0]
2874 # fill the details pane with info about this line
2875 $ctext conf -state normal
2876 $ctext delete 0.0 end
2877 $ctext tag conf link -foreground blue -underline 1
2878 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2879 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2880 $ctext insert end "Parent:\t"
2881 $ctext insert end $id [list link link0]
2882 $ctext tag bind link0 <1> [list selbyid $id]
2883 set info $commitinfo($id)
2884 $ctext insert end "\n\t[lindex $info 0]\n"
2885 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2886 set date [formatdate [lindex $info 2]]
2887 $ctext insert end "\tDate:\t$date\n"
2888 if {[info exists children($id)]} {
2889 $ctext insert end "\nChildren:"
2891 foreach child $children($id) {
2893 set info $commitinfo($child)
2894 $ctext insert end "\n\t"
2895 $ctext insert end $child [list link link$i]
2896 $ctext tag bind link$i <1> [list selbyid $child]
2897 $ctext insert end "\n\t[lindex $info 0]"
2898 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2899 set date [formatdate [lindex $info 2]]
2900 $ctext insert end "\n\tDate:\t$date\n"
2903 $ctext conf -state disabled
2905 $cflist delete 0 end
2908 proc normalline {} {
2910 if {[info exists thickerline]} {
2911 drawlines $thickerline 0
2918 if {[info exists commitrow($id)]} {
2919 selectline $commitrow($id) 1
2925 if {![info exists startmstime]} {
2926 set startmstime [clock clicks -milliseconds]
2928 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2931 proc rowmenu {x y id} {
2932 global rowctxmenu commitrow selectedline rowmenuid
2934 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2939 $rowctxmenu entryconfigure 0 -state $state
2940 $rowctxmenu entryconfigure 1 -state $state
2941 $rowctxmenu entryconfigure 2 -state $state
2943 tk_popup $rowctxmenu $x $y
2946 proc diffvssel {dirn} {
2947 global rowmenuid selectedline displayorder
2949 if {![info exists selectedline]} return
2951 set oldid [lindex $displayorder $selectedline]
2952 set newid $rowmenuid
2954 set oldid $rowmenuid
2955 set newid [lindex $displayorder $selectedline]
2957 addtohistory [list doseldiff $oldid $newid]
2958 doseldiff $oldid $newid
2961 proc doseldiff {oldid newid} {
2965 $ctext conf -state normal
2966 $ctext delete 0.0 end
2967 $ctext mark set fmark.0 0.0
2968 $ctext mark gravity fmark.0 left
2969 $cflist delete 0 end
2970 $cflist insert end "Top"
2971 $ctext insert end "From "
2972 $ctext tag conf link -foreground blue -underline 1
2973 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2974 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2975 $ctext tag bind link0 <1> [list selbyid $oldid]
2976 $ctext insert end $oldid [list link link0]
2977 $ctext insert end "\n "
2978 $ctext insert end [lindex $commitinfo($oldid) 0]
2979 $ctext insert end "\n\nTo "
2980 $ctext tag bind link1 <1> [list selbyid $newid]
2981 $ctext insert end $newid [list link link1]
2982 $ctext insert end "\n "
2983 $ctext insert end [lindex $commitinfo($newid) 0]
2984 $ctext insert end "\n"
2985 $ctext conf -state disabled
2986 $ctext tag delete Comments
2987 $ctext tag remove found 1.0 end
2988 startdiff [list $oldid $newid]
2992 global rowmenuid currentid commitinfo patchtop patchnum
2994 if {![info exists currentid]} return
2995 set oldid $currentid
2996 set oldhead [lindex $commitinfo($oldid) 0]
2997 set newid $rowmenuid
2998 set newhead [lindex $commitinfo($newid) 0]
3001 catch {destroy $top}
3003 label $top.title -text "Generate patch"
3004 grid $top.title - -pady 10
3005 label $top.from -text "From:"
3006 entry $top.fromsha1 -width 40 -relief flat
3007 $top.fromsha1 insert 0 $oldid
3008 $top.fromsha1 conf -state readonly
3009 grid $top.from $top.fromsha1 -sticky w
3010 entry $top.fromhead -width 60 -relief flat
3011 $top.fromhead insert 0 $oldhead
3012 $top.fromhead conf -state readonly
3013 grid x $top.fromhead -sticky w
3014 label $top.to -text "To:"
3015 entry $top.tosha1 -width 40 -relief flat
3016 $top.tosha1 insert 0 $newid
3017 $top.tosha1 conf -state readonly
3018 grid $top.to $top.tosha1 -sticky w
3019 entry $top.tohead -width 60 -relief flat
3020 $top.tohead insert 0 $newhead
3021 $top.tohead conf -state readonly
3022 grid x $top.tohead -sticky w
3023 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3024 grid $top.rev x -pady 10
3025 label $top.flab -text "Output file:"
3026 entry $top.fname -width 60
3027 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3029 grid $top.flab $top.fname -sticky w
3031 button $top.buts.gen -text "Generate" -command mkpatchgo
3032 button $top.buts.can -text "Cancel" -command mkpatchcan
3033 grid $top.buts.gen $top.buts.can
3034 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3035 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3036 grid $top.buts - -pady 10 -sticky ew
3040 proc mkpatchrev {} {
3043 set oldid [$patchtop.fromsha1 get]
3044 set oldhead [$patchtop.fromhead get]
3045 set newid [$patchtop.tosha1 get]
3046 set newhead [$patchtop.tohead get]
3047 foreach e [list fromsha1 fromhead tosha1 tohead] \
3048 v [list $newid $newhead $oldid $oldhead] {
3049 $patchtop.$e conf -state normal
3050 $patchtop.$e delete 0 end
3051 $patchtop.$e insert 0 $v
3052 $patchtop.$e conf -state readonly
3059 set oldid [$patchtop.fromsha1 get]
3060 set newid [$patchtop.tosha1 get]
3061 set fname [$patchtop.fname get]
3062 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3063 error_popup "Error creating patch: $err"
3065 catch {destroy $patchtop}
3069 proc mkpatchcan {} {
3072 catch {destroy $patchtop}
3077 global rowmenuid mktagtop commitinfo
3081 catch {destroy $top}
3083 label $top.title -text "Create tag"
3084 grid $top.title - -pady 10
3085 label $top.id -text "ID:"
3086 entry $top.sha1 -width 40 -relief flat
3087 $top.sha1 insert 0 $rowmenuid
3088 $top.sha1 conf -state readonly
3089 grid $top.id $top.sha1 -sticky w
3090 entry $top.head -width 60 -relief flat
3091 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3092 $top.head conf -state readonly
3093 grid x $top.head -sticky w
3094 label $top.tlab -text "Tag name:"
3095 entry $top.tag -width 60
3096 grid $top.tlab $top.tag -sticky w
3098 button $top.buts.gen -text "Create" -command mktaggo
3099 button $top.buts.can -text "Cancel" -command mktagcan
3100 grid $top.buts.gen $top.buts.can
3101 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3102 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3103 grid $top.buts - -pady 10 -sticky ew
3108 global mktagtop env tagids idtags
3110 set id [$mktagtop.sha1 get]
3111 set tag [$mktagtop.tag get]
3113 error_popup "No tag name specified"
3116 if {[info exists tagids($tag)]} {
3117 error_popup "Tag \"$tag\" already exists"
3122 set fname [file join $dir "refs/tags" $tag]
3123 set f [open $fname w]
3127 error_popup "Error creating tag: $err"
3131 set tagids($tag) $id
3132 lappend idtags($id) $tag
3136 proc redrawtags {id} {
3137 global canv linehtag commitrow idpos selectedline
3139 if {![info exists commitrow($id)]} return
3140 drawcmitrow $commitrow($id)
3141 $canv delete tag.$id
3142 set xt [eval drawtags $id $idpos($id)]
3143 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3144 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3145 selectline $selectedline 0
3152 catch {destroy $mktagtop}
3161 proc writecommit {} {
3162 global rowmenuid wrcomtop commitinfo wrcomcmd
3164 set top .writecommit
3166 catch {destroy $top}
3168 label $top.title -text "Write commit to file"
3169 grid $top.title - -pady 10
3170 label $top.id -text "ID:"
3171 entry $top.sha1 -width 40 -relief flat
3172 $top.sha1 insert 0 $rowmenuid
3173 $top.sha1 conf -state readonly
3174 grid $top.id $top.sha1 -sticky w
3175 entry $top.head -width 60 -relief flat
3176 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3177 $top.head conf -state readonly
3178 grid x $top.head -sticky w
3179 label $top.clab -text "Command:"
3180 entry $top.cmd -width 60 -textvariable wrcomcmd
3181 grid $top.clab $top.cmd -sticky w -pady 10
3182 label $top.flab -text "Output file:"
3183 entry $top.fname -width 60
3184 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3185 grid $top.flab $top.fname -sticky w
3187 button $top.buts.gen -text "Write" -command wrcomgo
3188 button $top.buts.can -text "Cancel" -command wrcomcan
3189 grid $top.buts.gen $top.buts.can
3190 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3191 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3192 grid $top.buts - -pady 10 -sticky ew
3199 set id [$wrcomtop.sha1 get]
3200 set cmd "echo $id | [$wrcomtop.cmd get]"
3201 set fname [$wrcomtop.fname get]
3202 if {[catch {exec sh -c $cmd >$fname &} err]} {
3203 error_popup "Error writing commit: $err"
3205 catch {destroy $wrcomtop}
3212 catch {destroy $wrcomtop}
3216 proc listrefs {id} {
3217 global idtags idheads idotherrefs
3220 if {[info exists idtags($id)]} {
3224 if {[info exists idheads($id)]} {
3228 if {[info exists idotherrefs($id)]} {
3229 set z $idotherrefs($id)
3231 return [list $x $y $z]
3234 proc rereadrefs {} {
3235 global idtags idheads idotherrefs
3236 global tagids headids otherrefids
3238 set refids [concat [array names idtags] \
3239 [array names idheads] [array names idotherrefs]]
3240 foreach id $refids {
3241 if {![info exists ref($id)]} {
3242 set ref($id) [listrefs $id]
3246 set refids [lsort -unique [concat $refids [array names idtags] \
3247 [array names idheads] [array names idotherrefs]]]
3248 foreach id $refids {
3249 set v [listrefs $id]
3250 if {![info exists ref($id)] || $ref($id) != $v} {
3256 proc showtag {tag isnew} {
3257 global ctext cflist tagcontents tagids linknum
3260 addtohistory [list showtag $tag 0]
3262 $ctext conf -state normal
3263 $ctext delete 0.0 end
3265 if {[info exists tagcontents($tag)]} {
3266 set text $tagcontents($tag)
3268 set text "Tag: $tag\nId: $tagids($tag)"
3270 appendwithlinks $text
3271 $ctext conf -state disabled
3272 $cflist delete 0 end
3282 global maxwidth maxgraphpct diffopts findmergefiles
3283 global oldprefs prefstop
3287 if {[winfo exists $top]} {
3291 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3292 set oldprefs($v) [set $v]
3295 wm title $top "Gitk preferences"
3296 label $top.ldisp -text "Commit list display options"
3297 grid $top.ldisp - -sticky w -pady 10
3298 label $top.spacer -text " "
3299 label $top.maxwidthl -text "Maximum graph width (lines)" \
3301 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3302 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3303 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3305 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3306 grid x $top.maxpctl $top.maxpct -sticky w
3307 checkbutton $top.findm -variable findmergefiles
3308 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3310 grid $top.findm $top.findml - -sticky w
3311 label $top.ddisp -text "Diff display options"
3312 grid $top.ddisp - -sticky w -pady 10
3313 label $top.diffoptl -text "Options for diff program" \
3315 entry $top.diffopt -width 20 -textvariable diffopts
3316 grid x $top.diffoptl $top.diffopt -sticky w
3318 button $top.buts.ok -text "OK" -command prefsok
3319 button $top.buts.can -text "Cancel" -command prefscan
3320 grid $top.buts.ok $top.buts.can
3321 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3322 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3323 grid $top.buts - - -pady 10 -sticky ew
3327 global maxwidth maxgraphpct diffopts findmergefiles
3328 global oldprefs prefstop
3330 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3331 set $v $oldprefs($v)
3333 catch {destroy $prefstop}
3338 global maxwidth maxgraphpct
3339 global oldprefs prefstop
3341 catch {destroy $prefstop}
3343 if {$maxwidth != $oldprefs(maxwidth)
3344 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3349 proc formatdate {d} {
3350 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3353 # This list of encoding names and aliases is distilled from
3354 # http://www.iana.org/assignments/character-sets.
3355 # Not all of them are supported by Tcl.
3356 set encoding_aliases {
3357 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3358 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3359 { ISO-10646-UTF-1 csISO10646UTF1 }
3360 { ISO_646.basic:1983 ref csISO646basic1983 }
3361 { INVARIANT csINVARIANT }
3362 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3363 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3364 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3365 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3366 { NATS-DANO iso-ir-9-1 csNATSDANO }
3367 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3368 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3369 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3370 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3371 { ISO-2022-KR csISO2022KR }
3373 { ISO-2022-JP csISO2022JP }
3374 { ISO-2022-JP-2 csISO2022JP2 }
3375 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3377 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3378 { IT iso-ir-15 ISO646-IT csISO15Italian }
3379 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3380 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3381 { greek7-old iso-ir-18 csISO18Greek7Old }
3382 { latin-greek iso-ir-19 csISO19LatinGreek }
3383 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3384 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3385 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3386 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3387 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3388 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3389 { INIS iso-ir-49 csISO49INIS }
3390 { INIS-8 iso-ir-50 csISO50INIS8 }
3391 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3392 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3393 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3394 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3395 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3396 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3398 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3399 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3400 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3401 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3402 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3403 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3404 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3405 { greek7 iso-ir-88 csISO88Greek7 }
3406 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3407 { iso-ir-90 csISO90 }
3408 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3409 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3410 csISO92JISC62991984b }
3411 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3412 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3413 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3414 csISO95JIS62291984handadd }
3415 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3416 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3417 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3418 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3420 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3421 { T.61-7bit iso-ir-102 csISO102T617bit }
3422 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3423 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3424 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3425 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3426 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3427 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3428 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3429 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3430 arabic csISOLatinArabic }
3431 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3432 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3433 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3434 greek greek8 csISOLatinGreek }
3435 { T.101-G2 iso-ir-128 csISO128T101G2 }
3436 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3438 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3439 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3440 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3441 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3442 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3443 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3444 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3445 csISOLatinCyrillic }
3446 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3447 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3448 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3449 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3450 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3451 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3452 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3453 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3454 { ISO_10367-box iso-ir-155 csISO10367Box }
3455 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3456 { latin-lap lap iso-ir-158 csISO158Lap }
3457 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3458 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3461 { JIS_X0201 X0201 csHalfWidthKatakana }
3462 { KSC5636 ISO646-KR csKSC5636 }
3463 { ISO-10646-UCS-2 csUnicode }
3464 { ISO-10646-UCS-4 csUCS4 }
3465 { DEC-MCS dec csDECMCS }
3466 { hp-roman8 roman8 r8 csHPRoman8 }
3467 { macintosh mac csMacintosh }
3468 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3470 { IBM038 EBCDIC-INT cp038 csIBM038 }
3471 { IBM273 CP273 csIBM273 }
3472 { IBM274 EBCDIC-BE CP274 csIBM274 }
3473 { IBM275 EBCDIC-BR cp275 csIBM275 }
3474 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3475 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3476 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3477 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3478 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3479 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3480 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3481 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3482 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3483 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3484 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3485 { IBM437 cp437 437 csPC8CodePage437 }
3486 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3487 { IBM775 cp775 csPC775Baltic }
3488 { IBM850 cp850 850 csPC850Multilingual }
3489 { IBM851 cp851 851 csIBM851 }
3490 { IBM852 cp852 852 csPCp852 }
3491 { IBM855 cp855 855 csIBM855 }
3492 { IBM857 cp857 857 csIBM857 }
3493 { IBM860 cp860 860 csIBM860 }
3494 { IBM861 cp861 861 cp-is csIBM861 }
3495 { IBM862 cp862 862 csPC862LatinHebrew }
3496 { IBM863 cp863 863 csIBM863 }
3497 { IBM864 cp864 csIBM864 }
3498 { IBM865 cp865 865 csIBM865 }
3499 { IBM866 cp866 866 csIBM866 }
3500 { IBM868 CP868 cp-ar csIBM868 }
3501 { IBM869 cp869 869 cp-gr csIBM869 }
3502 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3503 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3504 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3505 { IBM891 cp891 csIBM891 }
3506 { IBM903 cp903 csIBM903 }
3507 { IBM904 cp904 904 csIBBM904 }
3508 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3509 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3510 { IBM1026 CP1026 csIBM1026 }
3511 { EBCDIC-AT-DE csIBMEBCDICATDE }
3512 { EBCDIC-AT-DE-A csEBCDICATDEA }
3513 { EBCDIC-CA-FR csEBCDICCAFR }
3514 { EBCDIC-DK-NO csEBCDICDKNO }
3515 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3516 { EBCDIC-FI-SE csEBCDICFISE }
3517 { EBCDIC-FI-SE-A csEBCDICFISEA }
3518 { EBCDIC-FR csEBCDICFR }
3519 { EBCDIC-IT csEBCDICIT }
3520 { EBCDIC-PT csEBCDICPT }
3521 { EBCDIC-ES csEBCDICES }
3522 { EBCDIC-ES-A csEBCDICESA }
3523 { EBCDIC-ES-S csEBCDICESS }
3524 { EBCDIC-UK csEBCDICUK }
3525 { EBCDIC-US csEBCDICUS }
3526 { UNKNOWN-8BIT csUnknown8BiT }
3527 { MNEMONIC csMnemonic }
3532 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3533 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3534 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3535 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3536 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3537 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3538 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3539 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3540 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3541 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3542 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3543 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3544 { IBM1047 IBM-1047 }
3545 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3546 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3547 { UNICODE-1-1 csUnicode11 }
3550 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3551 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3553 { ISO-8859-15 ISO_8859-15 Latin-9 }
3554 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3555 { GBK CP936 MS936 windows-936 }
3556 { JIS_Encoding csJISEncoding }
3557 { Shift_JIS MS_Kanji csShiftJIS }
3558 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3560 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3561 { ISO-10646-UCS-Basic csUnicodeASCII }
3562 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3563 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3564 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3565 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3566 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3567 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3568 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3569 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3570 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3571 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3572 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3573 { Ventura-US csVenturaUS }
3574 { Ventura-International csVenturaInternational }
3575 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3576 { PC8-Turkish csPC8Turkish }
3577 { IBM-Symbols csIBMSymbols }
3578 { IBM-Thai csIBMThai }
3579 { HP-Legal csHPLegal }
3580 { HP-Pi-font csHPPiFont }
3581 { HP-Math8 csHPMath8 }
3582 { Adobe-Symbol-Encoding csHPPSMath }
3583 { HP-DeskTop csHPDesktop }
3584 { Ventura-Math csVenturaMath }
3585 { Microsoft-Publishing csMicrosoftPublishing }
3586 { Windows-31J csWindows31J }
3591 proc tcl_encoding {enc} {
3592 global encoding_aliases
3593 set names [encoding names]
3594 set lcnames [string tolower $names]
3595 set enc [string tolower $enc]
3596 set i [lsearch -exact $lcnames $enc]
3598 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3599 if {[regsub {^iso[-_]} $enc iso encx]} {
3600 set i [lsearch -exact $lcnames $encx]
3604 foreach l $encoding_aliases {
3605 set ll [string tolower $l]
3606 if {[lsearch -exact $ll $enc] < 0} continue
3607 # look through the aliases for one that tcl knows about
3609 set i [lsearch -exact $lcnames $e]
3611 if {[regsub {^iso[-_]} $e iso ex]} {
3612 set i [lsearch -exact $lcnames $ex]
3621 return [lindex $names $i]
3628 set diffopts "-U 5 -p"
3629 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3633 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3635 if {$gitencoding == ""} {
3636 set gitencoding "utf-8"
3638 set tclencoding [tcl_encoding $gitencoding]
3639 if {$tclencoding == {}} {
3640 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3643 set mainfont {Helvetica 9}
3644 set textfont {Courier 9}
3645 set findmergefiles 0
3654 set colors {green red blue magenta darkgrey brown orange}
3656 catch {source ~/.gitk}
3658 set namefont $mainfont
3660 font create optionfont -family sans-serif -size -12
3664 switch -regexp -- $arg {
3666 "^-d" { set datemode 1 }
3668 lappend revtreeargs $arg
3673 # check that we can find a .git directory somewhere...
3675 if {![file isdirectory $gitdir]} {
3676 error_popup "Cannot find the git directory \"$gitdir\"."
3689 makewindow $revtreeargs
3691 getcommits $revtreeargs