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
79 set stuff
[read $commfd]
81 if {![eof
$commfd]} return
82 # set it blocking so we wait for the process to terminate
83 fconfigure
$commfd -blocking 1
84 if {![catch
{close
$commfd} err
]} {
85 after idle finishcommits
88 if {[string range
$err 0 4] == "usage"} {
90 "Gitk: error reading commits: bad arguments to git-rev-list.\
91 (Note: arguments to gitk are passed to git-rev-list\
92 to allow selection of commits to be displayed.)"
94 set err
"Error reading commits: $err"
102 set i
[string first
"\0" $stuff $start]
104 append leftover
[string range
$stuff $start end
]
109 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
112 set cmit
[string range
$stuff $start [expr {$i - 1}]]
114 set start
[expr {$i + 1}]
115 set j
[string first
"\n" $cmit]
119 set ids
[string range
$cmit 0 [expr {$j - 1}]]
120 if {[string range
$ids 0 0] == "-"} {
122 set ids
[string range
$ids 1 end
]
126 if {[string length
$id] != 40} {
134 if {[string length
$shortcmit] > 80} {
135 set shortcmit
"[string range $shortcmit 0 80]..."
137 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
140 set id
[lindex
$ids 0]
142 set olds
[lrange
$ids 1 end
]
143 set commitlisted
($id) 1
147 updatechildren
$id $olds
148 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
149 set commitrow
($id) $commitidx
151 lappend displayorder
$id
157 if {[clock clicks
-milliseconds] >= $nextupdate} {
162 proc doupdate
{reading
} {
163 global commfd nextupdate numcommits ncmupdate
166 fileevent
$commfd readable
{}
169 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
170 if {$numcommits < 100} {
171 set ncmupdate
[expr {$numcommits + 1}]
172 } elseif
{$numcommits < 10000} {
173 set ncmupdate
[expr {$numcommits + 10}]
175 set ncmupdate
[expr {$numcommits + 100}]
178 fileevent
$commfd readable
[list getcommitlines
$commfd]
182 proc readcommit
{id
} {
183 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
184 updatechildren
$id {}
185 parsecommit
$id $contents 0
188 proc updatecommits
{rargs
} {
190 foreach v
{children nchildren parents nparents commitlisted
191 colormap selectedline matchinglines treediffs
192 mergefilelist currentid rowtextx commitrow
193 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
194 linesegends crossings cornercrossings
} {
203 proc updatechildren
{id olds
} {
204 global children nchildren parents nparents
206 if {![info exists nchildren
($id)]} {
210 set parents
($id) $olds
211 set nparents
($id) [llength
$olds]
213 if {![info exists nchildren
($p)]} {
214 set children
($p) [list
$id]
216 } elseif
{[lsearch
-exact $children($p) $id] < 0} {
217 lappend children
($p) $id
223 proc parsecommit
{id contents listed
} {
224 global commitinfo cdate
233 set hdrend
[string first
"\n\n" $contents]
235 # should never happen...
236 set hdrend
[string length
$contents]
238 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
239 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
240 foreach line
[split $header "\n"] {
241 set tag
[lindex
$line 0]
242 if {$tag == "author"} {
243 set audate
[lindex
$line end-1
]
244 set auname
[lrange
$line 1 end-2
]
245 } elseif
{$tag == "committer"} {
246 set comdate
[lindex
$line end-1
]
247 set comname
[lrange
$line 1 end-2
]
251 # take the first line of the comment as the headline
252 set i
[string first
"\n" $comment]
254 set headline
[string trim
[string range
$comment 0 $i]]
256 set headline
$comment
259 # git-rev-list indents the comment by 4 spaces;
260 # if we got this via git-cat-file, add the indentation
262 foreach line
[split $comment "\n"] {
263 append newcomment
" "
264 append newcomment
$line
265 append newcomment
"\n"
267 set comment
$newcomment
269 if {$comdate != {}} {
270 set cdate
($id) $comdate
272 set commitinfo
($id) [list
$headline $auname $audate \
273 $comname $comdate $comment]
276 proc getcommit
{id
} {
277 global commitdata commitinfo nparents
279 if {[info exists commitdata
($id)]} {
280 parsecommit
$id $commitdata($id) 1
283 if {![info exists commitinfo
($id)]} {
284 set commitinfo
($id) {"No commit information available"}
292 global tagids idtags headids idheads tagcontents
293 global otherrefids idotherrefs
295 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
298 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
299 while {0 <= [set n
[gets
$refd line
]]} {
300 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
304 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
308 if {$type == "tags"} {
309 set tagids
($name) $id
310 lappend idtags
($id) $name
315 set commit
[exec git-rev-parse
"$id^0"]
316 if {"$commit" != "$id"} {
317 set tagids
($name) $commit
318 lappend idtags
($commit) $name
322 set tagcontents
($name) [exec git-cat-file tag
"$id"]
324 } elseif
{ $type == "heads" } {
325 set headids
($name) $id
326 lappend idheads
($id) $name
328 set otherrefids
($name) $id
329 lappend idotherrefs
($id) $name
335 proc error_popup msg
{
339 message
$w.m
-text $msg -justify center
-aspect 400
340 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
341 button
$w.ok
-text OK
-command "destroy $w"
342 pack
$w.ok
-side bottom
-fill x
343 bind $w <Visibility
> "grab $w; focus $w"
344 bind $w <Key-Return
> "destroy $w"
348 proc makewindow
{rargs
} {
349 global canv canv2 canv3 linespc charspc ctext cflist textfont
350 global findtype findtypemenu findloc findstring fstring geometry
351 global entries sha1entry sha1string sha1but
352 global maincursor textcursor curtextcursor
353 global rowctxmenu mergemax
356 .bar add cascade
-label "File" -menu .bar.
file
358 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
359 .bar.
file add
command -label "Reread references" -command rereadrefs
360 .bar.
file add
command -label "Quit" -command doquit
362 .bar add cascade
-label "Edit" -menu .bar.edit
363 .bar.edit add
command -label "Preferences" -command doprefs
365 .bar add cascade
-label "Help" -menu .bar.
help
366 .bar.
help add
command -label "About gitk" -command about
367 . configure
-menu .bar
369 if {![info exists geometry
(canv1
)]} {
370 set geometry
(canv1
) [expr {45 * $charspc}]
371 set geometry
(canv2
) [expr {30 * $charspc}]
372 set geometry
(canv3
) [expr {15 * $charspc}]
373 set geometry
(canvh
) [expr {25 * $linespc + 4}]
374 set geometry
(ctextw
) 80
375 set geometry
(ctexth
) 30
376 set geometry
(cflistw
) 30
378 panedwindow .ctop
-orient vertical
379 if {[info exists geometry
(width
)]} {
380 .ctop conf
-width $geometry(width
) -height $geometry(height
)
381 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
382 set geometry
(ctexth
) [expr {($texth - 8) /
383 [font metrics
$textfont -linespace]}]
387 pack .ctop.top.bar
-side bottom
-fill x
388 set cscroll .ctop.top.csb
389 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
390 pack
$cscroll -side right
-fill y
391 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
392 pack .ctop.top.clist
-side top
-fill both
-expand 1
394 set canv .ctop.top.clist.canv
395 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
397 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
398 .ctop.top.clist add
$canv
399 set canv2 .ctop.top.clist.canv2
400 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
401 -bg white
-bd 0 -yscrollincr $linespc
402 .ctop.top.clist add
$canv2
403 set canv3 .ctop.top.clist.canv3
404 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
405 -bg white
-bd 0 -yscrollincr $linespc
406 .ctop.top.clist add
$canv3
407 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
409 set sha1entry .ctop.top.bar.sha1
410 set entries
$sha1entry
411 set sha1but .ctop.top.bar.sha1label
412 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
413 -command gotocommit
-width 8
414 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
415 pack .ctop.top.bar.sha1label
-side left
416 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
417 trace add variable sha1string
write sha1change
418 pack
$sha1entry -side left
-pady 2
420 image create bitmap bm-left
-data {
421 #define left_width 16
422 #define left_height 16
423 static unsigned char left_bits
[] = {
424 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
425 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
426 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
428 image create bitmap bm-right
-data {
429 #define right_width 16
430 #define right_height 16
431 static unsigned char right_bits
[] = {
432 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
433 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
434 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
436 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
437 -state disabled
-width 26
438 pack .ctop.top.bar.leftbut
-side left
-fill y
439 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
440 -state disabled
-width 26
441 pack .ctop.top.bar.rightbut
-side left
-fill y
443 button .ctop.top.bar.findbut
-text "Find" -command dofind
444 pack .ctop.top.bar.findbut
-side left
446 set fstring .ctop.top.bar.findstring
447 lappend entries
$fstring
448 entry
$fstring -width 30 -font $textfont -textvariable findstring
449 pack
$fstring -side left
-expand 1 -fill x
451 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
452 findtype Exact IgnCase Regexp
]
453 set findloc
"All fields"
454 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
455 Comments Author Committer Files Pickaxe
456 pack .ctop.top.bar.findloc
-side right
457 pack .ctop.top.bar.findtype
-side right
458 # for making sure type==Exact whenever loc==Pickaxe
459 trace add variable findloc
write findlocchange
461 panedwindow .ctop.cdet
-orient horizontal
463 frame .ctop.cdet.left
464 set ctext .ctop.cdet.left.ctext
465 text
$ctext -bg white
-state disabled
-font $textfont \
466 -width $geometry(ctextw
) -height $geometry(ctexth
) \
467 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
468 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
469 pack .ctop.cdet.left.sb
-side right
-fill y
470 pack
$ctext -side left
-fill both
-expand 1
471 .ctop.cdet add .ctop.cdet.left
473 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
474 $ctext tag conf hunksep
-fore blue
475 $ctext tag conf d0
-fore red
476 $ctext tag conf d1
-fore "#00a000"
477 $ctext tag conf m0
-fore red
478 $ctext tag conf m1
-fore blue
479 $ctext tag conf m2
-fore green
480 $ctext tag conf m3
-fore purple
481 $ctext tag conf
m4 -fore brown
482 $ctext tag conf m5
-fore "#009090"
483 $ctext tag conf m6
-fore magenta
484 $ctext tag conf m7
-fore "#808000"
485 $ctext tag conf m8
-fore "#009000"
486 $ctext tag conf m9
-fore "#ff0080"
487 $ctext tag conf m10
-fore cyan
488 $ctext tag conf m11
-fore "#b07070"
489 $ctext tag conf m12
-fore "#70b0f0"
490 $ctext tag conf m13
-fore "#70f0b0"
491 $ctext tag conf m14
-fore "#f0b070"
492 $ctext tag conf m15
-fore "#ff70b0"
493 $ctext tag conf mmax
-fore darkgrey
495 $ctext tag conf mresult
-font [concat
$textfont bold
]
496 $ctext tag conf msep
-font [concat
$textfont bold
]
497 $ctext tag conf found
-back yellow
499 frame .ctop.cdet.right
500 set cflist .ctop.cdet.right.cfiles
501 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
502 -yscrollcommand ".ctop.cdet.right.sb set"
503 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
504 pack .ctop.cdet.right.sb
-side right
-fill y
505 pack
$cflist -side left
-fill both
-expand 1
506 .ctop.cdet add .ctop.cdet.right
507 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
509 pack .ctop
-side top
-fill both
-expand 1
511 bindall
<1> {selcanvline
%W
%x
%y
}
512 #bindall <B1-Motion> {selcanvline %W %x %y}
513 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
514 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
515 bindall
<2> "canvscan mark %W %x %y"
516 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
517 bind .
<Key-Up
> "selnextline -1"
518 bind .
<Key-Down
> "selnextline 1"
519 bind .
<Key-Right
> "goforw"
520 bind .
<Key-Left
> "goback"
521 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
522 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
523 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
524 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
525 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
526 bindkey p
"selnextline -1"
527 bindkey n
"selnextline 1"
530 bindkey i
"selnextline -1"
531 bindkey k
"selnextline 1"
534 bindkey b
"$ctext yview scroll -1 pages"
535 bindkey d
"$ctext yview scroll 18 units"
536 bindkey u
"$ctext yview scroll -18 units"
537 bindkey
/ {findnext
1}
538 bindkey
<Key-Return
> {findnext
0}
541 bind .
<Control-q
> doquit
542 bind .
<Control-f
> dofind
543 bind .
<Control-g
> {findnext
0}
544 bind .
<Control-r
> findprev
545 bind .
<Control-equal
> {incrfont
1}
546 bind .
<Control-KP_Add
> {incrfont
1}
547 bind .
<Control-minus
> {incrfont
-1}
548 bind .
<Control-KP_Subtract
> {incrfont
-1}
549 bind $cflist <<ListboxSelect>> listboxsel
550 bind . <Destroy> {savestuff %W}
551 bind . <Button-1> "click %W"
552 bind $fstring <Key-Return> dofind
553 bind $sha1entry <Key-Return> gotocommit
554 bind $sha1entry <<PasteSelection>> clearsha1
556 set maincursor [. cget -cursor]
557 set textcursor [$ctext cget -cursor]
558 set curtextcursor $textcursor
560 set rowctxmenu .rowctxmenu
561 menu $rowctxmenu -tearoff 0
562 $rowctxmenu add command -label "Diff this -> selected" \
563 -command {diffvssel 0}
564 $rowctxmenu add command -label "Diff selected -> this" \
565 -command {diffvssel 1}
566 $rowctxmenu add command -label "Make patch" -command mkpatch
567 $rowctxmenu add command -label "Create tag" -command mktag
568 $rowctxmenu add command -label "Write commit to file" -command writecommit
571 # mouse-2 makes all windows scan vertically, but only the one
572 # the cursor is in scans horizontally
573 proc canvscan {op w x y} {
574 global canv canv2 canv3
575 foreach c [list $canv $canv2 $canv3] {
584 proc scrollcanv {cscroll f0 f1} {
589 # when we make a key binding for the toplevel, make sure
590 # it doesn't get triggered when that key is pressed in the
591 # find string entry widget.
592 proc bindkey {ev script} {
595 set escript [bind Entry $ev]
596 if {$escript == {}} {
597 set escript [bind Entry <Key>]
600 bind $e $ev "$escript; break"
604 # set the focus back to the toplevel for any click outside
615 global canv canv2 canv3 ctext cflist mainfont textfont
616 global stuffsaved findmergefiles maxgraphpct
619 if {$stuffsaved} return
620 if {![winfo viewable .]} return
622 set f [open "~/.gitk-new" w]
623 puts $f [list set mainfont $mainfont]
624 puts $f [list set textfont $textfont]
625 puts $f [list set findmergefiles $findmergefiles]
626 puts $f [list set maxgraphpct $maxgraphpct]
627 puts $f [list set maxwidth $maxwidth]
628 puts $f "set geometry(width) [winfo width .ctop]"
629 puts $f "set geometry(height) [winfo height .ctop]"
630 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
631 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
632 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
633 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
634 set wid [expr {([winfo width $ctext] - 8) \
635 / [font measure $textfont "0"]}]
636 puts $f "set geometry(ctextw) $wid"
637 set wid [expr {([winfo width $cflist] - 11) \
638 / [font measure [$cflist cget -font] "0"]}]
639 puts $f "set geometry(cflistw) $wid"
641 file rename -force "~/.gitk-new" "~/.gitk"
646 proc resizeclistpanes {win w} {
648 if {[info exists oldwidth($win)]} {
649 set s0 [$win sash coord 0]
650 set s1 [$win sash coord 1]
652 set sash0 [expr {int($w/2 - 2)}]
653 set sash1 [expr {int($w*5/6 - 2)}]
655 set factor [expr {1.0 * $w / $oldwidth($win)}]
656 set sash0 [expr {int($factor * [lindex $s0 0])}]
657 set sash1 [expr {int($factor * [lindex $s1 0])}]
661 if {$sash1 < $sash0 + 20} {
662 set sash1 [expr {$sash0 + 20}]
664 if {$sash1 > $w - 10} {
665 set sash1 [expr {$w - 10}]
666 if {$sash0 > $sash1 - 20} {
667 set sash0 [expr {$sash1 - 20}]
671 $win sash place 0 $sash0 [lindex $s0 1]
672 $win sash place 1 $sash1 [lindex $s1 1]
674 set oldwidth($win) $w
677 proc resizecdetpanes {win w} {
679 if {[info exists oldwidth($win)]} {
680 set s0 [$win sash coord 0]
682 set sash0 [expr {int($w*3/4 - 2)}]
684 set factor [expr {1.0 * $w / $oldwidth($win)}]
685 set sash0 [expr {int($factor * [lindex $s0 0])}]
689 if {$sash0 > $w - 15} {
690 set sash0 [expr {$w - 15}]
693 $win sash place 0 $sash0 [lindex $s0 1]
695 set oldwidth($win) $w
699 global canv canv2 canv3
705 proc bindall {event action} {
706 global canv canv2 canv3
707 bind $canv $event $action
708 bind $canv2 $event $action
709 bind $canv3 $event $action
714 if {[winfo exists $w]} {
719 wm title $w "About gitk"
721 Gitk - a commit viewer for git
723 Copyright © 2005-2006 Paul Mackerras
725 Use and redistribute under the terms of the GNU General Public License} \
726 -justify center -aspect 400
727 pack $w.m -side top -fill x -padx 20 -pady 20
728 button $w.ok -text Close -command "destroy $w"
729 pack $w.ok -side bottom
732 proc shortids {ids} {
735 if {[llength $id] > 1} {
736 lappend res [shortids $id]
737 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
738 lappend res [string range $id 0 7]
746 proc incrange {l x o} {
751 lset l $x [expr {$e + $o}]
760 for {} {$n > 0} {incr n -1} {
766 proc usedinrange {id l1 l2} {
767 global children commitrow
769 if {[info exists commitrow($id)]} {
770 set r $commitrow($id)
771 if {$l1 <= $r && $r <= $l2} {
772 return [expr {$r - $l1 + 1}]
775 foreach c $children($id) {
776 if {[info exists commitrow($c)]} {
778 if {$l1 <= $r && $r <= $l2} {
779 return [expr {$r - $l1 + 1}]
786 proc sanity {row {full 0}} {
787 global rowidlist rowoffsets
790 set ids [lindex $rowidlist $row]
793 if {$id eq {}} continue
794 if {$col < [llength $ids] - 1 &&
795 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
796 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
798 set o [lindex $rowoffsets $row $col]
804 if {[lindex $rowidlist $y $x] != $id} {
805 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
806 puts " id=[shortids $id] check started at row $row"
807 for {set i $row} {$i >= $y} {incr i -1} {
808 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
813 set o [lindex $rowoffsets $y $x]
818 proc makeuparrow {oid x y z} {
819 global rowidlist rowoffsets uparrowlen idrowranges
821 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
824 set off0 [lindex $rowoffsets $y]
825 for {set x0 $x} {1} {incr x0} {
826 if {$x0 >= [llength $off0]} {
827 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
830 set z [lindex $off0 $x0]
836 set z [expr {$x0 - $x}]
837 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
838 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
840 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
841 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
842 lappend idrowranges($oid) $y
846 global rowidlist rowoffsets displayorder
847 global rowlaidout rowoptim
848 global idinlist rowchk
849 global commitidx numcommits canvxmax canv
858 catch {unset idinlist}
862 set canvxmax [$canv cget -width]
865 proc setcanvscroll {} {
866 global canv canv2 canv3 numcommits linespc canvxmax canvy0
868 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
869 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
870 $canv2 conf -scrollregion [list 0 0 0 $ymax]
871 $canv3 conf -scrollregion [list 0 0 0 $ymax]
874 proc visiblerows {} {
875 global canv numcommits linespc
877 set ymax [lindex [$canv cget -scrollregion] 3]
878 if {$ymax eq {} || $ymax == 0} return
880 set y0 [expr {int([lindex $f 0] * $ymax)}]
881 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
885 set y1 [expr {int([lindex $f 1] * $ymax)}]
886 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
887 if {$r1 >= $numcommits} {
888 set r1 [expr {$numcommits - 1}]
890 return [list $r0 $r1]
894 global rowlaidout rowoptim commitidx numcommits optim_delay
898 set rowlaidout [layoutrows $row $commitidx 0]
899 set orow [expr {$rowlaidout - $uparrowlen - 1}]
900 if {$orow > $rowoptim} {
901 checkcrossings $rowoptim $orow
902 optimize_rows $rowoptim 0 $orow
905 set canshow [expr {$rowoptim - $optim_delay}]
906 if {$canshow > $numcommits} {
911 proc showstuff {canshow} {
913 global linesegends idrowranges idrangedrawn
915 if {$numcommits == 0} {
921 set numcommits $canshow
923 set rows [visiblerows]
924 set r0 [lindex $rows 0]
925 set r1 [lindex $rows 1]
926 for {set r $row} {$r < $canshow} {incr r} {
927 if {[info exists linesegends($r)]} {
928 foreach id $linesegends($r) {
930 foreach {s e} $idrowranges($id) {
932 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
933 && ![info exists idrangedrawn($id,$i)]} {
935 set idrangedrawn($id,$i) 1
941 if {$canshow > $r1} {
944 while {$row < $canshow} {
950 proc layoutrows {row endrow last} {
951 global rowidlist rowoffsets displayorder
952 global uparrowlen downarrowlen maxwidth mingaplen
953 global nchildren parents nparents
954 global idrowranges linesegends
956 global idinlist rowchk
958 set idlist [lindex $rowidlist $row]
959 set offs [lindex $rowoffsets $row]
960 while {$row < $endrow} {
961 set id [lindex $displayorder $row]
964 foreach p $parents($id) {
965 if {![info exists idinlist($p)]} {
967 } elseif {!$idinlist($p)} {
971 set nev [expr {[llength $idlist] + [llength $newolds]
972 + [llength $oldolds] - $maxwidth + 1}]
974 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
975 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
976 set i [lindex $idlist $x]
977 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
978 set r [usedinrange $i [expr {$row - $downarrowlen}] \
979 [expr {$row + $uparrowlen + $mingaplen}]]
981 set idlist [lreplace $idlist $x $x]
982 set offs [lreplace $offs $x $x]
983 set offs [incrange $offs $x 1]
985 set rm1 [expr {$row - 1}]
986 lappend linesegends($rm1) $i
987 lappend idrowranges($i) $rm1
988 if {[incr nev -1] <= 0} break
991 set rowchk($id) [expr {$row + $r}]
994 lset rowidlist $row $idlist
995 lset rowoffsets $row $offs
997 set col [lsearch -exact $idlist $id]
999 set col [llength $idlist]
1001 lset rowidlist $row $idlist
1003 if {$nchildren($id) > 0} {
1004 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1008 lset rowoffsets $row $offs
1010 makeuparrow $id $col $row $z
1015 if {[info exists idrowranges($id)]} {
1016 lappend idrowranges($id) $row
1019 set offs [ntimes [llength $idlist] 0]
1020 set l [llength $newolds]
1021 set idlist [eval lreplace \$idlist $col $col $newolds]
1024 set offs [lrange $offs 0 [expr {$col - 1}]]
1025 foreach x $newolds {
1030 set tmp [expr {[llength $idlist] - [llength $offs]}]
1032 set offs [concat $offs [ntimes $tmp $o]]
1037 foreach i $newolds {
1039 set idrowranges($i) $row
1042 foreach oid $oldolds {
1043 set idinlist($oid) 1
1044 set idlist [linsert $idlist $col $oid]
1045 set offs [linsert $offs $col $o]
1046 makeuparrow $oid $col $row $o
1049 lappend rowidlist $idlist
1050 lappend rowoffsets $offs
1055 proc addextraid {id row} {
1056 global displayorder commitrow commitinfo nparents
1060 lappend displayorder $id
1061 set commitrow($id) $row
1063 if {![info exists commitinfo($id)]} {
1064 set commitinfo($id) {"No commit information available"}
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 set downarrowcols {}
1117 if {[info exists linesegends($row)]} {
1118 set downarrowcols $linesegends($row)
1120 while {$downarrowcols ne {}} {
1121 set i [lsearch -exact $idlist [lindex $downarrowcols 0]]
1122 if {$i < 0 || $i >= $col} break
1123 set downarrowcols [lrange $downarrowcols 1 end]
1127 for {} {$col < [llength $offs]} {incr col} {
1128 if {[lindex $idlist $col] eq {}} {
1132 set z [lindex $offs $col]
1133 if {$z eq {}} continue
1135 set x0 [expr {$col + $z}]
1136 set y0 [expr {$row - 1}]
1137 set z0 [lindex $rowoffsets $y0 $x0]
1139 set id [lindex $idlist $col]
1140 if {[info exists idrowranges($id)] &&
1141 $y0 > [lindex $idrowranges($id) 0]} {
1144 } elseif {$downarrowcols ne {} &&
1145 [lindex $idlist $col] eq [lindex $downarrowcols 0]} {
1146 set downarrowcols [lrange $downarrowcols 1 end]
1149 if {$z < -1 || ($z < 0 && $isarrow)} {
1150 set npad [expr {-1 - $z + $isarrow}]
1151 set offs [incrange $offs $col $npad]
1152 insert_pad $y0 $x0 $npad
1154 optimize_rows $y0 $x0 $row
1156 set z [lindex $offs $col]
1157 set x0 [expr {$col + $z}]
1158 set z0 [lindex $rowoffsets $y0 $x0]
1159 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1160 set npad [expr {$z - 1 + $isarrow}]
1161 set y1 [expr {$row + 1}]
1162 set offs2 [lindex $rowoffsets $y1]
1166 if {$z eq {} || $x1 + $z < $col} continue
1167 if {$x1 + $z > $col} {
1170 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1173 set pad [ntimes $npad {}]
1174 set idlist [eval linsert \$idlist $col $pad]
1175 set tmp [eval linsert \$offs $col $pad]
1177 set offs [incrange $tmp $col [expr {-$npad}]]
1178 set z [lindex $offs $col]
1181 if {$z0 eq {} && !$isarrow} {
1182 # this line links to its first child on row $row-2
1183 set rm2 [expr {$row - 2}]
1184 set id [lindex $displayorder $rm2]
1185 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1187 set z0 [expr {$xc - $x0}]
1190 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1191 insert_pad $y0 $x0 1
1192 set offs [incrange $offs $col 1]
1193 optimize_rows $y0 [expr {$x0 + 1}] $row
1198 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1199 set o [lindex $offs $col]
1201 # check if this is the link to the first child
1202 set id [lindex $idlist $col]
1203 if {[info exists idrowranges($id)] &&
1204 $row == [lindex $idrowranges($id) 0]} {
1205 # it is, work out offset to child
1206 set y0 [expr {$row - 1}]
1207 set id [lindex $displayorder $y0]
1208 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1210 set o [expr {$x0 - $col}]
1214 if {$o eq {} || $o <= 0} break
1216 if {$o ne {} && [incr col] < [llength $idlist]} {
1217 set y1 [expr {$row + 1}]
1218 set offs2 [lindex $rowoffsets $y1]
1222 if {$z eq {} || $x1 + $z < $col} continue
1223 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1226 set idlist [linsert $idlist $col {}]
1227 set tmp [linsert $offs $col {}]
1229 set offs [incrange $tmp $col -1]
1232 lset rowidlist $row $idlist
1233 lset rowoffsets $row $offs
1239 global canvx0 linespc
1240 return [expr {$canvx0 + $col * $linespc}]
1244 global canvy0 linespc
1245 return [expr {$canvy0 + $row * $linespc}]
1248 proc linewidth {id} {
1249 global thickerline lthickness
1252 if {[info exists thickerline] && $id eq $thickerline} {
1253 set wid [expr {2 * $lthickness}]
1258 proc drawlineseg {id i} {
1259 global rowoffsets rowidlist idrowranges
1261 global canv colormap
1263 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1264 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1265 if {$startrow == $row} return
1268 set col [lsearch -exact [lindex $rowidlist $row] $id]
1270 puts "oops: drawline: id $id not on row $row"
1276 set o [lindex $rowoffsets $row $col]
1279 # changing direction
1280 set x [xc $row $col]
1282 lappend coords $x $y
1288 set x [xc $row $col]
1290 lappend coords $x $y
1292 # draw the link to the first child as part of this line
1294 set child [lindex $displayorder $row]
1295 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1297 set x [xc $row $ccol]
1299 if {$ccol < $col - 1} {
1300 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1301 } elseif {$ccol > $col + 1} {
1302 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1304 lappend coords $x $y
1307 if {[llength $coords] < 4} return
1308 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1309 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1310 set arrow [lindex {none first last both} $arrow]
1311 set t [$canv create line $coords -width [linewidth $id] \
1312 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1317 proc drawparentlinks {id row col olds} {
1318 global rowidlist canv colormap idrowranges
1320 set row2 [expr {$row + 1}]
1321 set x [xc $row $col]
1324 set ids [lindex $rowidlist $row2]
1325 # rmx = right-most X coord used
1328 set i [lsearch -exact $ids $p]
1330 puts "oops, parent $p of $id not in list"
1333 set x2 [xc $row2 $i]
1337 if {[info exists idrowranges($p)] &&
1338 $row2 == [lindex $idrowranges($p) 0] &&
1339 $row2 < [lindex $idrowranges($p) 1]} {
1340 # drawlineseg will do this one for us
1344 # should handle duplicated parents here...
1345 set coords [list $x $y]
1346 if {$i < $col - 1} {
1347 lappend coords [xc $row [expr {$i + 1}]] $y
1348 } elseif {$i > $col + 1} {
1349 lappend coords [xc $row [expr {$i - 1}]] $y
1351 lappend coords $x2 $y2
1352 set t [$canv create line $coords -width [linewidth $p] \
1353 -fill $colormap($p) -tags lines.$p]
1360 proc drawlines {id} {
1361 global colormap canv
1362 global idrowranges idrangedrawn
1363 global children iddrawn commitrow rowidlist
1365 $canv delete lines.$id
1366 set nr [expr {[llength $idrowranges($id)] / 2}]
1367 for {set i 0} {$i < $nr} {incr i} {
1368 if {[info exists idrangedrawn($id,$i)]} {
1372 if {[info exists children($id)]} {
1373 foreach child $children($id) {
1374 if {[info exists iddrawn($child)]} {
1375 set row $commitrow($child)
1376 set col [lsearch -exact [lindex $rowidlist $row] $child]
1378 drawparentlinks $child $row $col [list $id]
1385 proc drawcmittext {id row col rmx} {
1386 global linespc canv canv2 canv3 canvy0
1387 global commitlisted commitinfo rowidlist
1388 global rowtextx idpos idtags idheads idotherrefs
1389 global linehtag linentag linedtag
1390 global mainfont namefont canvxmax
1392 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1393 set x [xc $row $col]
1395 set orad [expr {$linespc / 3}]
1396 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1397 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1398 -fill $ofill -outline black -width 1]
1400 $canv bind $t <1> {selcanvline {} %x %y}
1401 set xt [xc $row [llength [lindex $rowidlist $row]]]
1405 set rowtextx($row) $xt
1406 set idpos($id) [list $x $xt $y]
1407 if {[info exists idtags($id)] || [info exists idheads($id)]
1408 || [info exists idotherrefs($id)]} {
1409 set xt [drawtags $id $x $xt $y]
1411 set headline [lindex $commitinfo($id) 0]
1412 set name [lindex $commitinfo($id) 1]
1413 set date [lindex $commitinfo($id) 2]
1414 set date [formatdate $date]
1415 set linehtag($row) [$canv create text $xt $y -anchor w \
1416 -text $headline -font $mainfont ]
1417 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1418 set linentag($row) [$canv2 create text 3 $y -anchor w \
1419 -text $name -font $namefont]
1420 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1421 -text $date -font $mainfont]
1422 set xr [expr {$xt + [font measure $mainfont $headline]}]
1423 if {$xr > $canvxmax} {
1429 proc drawcmitrow {row} {
1430 global displayorder rowidlist
1431 global idrowranges idrangedrawn iddrawn
1432 global commitinfo commitlisted parents numcommits
1434 if {$row >= $numcommits} return
1435 foreach id [lindex $rowidlist $row] {
1436 if {![info exists idrowranges($id)]} continue
1438 foreach {s e} $idrowranges($id) {
1440 if {$row < $s} continue
1443 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1445 set idrangedrawn($id,$i) 1
1452 set id [lindex $displayorder $row]
1453 if {[info exists iddrawn($id)]} return
1454 set col [lsearch -exact [lindex $rowidlist $row] $id]
1456 puts "oops, row $row id $id not in list"
1459 if {![info exists commitinfo($id)]} {
1463 if {[info exists commitlisted($id)] && [info exists parents($id)]
1464 && $parents($id) ne {}} {
1465 set rmx [drawparentlinks $id $row $col $parents($id)]
1469 drawcmittext $id $row $col $rmx
1473 proc drawfrac {f0 f1} {
1474 global numcommits canv
1477 set ymax [lindex [$canv cget -scrollregion] 3]
1478 if {$ymax eq {} || $ymax == 0} return
1479 set y0 [expr {int($f0 * $ymax)}]
1480 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1484 set y1 [expr {int($f1 * $ymax)}]
1485 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1486 if {$endrow >= $numcommits} {
1487 set endrow [expr {$numcommits - 1}]
1489 for {} {$row <= $endrow} {incr row} {
1494 proc drawvisible {} {
1496 eval drawfrac [$canv yview]
1499 proc clear_display {} {
1500 global iddrawn idrangedrawn
1503 catch {unset iddrawn}
1504 catch {unset idrangedrawn}
1507 proc assigncolor {id} {
1508 global colormap colors nextcolor
1509 global parents nparents children nchildren
1510 global cornercrossings crossings
1512 if {[info exists colormap($id)]} return
1513 set ncolors [llength $colors]
1514 if {$nchildren($id) == 1} {
1515 set child [lindex $children($id) 0]
1516 if {[info exists colormap($child)]
1517 && $nparents($child) == 1} {
1518 set colormap($id) $colormap($child)
1523 if {[info exists cornercrossings($id)]} {
1524 foreach x $cornercrossings($id) {
1525 if {[info exists colormap($x)]
1526 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1527 lappend badcolors $colormap($x)
1530 if {[llength $badcolors] >= $ncolors} {
1534 set origbad $badcolors
1535 if {[llength $badcolors] < $ncolors - 1} {
1536 if {[info exists crossings($id)]} {
1537 foreach x $crossings($id) {
1538 if {[info exists colormap($x)]
1539 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1540 lappend badcolors $colormap($x)
1543 if {[llength $badcolors] >= $ncolors} {
1544 set badcolors $origbad
1547 set origbad $badcolors
1549 if {[llength $badcolors] < $ncolors - 1} {
1550 foreach child $children($id) {
1551 if {[info exists colormap($child)]
1552 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1553 lappend badcolors $colormap($child)
1555 if {[info exists parents($child)]} {
1556 foreach p $parents($child) {
1557 if {[info exists colormap($p)]
1558 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1559 lappend badcolors $colormap($p)
1564 if {[llength $badcolors] >= $ncolors} {
1565 set badcolors $origbad
1568 for {set i 0} {$i <= $ncolors} {incr i} {
1569 set c [lindex $colors $nextcolor]
1570 if {[incr nextcolor] >= $ncolors} {
1573 if {[lsearch -exact $badcolors $c]} break
1575 set colormap($id) $c
1578 proc bindline {t id} {
1581 $canv bind $t <Enter> "lineenter %x %y $id"
1582 $canv bind $t <Motion> "linemotion %x %y $id"
1583 $canv bind $t <Leave> "lineleave $id"
1584 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1587 proc drawtags {id x xt y1} {
1588 global idtags idheads idotherrefs
1589 global linespc lthickness
1590 global canv mainfont commitrow rowtextx
1595 if {[info exists idtags($id)]} {
1596 set marks $idtags($id)
1597 set ntags [llength $marks]
1599 if {[info exists idheads($id)]} {
1600 set marks [concat $marks $idheads($id)]
1601 set nheads [llength $idheads($id)]
1603 if {[info exists idotherrefs($id)]} {
1604 set marks [concat $marks $idotherrefs($id)]
1610 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1611 set yt [expr {$y1 - 0.5 * $linespc}]
1612 set yb [expr {$yt + $linespc - 1}]
1615 foreach tag $marks {
1616 set wid [font measure $mainfont $tag]
1619 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1621 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1622 -width $lthickness -fill black -tags tag.$id]
1624 foreach tag $marks x $xvals wid $wvals {
1625 set xl [expr {$x + $delta}]
1626 set xr [expr {$x + $delta + $wid + $lthickness}]
1627 if {[incr ntags -1] >= 0} {
1629 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1630 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1631 -width 1 -outline black -fill yellow -tags tag.$id]
1632 $canv bind $t <1> [list showtag $tag 1]
1633 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1635 # draw a head or other ref
1636 if {[incr nheads -1] >= 0} {
1641 set xl [expr {$xl - $delta/2}]
1642 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1643 -width 1 -outline black -fill $col -tags tag.$id
1645 set t [$canv create text $xl $y1 -anchor w -text $tag \
1646 -font $mainfont -tags tag.$id]
1648 $canv bind $t <1> [list showtag $tag 1]
1654 proc checkcrossings {row endrow} {
1655 global displayorder parents rowidlist
1657 for {} {$row < $endrow} {incr row} {
1658 set id [lindex $displayorder $row]
1659 set i [lsearch -exact [lindex $rowidlist $row] $id]
1660 if {$i < 0} continue
1661 set idlist [lindex $rowidlist [expr {$row+1}]]
1662 foreach p $parents($id) {
1663 set j [lsearch -exact $idlist $p]
1666 notecrossings $row $p $j $i [expr {$j+1}]
1667 } elseif {$j > $i + 1} {
1668 notecrossings $row $p $i $j [expr {$j-1}]
1675 proc notecrossings {row id lo hi corner} {
1676 global rowidlist crossings cornercrossings
1678 for {set i $lo} {[incr i] < $hi} {} {
1679 set p [lindex [lindex $rowidlist $row] $i]
1680 if {$p == {}} continue
1681 if {$i == $corner} {
1682 if {![info exists cornercrossings($id)]
1683 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1684 lappend cornercrossings($id) $p
1686 if {![info exists cornercrossings($p)]
1687 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1688 lappend cornercrossings($p) $id
1691 if {![info exists crossings($id)]
1692 || [lsearch -exact $crossings($id) $p] < 0} {
1693 lappend crossings($id) $p
1695 if {![info exists crossings($p)]
1696 || [lsearch -exact $crossings($p) $id] < 0} {
1697 lappend crossings($p) $id
1703 proc xcoord {i level ln} {
1704 global canvx0 xspc1 xspc2
1706 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1707 if {$i > 0 && $i == $level} {
1708 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1709 } elseif {$i > $level} {
1710 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1715 proc finishcommits {} {
1716 global commitidx phase
1717 global canv mainfont ctext maincursor textcursor
1718 global findinprogress
1720 if {$commitidx > 0} {
1724 $canv create text 3 3 -anchor nw -text "No commits selected" \
1725 -font $mainfont -tags textitems
1727 if {![info exists findinprogress]} {
1728 . config -cursor $maincursor
1729 settextcursor $textcursor
1734 # Don't change the text pane cursor if it is currently the hand cursor,
1735 # showing that we are over a sha1 ID link.
1736 proc settextcursor {c} {
1737 global ctext curtextcursor
1739 if {[$ctext cget -cursor] == $curtextcursor} {
1740 $ctext config -cursor $c
1742 set curtextcursor $c
1748 global canvy0 numcommits linespc
1749 global rowlaidout commitidx
1752 layoutrows $rowlaidout $commitidx 1
1754 optimize_rows $row 0 $commitidx
1755 showstuff $commitidx
1757 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1758 #puts "overall $drawmsecs ms for $numcommits commits"
1761 proc findmatches {f} {
1762 global findtype foundstring foundstrlen
1763 if {$findtype == "Regexp"} {
1764 set matches [regexp -indices -all -inline $foundstring $f]
1766 if {$findtype == "IgnCase"} {
1767 set str [string tolower $f]
1773 while {[set j [string first $foundstring $str $i]] >= 0} {
1774 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1775 set i [expr {$j + $foundstrlen}]
1782 global findtype findloc findstring markedmatches commitinfo
1783 global numcommits displayorder linehtag linentag linedtag
1784 global mainfont namefont canv canv2 canv3 selectedline
1785 global matchinglines foundstring foundstrlen matchstring
1791 set matchinglines {}
1792 if {$findloc == "Pickaxe"} {
1796 if {$findtype == "IgnCase"} {
1797 set foundstring [string tolower $findstring]
1799 set foundstring $findstring
1801 set foundstrlen [string length $findstring]
1802 if {$foundstrlen == 0} return
1803 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1804 set matchstring "*$matchstring*"
1805 if {$findloc == "Files"} {
1809 if {![info exists selectedline]} {
1812 set oldsel $selectedline
1815 set fldtypes {Headline Author Date Committer CDate Comment}
1817 foreach id $displayorder {
1818 set d $commitdata($id)
1820 if {$findtype == "Regexp"} {
1821 set doesmatch [regexp $foundstring $d]
1822 } elseif {$findtype == "IgnCase"} {
1823 set doesmatch [string match -nocase $matchstring $d]
1825 set doesmatch [string match $matchstring $d]
1827 if {!$doesmatch} continue
1828 if {![info exists commitinfo($id)]} {
1831 set info $commitinfo($id)
1833 foreach f $info ty $fldtypes {
1834 if {$findloc != "All fields" && $findloc != $ty} {
1837 set matches [findmatches $f]
1838 if {$matches == {}} continue
1840 if {$ty == "Headline"} {
1842 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1843 } elseif {$ty == "Author"} {
1845 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1846 } elseif {$ty == "Date"} {
1848 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1852 lappend matchinglines $l
1853 if {!$didsel && $l > $oldsel} {
1859 if {$matchinglines == {}} {
1861 } elseif {!$didsel} {
1862 findselectline [lindex $matchinglines 0]
1866 proc findselectline {l} {
1867 global findloc commentend ctext
1869 if {$findloc == "All fields" || $findloc == "Comments"} {
1870 # highlight the matches in the comments
1871 set f [$ctext get 1.0 $commentend]
1872 set matches [findmatches $f]
1873 foreach match $matches {
1874 set start [lindex $match 0]
1875 set end [expr {[lindex $match 1] + 1}]
1876 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1881 proc findnext {restart} {
1882 global matchinglines selectedline
1883 if {![info exists matchinglines]} {
1889 if {![info exists selectedline]} return
1890 foreach l $matchinglines {
1891 if {$l > $selectedline} {
1900 global matchinglines selectedline
1901 if {![info exists matchinglines]} {
1905 if {![info exists selectedline]} return
1907 foreach l $matchinglines {
1908 if {$l >= $selectedline} break
1912 findselectline $prev
1918 proc findlocchange {name ix op} {
1919 global findloc findtype findtypemenu
1920 if {$findloc == "Pickaxe"} {
1926 $findtypemenu entryconf 1 -state $state
1927 $findtypemenu entryconf 2 -state $state
1930 proc stopfindproc {{done 0}} {
1931 global findprocpid findprocfile findids
1932 global ctext findoldcursor phase maincursor textcursor
1933 global findinprogress
1935 catch {unset findids}
1936 if {[info exists findprocpid]} {
1938 catch {exec kill $findprocpid}
1940 catch {close $findprocfile}
1943 if {[info exists findinprogress]} {
1944 unset findinprogress
1945 if {$phase != "incrdraw"} {
1946 . config -cursor $maincursor
1947 settextcursor $textcursor
1952 proc findpatches {} {
1953 global findstring selectedline numcommits
1954 global findprocpid findprocfile
1955 global finddidsel ctext displayorder findinprogress
1956 global findinsertpos
1958 if {$numcommits == 0} return
1960 # make a list of all the ids to search, starting at the one
1961 # after the selected line (if any)
1962 if {[info exists selectedline]} {
1968 for {set i 0} {$i < $numcommits} {incr i} {
1969 if {[incr l] >= $numcommits} {
1972 append inputids [lindex $displayorder $l] "\n"
1976 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1979 error_popup "Error starting search process: $err"
1983 set findinsertpos end
1985 set findprocpid [pid $f]
1986 fconfigure $f -blocking 0
1987 fileevent $f readable readfindproc
1989 . config -cursor watch
1991 set findinprogress 1
1994 proc readfindproc {} {
1995 global findprocfile finddidsel
1996 global commitrow matchinglines findinsertpos
1998 set n [gets $findprocfile line]
2000 if {[eof $findprocfile]} {
2008 if {![regexp {^[0-9a-f]{40}} $line id]} {
2009 error_popup "Can't parse git-diff-tree output: $line"
2013 if {![info exists commitrow($id)]} {
2014 puts stderr "spurious id: $id"
2017 set l $commitrow($id)
2021 proc insertmatch {l id} {
2022 global matchinglines findinsertpos finddidsel
2024 if {$findinsertpos == "end"} {
2025 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2026 set matchinglines [linsert $matchinglines 0 $l]
2029 lappend matchinglines $l
2032 set matchinglines [linsert $matchinglines $findinsertpos $l]
2043 global selectedline numcommits displayorder ctext
2044 global ffileline finddidsel parents nparents
2045 global findinprogress findstartline findinsertpos
2046 global treediffs fdiffid fdiffsneeded fdiffpos
2047 global findmergefiles
2049 if {$numcommits == 0} return
2051 if {[info exists selectedline]} {
2052 set l [expr {$selectedline + 1}]
2057 set findstartline $l
2061 set id [lindex $displayorder $l]
2062 if {$findmergefiles || $nparents($id) == 1} {
2063 if {![info exists treediffs($id)]} {
2064 append diffsneeded "$id\n"
2065 lappend fdiffsneeded $id
2068 if {[incr l] >= $numcommits} {
2071 if {$l == $findstartline} break
2074 # start off a git-diff-tree process if needed
2075 if {$diffsneeded ne {}} {
2077 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2079 error_popup "Error starting search process: $err"
2082 catch {unset fdiffid}
2084 fconfigure $df -blocking 0
2085 fileevent $df readable [list readfilediffs $df]
2089 set findinsertpos end
2090 set id [lindex $displayorder $l]
2091 . config -cursor watch
2093 set findinprogress 1
2098 proc readfilediffs {df} {
2099 global findid fdiffid fdiffs
2101 set n [gets $df line]
2105 if {[catch {close $df} err]} {
2108 error_popup "Error in git-diff-tree: $err"
2109 } elseif {[info exists findid]} {
2113 error_popup "Couldn't find diffs for $id"
2118 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2119 # start of a new string of diffs
2123 } elseif {[string match ":*" $line]} {
2124 lappend fdiffs [lindex $line 5]
2128 proc donefilediff {} {
2129 global fdiffid fdiffs treediffs findid
2130 global fdiffsneeded fdiffpos
2132 if {[info exists fdiffid]} {
2133 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2134 && $fdiffpos < [llength $fdiffsneeded]} {
2135 # git-diff-tree doesn't output anything for a commit
2136 # which doesn't change anything
2137 set nullid [lindex $fdiffsneeded $fdiffpos]
2138 set treediffs($nullid) {}
2139 if {[info exists findid] && $nullid eq $findid} {
2147 if {![info exists treediffs($fdiffid)]} {
2148 set treediffs($fdiffid) $fdiffs
2150 if {[info exists findid] && $fdiffid eq $findid} {
2157 proc findcont {id} {
2158 global findid treediffs parents nparents
2159 global ffileline findstartline finddidsel
2160 global displayorder numcommits matchinglines findinprogress
2161 global findmergefiles
2165 if {$findmergefiles || $nparents($id) == 1} {
2166 if {![info exists treediffs($id)]} {
2172 foreach f $treediffs($id) {
2173 set x [findmatches $f]
2183 if {[incr l] >= $numcommits} {
2186 if {$l == $findstartline} break
2187 set id [lindex $displayorder $l]
2195 # mark a commit as matching by putting a yellow background
2196 # behind the headline
2197 proc markheadline {l id} {
2198 global canv mainfont linehtag
2201 set bbox [$canv bbox $linehtag($l)]
2202 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2206 # mark the bits of a headline, author or date that match a find string
2207 proc markmatches {canv l str tag matches font} {
2208 set bbox [$canv bbox $tag]
2209 set x0 [lindex $bbox 0]
2210 set y0 [lindex $bbox 1]
2211 set y1 [lindex $bbox 3]
2212 foreach match $matches {
2213 set start [lindex $match 0]
2214 set end [lindex $match 1]
2215 if {$start > $end} continue
2216 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2217 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2218 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2219 [expr {$x0+$xlen+2}] $y1 \
2220 -outline {} -tags matches -fill yellow]
2225 proc unmarkmatches {} {
2226 global matchinglines findids
2227 allcanvs delete matches
2228 catch {unset matchinglines}
2229 catch {unset findids}
2232 proc selcanvline {w x y} {
2233 global canv canvy0 ctext linespc
2235 set ymax [lindex [$canv cget -scrollregion] 3]
2236 if {$ymax == {}} return
2237 set yfrac [lindex [$canv yview] 0]
2238 set y [expr {$y + $yfrac * $ymax}]
2239 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2244 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2250 proc commit_descriptor {p} {
2253 if {[info exists commitinfo($p)]} {
2254 set l [lindex $commitinfo($p) 0]
2259 # append some text to the ctext widget, and make any SHA1 ID
2260 # that we know about be a clickable link.
2261 proc appendwithlinks {text} {
2262 global ctext commitrow linknum
2264 set start [$ctext index "end - 1c"]
2265 $ctext insert end $text
2266 $ctext insert end "\n"
2267 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2271 set linkid [string range $text $s $e]
2272 if {![info exists commitrow($linkid)]} continue
2274 $ctext tag add link "$start + $s c" "$start + $e c"
2275 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2276 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2279 $ctext tag conf link -foreground blue -underline 1
2280 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2281 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2284 proc selectline {l isnew} {
2285 global canv canv2 canv3 ctext commitinfo selectedline
2286 global displayorder linehtag linentag linedtag
2287 global canvy0 linespc parents nparents children
2288 global cflist currentid sha1entry
2289 global commentend idtags linknum
2290 global mergemax numcommits
2294 if {$l < 0 || $l >= $numcommits} return
2295 set y [expr {$canvy0 + $l * $linespc}]
2296 set ymax [lindex [$canv cget -scrollregion] 3]
2297 set ytop [expr {$y - $linespc - 1}]
2298 set ybot [expr {$y + $linespc + 1}]
2299 set wnow [$canv yview]
2300 set wtop [expr {[lindex $wnow 0] * $ymax}]
2301 set wbot [expr {[lindex $wnow 1] * $ymax}]
2302 set wh [expr {$wbot - $wtop}]
2304 if {$ytop < $wtop} {
2305 if {$ybot < $wtop} {
2306 set newtop [expr {$y - $wh / 2.0}]
2309 if {$newtop > $wtop - $linespc} {
2310 set newtop [expr {$wtop - $linespc}]
2313 } elseif {$ybot > $wbot} {
2314 if {$ytop > $wbot} {
2315 set newtop [expr {$y - $wh / 2.0}]
2317 set newtop [expr {$ybot - $wh}]
2318 if {$newtop < $wtop + $linespc} {
2319 set newtop [expr {$wtop + $linespc}]
2323 if {$newtop != $wtop} {
2327 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2331 if {![info exists linehtag($l)]} return
2333 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2334 -tags secsel -fill [$canv cget -selectbackground]]
2336 $canv2 delete secsel
2337 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2338 -tags secsel -fill [$canv2 cget -selectbackground]]
2340 $canv3 delete secsel
2341 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2342 -tags secsel -fill [$canv3 cget -selectbackground]]
2346 addtohistory [list selectline $l 0]
2351 set id [lindex $displayorder $l]
2353 $sha1entry delete 0 end
2354 $sha1entry insert 0 $id
2355 $sha1entry selection from 0
2356 $sha1entry selection to end
2358 $ctext conf -state normal
2359 $ctext delete 0.0 end
2361 $ctext mark set fmark.0 0.0
2362 $ctext mark gravity fmark.0 left
2363 set info $commitinfo($id)
2364 set date [formatdate [lindex $info 2]]
2365 $ctext insert end "Author: [lindex $info 1] $date\n"
2366 set date [formatdate [lindex $info 4]]
2367 $ctext insert end "Committer: [lindex $info 3] $date\n"
2368 if {[info exists idtags($id)]} {
2369 $ctext insert end "Tags:"
2370 foreach tag $idtags($id) {
2371 $ctext insert end " $tag"
2373 $ctext insert end "\n"
2377 if {$nparents($id) > 1} {
2379 foreach p $parents($id) {
2380 if {$np >= $mergemax} {
2385 $ctext insert end "Parent: " $tag
2386 appendwithlinks [commit_descriptor $p]
2390 if {[info exists parents($id)]} {
2391 foreach p $parents($id) {
2392 append comment "Parent: [commit_descriptor $p]\n"
2397 if {[info exists children($id)]} {
2398 foreach c $children($id) {
2399 append comment "Child: [commit_descriptor $c]\n"
2403 append comment [lindex $info 5]
2405 # make anything that looks like a SHA1 ID be a clickable link
2406 appendwithlinks $comment
2408 $ctext tag delete Comments
2409 $ctext tag remove found 1.0 end
2410 $ctext conf -state disabled
2411 set commentend [$ctext index "end - 1c"]
2413 $cflist delete 0 end
2414 $cflist insert end "Comments"
2415 if {$nparents($id) <= 1} {
2422 proc selnextline {dir} {
2424 if {![info exists selectedline]} return
2425 set l [expr {$selectedline + $dir}]
2430 proc unselectline {} {
2433 catch {unset selectedline}
2434 allcanvs delete secsel
2437 proc addtohistory {cmd} {
2438 global history historyindex
2440 if {$historyindex > 0
2441 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2445 if {$historyindex < [llength $history]} {
2446 set history [lreplace $history $historyindex end $cmd]
2448 lappend history $cmd
2451 if {$historyindex > 1} {
2452 .ctop.top.bar.leftbut conf -state normal
2454 .ctop.top.bar.leftbut conf -state disabled
2456 .ctop.top.bar.rightbut conf -state disabled
2460 global history historyindex
2462 if {$historyindex > 1} {
2463 incr historyindex -1
2464 set cmd [lindex $history [expr {$historyindex - 1}]]
2466 .ctop.top.bar.rightbut conf -state normal
2468 if {$historyindex <= 1} {
2469 .ctop.top.bar.leftbut conf -state disabled
2474 global history historyindex
2476 if {$historyindex < [llength $history]} {
2477 set cmd [lindex $history $historyindex]
2480 .ctop.top.bar.leftbut conf -state normal
2482 if {$historyindex >= [llength $history]} {
2483 .ctop.top.bar.rightbut conf -state disabled
2487 proc mergediff {id} {
2488 global parents diffmergeid diffopts mdifffd
2489 global difffilestart diffids
2493 catch {unset difffilestart}
2494 # this doesn't seem to actually affect anything...
2495 set env(GIT_DIFF_OPTS) $diffopts
2496 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2497 if {[catch {set mdf [open $cmd r]} err]} {
2498 error_popup "Error getting merge diffs: $err"
2501 fconfigure $mdf -blocking 0
2502 set mdifffd($id) $mdf
2503 fileevent $mdf readable [list getmergediffline $mdf $id]
2504 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2507 proc getmergediffline {mdf id} {
2508 global diffmergeid ctext cflist nextupdate nparents mergemax
2509 global difffilestart mdifffd
2511 set n [gets $mdf line]
2518 if {![info exists diffmergeid] || $id != $diffmergeid
2519 || $mdf != $mdifffd($id)} {
2522 $ctext conf -state normal
2523 if {[regexp {^diff --cc (.*)} $line match fname]} {
2524 # start of a new file
2525 $ctext insert end "\n"
2526 set here [$ctext index "end - 1c"]
2527 set i [$cflist index end]
2528 $ctext mark set fmark.$i $here
2529 $ctext mark gravity fmark.$i left
2530 set difffilestart([expr {$i-1}]) $here
2531 $cflist insert end $fname
2532 set l [expr {(78 - [string length $fname]) / 2}]
2533 set pad [string range "----------------------------------------" 1 $l]
2534 $ctext insert end "$pad $fname $pad\n" filesep
2535 } elseif {[regexp {^@@} $line]} {
2536 $ctext insert end "$line\n" hunksep
2537 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2540 # parse the prefix - one ' ', '-' or '+' for each parent
2541 set np $nparents($id)
2546 for {set j 0} {$j < $np} {incr j} {
2547 set c [string range $line $j $j]
2550 } elseif {$c == "-"} {
2552 } elseif {$c == "+"} {
2561 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2562 # line doesn't appear in result, parents in $minuses have the line
2563 set num [lindex $minuses 0]
2564 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2565 # line appears in result, parents in $pluses don't have the line
2566 lappend tags mresult
2567 set num [lindex $spaces 0]
2570 if {$num >= $mergemax} {
2575 $ctext insert end "$line\n" $tags
2577 $ctext conf -state disabled
2578 if {[clock clicks -milliseconds] >= $nextupdate} {
2580 fileevent $mdf readable {}
2582 fileevent $mdf readable [list getmergediffline $mdf $id]
2586 proc startdiff {ids} {
2587 global treediffs diffids treepending diffmergeid
2590 catch {unset diffmergeid}
2591 if {![info exists treediffs($ids)]} {
2592 if {![info exists treepending]} {
2600 proc addtocflist {ids} {
2601 global treediffs cflist
2602 foreach f $treediffs($ids) {
2603 $cflist insert end $f
2608 proc gettreediffs {ids} {
2609 global treediff parents treepending
2610 set treepending $ids
2613 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2615 fconfigure $gdtf -blocking 0
2616 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2619 proc gettreediffline {gdtf ids} {
2620 global treediff treediffs treepending diffids diffmergeid
2622 set n [gets $gdtf line]
2624 if {![eof $gdtf]} return
2626 set treediffs($ids) $treediff
2628 if {$ids != $diffids} {
2629 if {![info exists diffmergeid]} {
2630 gettreediffs $diffids
2637 set file [lindex $line 5]
2638 lappend treediff $file
2641 proc getblobdiffs {ids} {
2642 global diffopts blobdifffd diffids env curdifftag curtagstart
2643 global difffilestart nextupdate diffinhdr treediffs
2645 set env(GIT_DIFF_OPTS) $diffopts
2646 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2647 if {[catch {set bdf [open $cmd r]} err]} {
2648 puts "error getting diffs: $err"
2652 fconfigure $bdf -blocking 0
2653 set blobdifffd($ids) $bdf
2654 set curdifftag Comments
2656 catch {unset difffilestart}
2657 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2658 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2661 proc getblobdiffline {bdf ids} {
2662 global diffids blobdifffd ctext curdifftag curtagstart
2663 global diffnexthead diffnextnote difffilestart
2664 global nextupdate diffinhdr treediffs
2666 set n [gets $bdf line]
2670 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2671 $ctext tag add $curdifftag $curtagstart end
2676 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2679 $ctext conf -state normal
2680 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2681 # start of a new file
2682 $ctext insert end "\n"
2683 $ctext tag add $curdifftag $curtagstart end
2684 set curtagstart [$ctext index "end - 1c"]
2686 set here [$ctext index "end - 1c"]
2687 set i [lsearch -exact $treediffs($diffids) $fname]
2689 set difffilestart($i) $here
2691 $ctext mark set fmark.$i $here
2692 $ctext mark gravity fmark.$i left
2694 if {$newname != $fname} {
2695 set i [lsearch -exact $treediffs($diffids) $newname]
2697 set difffilestart($i) $here
2699 $ctext mark set fmark.$i $here
2700 $ctext mark gravity fmark.$i left
2703 set curdifftag "f:$fname"
2704 $ctext tag delete $curdifftag
2705 set l [expr {(78 - [string length $header]) / 2}]
2706 set pad [string range "----------------------------------------" 1 $l]
2707 $ctext insert end "$pad $header $pad\n" filesep
2709 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2711 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2713 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2714 $line match f1l f1c f2l f2c rest]} {
2715 $ctext insert end "$line\n" hunksep
2718 set x [string range $line 0 0]
2719 if {$x == "-" || $x == "+"} {
2720 set tag [expr {$x == "+"}]
2721 $ctext insert end "$line\n" d$tag
2722 } elseif {$x == " "} {
2723 $ctext insert end "$line\n"
2724 } elseif {$diffinhdr || $x == "\\"} {
2725 # e.g. "\ No newline at end of file"
2726 $ctext insert end "$line\n" filesep
2728 # Something else we don't recognize
2729 if {$curdifftag != "Comments"} {
2730 $ctext insert end "\n"
2731 $ctext tag add $curdifftag $curtagstart end
2732 set curtagstart [$ctext index "end - 1c"]
2733 set curdifftag Comments
2735 $ctext insert end "$line\n" filesep
2738 $ctext conf -state disabled
2739 if {[clock clicks -milliseconds] >= $nextupdate} {
2741 fileevent $bdf readable {}
2743 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2748 global difffilestart ctext
2749 set here [$ctext index @0,0]
2750 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2751 if {[$ctext compare $difffilestart($i) > $here]} {
2752 if {![info exists pos]
2753 || [$ctext compare $difffilestart($i) < $pos]} {
2754 set pos $difffilestart($i)
2758 if {[info exists pos]} {
2763 proc listboxsel {} {
2764 global ctext cflist currentid
2765 if {![info exists currentid]} return
2766 set sel [lsort [$cflist curselection]]
2767 if {$sel eq {}} return
2768 set first [lindex $sel 0]
2769 catch {$ctext yview fmark.$first}
2773 global linespc charspc canvx0 canvy0 mainfont
2774 global xspc1 xspc2 lthickness
2776 set linespc [font metrics $mainfont -linespace]
2777 set charspc [font measure $mainfont "m"]
2778 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2779 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2780 set lthickness [expr {int($linespc / 9) + 1}]
2781 set xspc1(0) $linespc
2789 set ymax [lindex [$canv cget -scrollregion] 3]
2790 if {$ymax eq {} || $ymax == 0} return
2791 set span [$canv yview]
2794 allcanvs yview moveto [lindex $span 0]
2796 if {[info exists selectedline]} {
2797 selectline $selectedline 0
2801 proc incrfont {inc} {
2802 global mainfont namefont textfont ctext canv phase
2803 global stopped entries
2805 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2806 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2807 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2809 $ctext conf -font $textfont
2810 $ctext tag conf filesep -font [concat $textfont bold]
2811 foreach e $entries {
2812 $e conf -font $mainfont
2814 if {$phase == "getcommits"} {
2815 $canv itemconf textitems -font $mainfont
2821 global sha1entry sha1string
2822 if {[string length $sha1string] == 40} {
2823 $sha1entry delete 0 end
2827 proc sha1change {n1 n2 op} {
2828 global sha1string currentid sha1but
2829 if {$sha1string == {}
2830 || ([info exists currentid] && $sha1string == $currentid)} {
2835 if {[$sha1but cget -state] == $state} return
2836 if {$state == "normal"} {
2837 $sha1but conf -state normal -relief raised -text "Goto: "
2839 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2843 proc gotocommit {} {
2844 global sha1string currentid commitrow tagids
2845 global displayorder numcommits
2847 if {$sha1string == {}
2848 || ([info exists currentid] && $sha1string == $currentid)} return
2849 if {[info exists tagids($sha1string)]} {
2850 set id $tagids($sha1string)
2852 set id [string tolower $sha1string]
2853 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2855 foreach i $displayorder {
2856 if {[string match $id* $i]} {
2860 if {$matches ne {}} {
2861 if {[llength $matches] > 1} {
2862 error_popup "Short SHA1 id $id is ambiguous"
2865 set id [lindex $matches 0]
2869 if {[info exists commitrow($id)]} {
2870 selectline $commitrow($id) 1
2873 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2878 error_popup "$type $sha1string is not known"
2881 proc lineenter {x y id} {
2882 global hoverx hovery hoverid hovertimer
2883 global commitinfo canv
2885 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2889 if {[info exists hovertimer]} {
2890 after cancel $hovertimer
2892 set hovertimer [after 500 linehover]
2896 proc linemotion {x y id} {
2897 global hoverx hovery hoverid hovertimer
2899 if {[info exists hoverid] && $id == $hoverid} {
2902 if {[info exists hovertimer]} {
2903 after cancel $hovertimer
2905 set hovertimer [after 500 linehover]
2909 proc lineleave {id} {
2910 global hoverid hovertimer canv
2912 if {[info exists hoverid] && $id == $hoverid} {
2914 if {[info exists hovertimer]} {
2915 after cancel $hovertimer
2923 global hoverx hovery hoverid hovertimer
2924 global canv linespc lthickness
2925 global commitinfo mainfont
2927 set text [lindex $commitinfo($hoverid) 0]
2928 set ymax [lindex [$canv cget -scrollregion] 3]
2929 if {$ymax == {}} return
2930 set yfrac [lindex [$canv yview] 0]
2931 set x [expr {$hoverx + 2 * $linespc}]
2932 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2933 set x0 [expr {$x - 2 * $lthickness}]
2934 set y0 [expr {$y - 2 * $lthickness}]
2935 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2936 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2937 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2938 -fill \#ffff80 -outline black -width 1 -tags hover]
2940 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2944 proc clickisonarrow {id y} {
2945 global lthickness idrowranges
2947 set thresh [expr {2 * $lthickness + 6}]
2948 set n [expr {[llength $idrowranges($id)] - 1}]
2949 for {set i 1} {$i < $n} {incr i} {
2950 set row [lindex $idrowranges($id) $i]
2951 if {abs([yc $row] - $y) < $thresh} {
2958 proc arrowjump {id n y} {
2959 global idrowranges canv
2961 # 1 <-> 2, 3 <-> 4, etc...
2962 set n [expr {(($n - 1) ^ 1) + 1}]
2963 set row [lindex $idrowranges($id) $n]
2965 set ymax [lindex [$canv cget -scrollregion] 3]
2966 if {$ymax eq {} || $ymax <= 0} return
2967 set view [$canv yview]
2968 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2969 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2973 allcanvs yview moveto $yfrac
2976 proc lineclick {x y id isnew} {
2977 global ctext commitinfo children cflist canv thickerline
2979 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2984 # draw this line thicker than normal
2988 set ymax [lindex [$canv cget -scrollregion] 3]
2989 if {$ymax eq {}} return
2990 set yfrac [lindex [$canv yview] 0]
2991 set y [expr {$y + $yfrac * $ymax}]
2993 set dirn [clickisonarrow $id $y]
2995 arrowjump $id $dirn $y
3000 addtohistory [list lineclick $x $y $id 0]
3002 # fill the details pane with info about this line
3003 $ctext conf -state normal
3004 $ctext delete 0.0 end
3005 $ctext tag conf link -foreground blue -underline 1
3006 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3007 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3008 $ctext insert end "Parent:\t"
3009 $ctext insert end $id [list link link0]
3010 $ctext tag bind link0 <1> [list selbyid $id]
3011 set info $commitinfo($id)
3012 $ctext insert end "\n\t[lindex $info 0]\n"
3013 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3014 set date [formatdate [lindex $info 2]]
3015 $ctext insert end "\tDate:\t$date\n"
3016 if {[info exists children($id)]} {
3017 $ctext insert end "\nChildren:"
3019 foreach child $children($id) {
3021 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3022 set info $commitinfo($child)
3023 $ctext insert end "\n\t"
3024 $ctext insert end $child [list link link$i]
3025 $ctext tag bind link$i <1> [list selbyid $child]
3026 $ctext insert end "\n\t[lindex $info 0]"
3027 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3028 set date [formatdate [lindex $info 2]]
3029 $ctext insert end "\n\tDate:\t$date\n"
3032 $ctext conf -state disabled
3034 $cflist delete 0 end
3037 proc normalline {} {
3039 if {[info exists thickerline]} {
3048 if {[info exists commitrow($id)]} {
3049 selectline $commitrow($id) 1
3055 if {![info exists startmstime]} {
3056 set startmstime [clock clicks -milliseconds]
3058 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3061 proc rowmenu {x y id} {
3062 global rowctxmenu commitrow selectedline rowmenuid
3064 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3069 $rowctxmenu entryconfigure 0 -state $state
3070 $rowctxmenu entryconfigure 1 -state $state
3071 $rowctxmenu entryconfigure 2 -state $state
3073 tk_popup $rowctxmenu $x $y
3076 proc diffvssel {dirn} {
3077 global rowmenuid selectedline displayorder
3079 if {![info exists selectedline]} return
3081 set oldid [lindex $displayorder $selectedline]
3082 set newid $rowmenuid
3084 set oldid $rowmenuid
3085 set newid [lindex $displayorder $selectedline]
3087 addtohistory [list doseldiff $oldid $newid]
3088 doseldiff $oldid $newid
3091 proc doseldiff {oldid newid} {
3095 $ctext conf -state normal
3096 $ctext delete 0.0 end
3097 $ctext mark set fmark.0 0.0
3098 $ctext mark gravity fmark.0 left
3099 $cflist delete 0 end
3100 $cflist insert end "Top"
3101 $ctext insert end "From "
3102 $ctext tag conf link -foreground blue -underline 1
3103 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3104 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3105 $ctext tag bind link0 <1> [list selbyid $oldid]
3106 $ctext insert end $oldid [list link link0]
3107 $ctext insert end "\n "
3108 $ctext insert end [lindex $commitinfo($oldid) 0]
3109 $ctext insert end "\n\nTo "
3110 $ctext tag bind link1 <1> [list selbyid $newid]
3111 $ctext insert end $newid [list link link1]
3112 $ctext insert end "\n "
3113 $ctext insert end [lindex $commitinfo($newid) 0]
3114 $ctext insert end "\n"
3115 $ctext conf -state disabled
3116 $ctext tag delete Comments
3117 $ctext tag remove found 1.0 end
3118 startdiff [list $oldid $newid]
3122 global rowmenuid currentid commitinfo patchtop patchnum
3124 if {![info exists currentid]} return
3125 set oldid $currentid
3126 set oldhead [lindex $commitinfo($oldid) 0]
3127 set newid $rowmenuid
3128 set newhead [lindex $commitinfo($newid) 0]
3131 catch {destroy $top}
3133 label $top.title -text "Generate patch"
3134 grid $top.title - -pady 10
3135 label $top.from -text "From:"
3136 entry $top.fromsha1 -width 40 -relief flat
3137 $top.fromsha1 insert 0 $oldid
3138 $top.fromsha1 conf -state readonly
3139 grid $top.from $top.fromsha1 -sticky w
3140 entry $top.fromhead -width 60 -relief flat
3141 $top.fromhead insert 0 $oldhead
3142 $top.fromhead conf -state readonly
3143 grid x $top.fromhead -sticky w
3144 label $top.to -text "To:"
3145 entry $top.tosha1 -width 40 -relief flat
3146 $top.tosha1 insert 0 $newid
3147 $top.tosha1 conf -state readonly
3148 grid $top.to $top.tosha1 -sticky w
3149 entry $top.tohead -width 60 -relief flat
3150 $top.tohead insert 0 $newhead
3151 $top.tohead conf -state readonly
3152 grid x $top.tohead -sticky w
3153 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3154 grid $top.rev x -pady 10
3155 label $top.flab -text "Output file:"
3156 entry $top.fname -width 60
3157 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3159 grid $top.flab $top.fname -sticky w
3161 button $top.buts.gen -text "Generate" -command mkpatchgo
3162 button $top.buts.can -text "Cancel" -command mkpatchcan
3163 grid $top.buts.gen $top.buts.can
3164 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3165 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3166 grid $top.buts - -pady 10 -sticky ew
3170 proc mkpatchrev {} {
3173 set oldid [$patchtop.fromsha1 get]
3174 set oldhead [$patchtop.fromhead get]
3175 set newid [$patchtop.tosha1 get]
3176 set newhead [$patchtop.tohead get]
3177 foreach e [list fromsha1 fromhead tosha1 tohead] \
3178 v [list $newid $newhead $oldid $oldhead] {
3179 $patchtop.$e conf -state normal
3180 $patchtop.$e delete 0 end
3181 $patchtop.$e insert 0 $v
3182 $patchtop.$e conf -state readonly
3189 set oldid [$patchtop.fromsha1 get]
3190 set newid [$patchtop.tosha1 get]
3191 set fname [$patchtop.fname get]
3192 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3193 error_popup "Error creating patch: $err"
3195 catch {destroy $patchtop}
3199 proc mkpatchcan {} {
3202 catch {destroy $patchtop}
3207 global rowmenuid mktagtop commitinfo
3211 catch {destroy $top}
3213 label $top.title -text "Create tag"
3214 grid $top.title - -pady 10
3215 label $top.id -text "ID:"
3216 entry $top.sha1 -width 40 -relief flat
3217 $top.sha1 insert 0 $rowmenuid
3218 $top.sha1 conf -state readonly
3219 grid $top.id $top.sha1 -sticky w
3220 entry $top.head -width 60 -relief flat
3221 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3222 $top.head conf -state readonly
3223 grid x $top.head -sticky w
3224 label $top.tlab -text "Tag name:"
3225 entry $top.tag -width 60
3226 grid $top.tlab $top.tag -sticky w
3228 button $top.buts.gen -text "Create" -command mktaggo
3229 button $top.buts.can -text "Cancel" -command mktagcan
3230 grid $top.buts.gen $top.buts.can
3231 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3232 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3233 grid $top.buts - -pady 10 -sticky ew
3238 global mktagtop env tagids idtags
3240 set id [$mktagtop.sha1 get]
3241 set tag [$mktagtop.tag get]
3243 error_popup "No tag name specified"
3246 if {[info exists tagids($tag)]} {
3247 error_popup "Tag \"$tag\" already exists"
3252 set fname [file join $dir "refs/tags" $tag]
3253 set f [open $fname w]
3257 error_popup "Error creating tag: $err"
3261 set tagids($tag) $id
3262 lappend idtags($id) $tag
3266 proc redrawtags {id} {
3267 global canv linehtag commitrow idpos selectedline
3269 if {![info exists commitrow($id)]} return
3270 drawcmitrow $commitrow($id)
3271 $canv delete tag.$id
3272 set xt [eval drawtags $id $idpos($id)]
3273 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3274 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3275 selectline $selectedline 0
3282 catch {destroy $mktagtop}
3291 proc writecommit {} {
3292 global rowmenuid wrcomtop commitinfo wrcomcmd
3294 set top .writecommit
3296 catch {destroy $top}
3298 label $top.title -text "Write commit to file"
3299 grid $top.title - -pady 10
3300 label $top.id -text "ID:"
3301 entry $top.sha1 -width 40 -relief flat
3302 $top.sha1 insert 0 $rowmenuid
3303 $top.sha1 conf -state readonly
3304 grid $top.id $top.sha1 -sticky w
3305 entry $top.head -width 60 -relief flat
3306 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3307 $top.head conf -state readonly
3308 grid x $top.head -sticky w
3309 label $top.clab -text "Command:"
3310 entry $top.cmd -width 60 -textvariable wrcomcmd
3311 grid $top.clab $top.cmd -sticky w -pady 10
3312 label $top.flab -text "Output file:"
3313 entry $top.fname -width 60
3314 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3315 grid $top.flab $top.fname -sticky w
3317 button $top.buts.gen -text "Write" -command wrcomgo
3318 button $top.buts.can -text "Cancel" -command wrcomcan
3319 grid $top.buts.gen $top.buts.can
3320 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3321 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3322 grid $top.buts - -pady 10 -sticky ew
3329 set id [$wrcomtop.sha1 get]
3330 set cmd "echo $id | [$wrcomtop.cmd get]"
3331 set fname [$wrcomtop.fname get]
3332 if {[catch {exec sh -c $cmd >$fname &} err]} {
3333 error_popup "Error writing commit: $err"
3335 catch {destroy $wrcomtop}
3342 catch {destroy $wrcomtop}
3346 proc listrefs {id} {
3347 global idtags idheads idotherrefs
3350 if {[info exists idtags($id)]} {
3354 if {[info exists idheads($id)]} {
3358 if {[info exists idotherrefs($id)]} {
3359 set z $idotherrefs($id)
3361 return [list $x $y $z]
3364 proc rereadrefs {} {
3365 global idtags idheads idotherrefs
3366 global tagids headids otherrefids
3368 set refids [concat [array names idtags] \
3369 [array names idheads] [array names idotherrefs]]
3370 foreach id $refids {
3371 if {![info exists ref($id)]} {
3372 set ref($id) [listrefs $id]
3376 set refids [lsort -unique [concat $refids [array names idtags] \
3377 [array names idheads] [array names idotherrefs]]]
3378 foreach id $refids {
3379 set v [listrefs $id]
3380 if {![info exists ref($id)] || $ref($id) != $v} {
3386 proc showtag {tag isnew} {
3387 global ctext cflist tagcontents tagids linknum
3390 addtohistory [list showtag $tag 0]
3392 $ctext conf -state normal
3393 $ctext delete 0.0 end
3395 if {[info exists tagcontents($tag)]} {
3396 set text $tagcontents($tag)
3398 set text "Tag: $tag\nId: $tagids($tag)"
3400 appendwithlinks $text
3401 $ctext conf -state disabled
3402 $cflist delete 0 end
3412 global maxwidth maxgraphpct diffopts findmergefiles
3413 global oldprefs prefstop
3417 if {[winfo exists $top]} {
3421 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3422 set oldprefs($v) [set $v]
3425 wm title $top "Gitk preferences"
3426 label $top.ldisp -text "Commit list display options"
3427 grid $top.ldisp - -sticky w -pady 10
3428 label $top.spacer -text " "
3429 label $top.maxwidthl -text "Maximum graph width (lines)" \
3431 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3432 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3433 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3435 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3436 grid x $top.maxpctl $top.maxpct -sticky w
3437 checkbutton $top.findm -variable findmergefiles
3438 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3440 grid $top.findm $top.findml - -sticky w
3441 label $top.ddisp -text "Diff display options"
3442 grid $top.ddisp - -sticky w -pady 10
3443 label $top.diffoptl -text "Options for diff program" \
3445 entry $top.diffopt -width 20 -textvariable diffopts
3446 grid x $top.diffoptl $top.diffopt -sticky w
3448 button $top.buts.ok -text "OK" -command prefsok
3449 button $top.buts.can -text "Cancel" -command prefscan
3450 grid $top.buts.ok $top.buts.can
3451 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3452 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3453 grid $top.buts - - -pady 10 -sticky ew
3457 global maxwidth maxgraphpct diffopts findmergefiles
3458 global oldprefs prefstop
3460 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3461 set $v $oldprefs($v)
3463 catch {destroy $prefstop}
3468 global maxwidth maxgraphpct
3469 global oldprefs prefstop
3471 catch {destroy $prefstop}
3473 if {$maxwidth != $oldprefs(maxwidth)
3474 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3479 proc formatdate {d} {
3480 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3483 # This list of encoding names and aliases is distilled from
3484 # http://www.iana.org/assignments/character-sets.
3485 # Not all of them are supported by Tcl.
3486 set encoding_aliases {
3487 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3488 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3489 { ISO-10646-UTF-1 csISO10646UTF1 }
3490 { ISO_646.basic:1983 ref csISO646basic1983 }
3491 { INVARIANT csINVARIANT }
3492 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3493 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3494 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3495 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3496 { NATS-DANO iso-ir-9-1 csNATSDANO }
3497 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3498 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3499 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3500 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3501 { ISO-2022-KR csISO2022KR }
3503 { ISO-2022-JP csISO2022JP }
3504 { ISO-2022-JP-2 csISO2022JP2 }
3505 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3507 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3508 { IT iso-ir-15 ISO646-IT csISO15Italian }
3509 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3510 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3511 { greek7-old iso-ir-18 csISO18Greek7Old }
3512 { latin-greek iso-ir-19 csISO19LatinGreek }
3513 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3514 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3515 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3516 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3517 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3518 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3519 { INIS iso-ir-49 csISO49INIS }
3520 { INIS-8 iso-ir-50 csISO50INIS8 }
3521 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3522 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3523 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3524 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3525 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3526 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3528 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3529 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3530 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3531 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3532 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3533 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3534 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3535 { greek7 iso-ir-88 csISO88Greek7 }
3536 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3537 { iso-ir-90 csISO90 }
3538 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3539 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3540 csISO92JISC62991984b }
3541 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3542 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3543 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3544 csISO95JIS62291984handadd }
3545 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3546 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3547 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3548 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3550 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3551 { T.61-7bit iso-ir-102 csISO102T617bit }
3552 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3553 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3554 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3555 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3556 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3557 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3558 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3559 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3560 arabic csISOLatinArabic }
3561 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3562 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3563 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3564 greek greek8 csISOLatinGreek }
3565 { T.101-G2 iso-ir-128 csISO128T101G2 }
3566 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3568 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3569 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3570 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3571 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3572 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3573 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3574 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3575 csISOLatinCyrillic }
3576 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3577 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3578 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3579 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3580 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3581 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3582 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3583 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3584 { ISO_10367-box iso-ir-155 csISO10367Box }
3585 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3586 { latin-lap lap iso-ir-158 csISO158Lap }
3587 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3588 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3591 { JIS_X0201 X0201 csHalfWidthKatakana }
3592 { KSC5636 ISO646-KR csKSC5636 }
3593 { ISO-10646-UCS-2 csUnicode }
3594 { ISO-10646-UCS-4 csUCS4 }
3595 { DEC-MCS dec csDECMCS }
3596 { hp-roman8 roman8 r8 csHPRoman8 }
3597 { macintosh mac csMacintosh }
3598 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3600 { IBM038 EBCDIC-INT cp038 csIBM038 }
3601 { IBM273 CP273 csIBM273 }
3602 { IBM274 EBCDIC-BE CP274 csIBM274 }
3603 { IBM275 EBCDIC-BR cp275 csIBM275 }
3604 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3605 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3606 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3607 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3608 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3609 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3610 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3611 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3612 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3613 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3614 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3615 { IBM437 cp437 437 csPC8CodePage437 }
3616 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3617 { IBM775 cp775 csPC775Baltic }
3618 { IBM850 cp850 850 csPC850Multilingual }
3619 { IBM851 cp851 851 csIBM851 }
3620 { IBM852 cp852 852 csPCp852 }
3621 { IBM855 cp855 855 csIBM855 }
3622 { IBM857 cp857 857 csIBM857 }
3623 { IBM860 cp860 860 csIBM860 }
3624 { IBM861 cp861 861 cp-is csIBM861 }
3625 { IBM862 cp862 862 csPC862LatinHebrew }
3626 { IBM863 cp863 863 csIBM863 }
3627 { IBM864 cp864 csIBM864 }
3628 { IBM865 cp865 865 csIBM865 }
3629 { IBM866 cp866 866 csIBM866 }
3630 { IBM868 CP868 cp-ar csIBM868 }
3631 { IBM869 cp869 869 cp-gr csIBM869 }
3632 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3633 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3634 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3635 { IBM891 cp891 csIBM891 }
3636 { IBM903 cp903 csIBM903 }
3637 { IBM904 cp904 904 csIBBM904 }
3638 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3639 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3640 { IBM1026 CP1026 csIBM1026 }
3641 { EBCDIC-AT-DE csIBMEBCDICATDE }
3642 { EBCDIC-AT-DE-A csEBCDICATDEA }
3643 { EBCDIC-CA-FR csEBCDICCAFR }
3644 { EBCDIC-DK-NO csEBCDICDKNO }
3645 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3646 { EBCDIC-FI-SE csEBCDICFISE }
3647 { EBCDIC-FI-SE-A csEBCDICFISEA }
3648 { EBCDIC-FR csEBCDICFR }
3649 { EBCDIC-IT csEBCDICIT }
3650 { EBCDIC-PT csEBCDICPT }
3651 { EBCDIC-ES csEBCDICES }
3652 { EBCDIC-ES-A csEBCDICESA }
3653 { EBCDIC-ES-S csEBCDICESS }
3654 { EBCDIC-UK csEBCDICUK }
3655 { EBCDIC-US csEBCDICUS }
3656 { UNKNOWN-8BIT csUnknown8BiT }
3657 { MNEMONIC csMnemonic }
3662 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3663 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3664 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3665 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3666 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3667 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3668 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3669 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3670 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3671 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3672 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3673 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3674 { IBM1047 IBM-1047 }
3675 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3676 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3677 { UNICODE-1-1 csUnicode11 }
3680 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3681 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3683 { ISO-8859-15 ISO_8859-15 Latin-9 }
3684 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3685 { GBK CP936 MS936 windows-936 }
3686 { JIS_Encoding csJISEncoding }
3687 { Shift_JIS MS_Kanji csShiftJIS }
3688 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3690 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3691 { ISO-10646-UCS-Basic csUnicodeASCII }
3692 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3693 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3694 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3695 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3696 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3697 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3698 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3699 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3700 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3701 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3702 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3703 { Ventura-US csVenturaUS }
3704 { Ventura-International csVenturaInternational }
3705 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3706 { PC8-Turkish csPC8Turkish }
3707 { IBM-Symbols csIBMSymbols }
3708 { IBM-Thai csIBMThai }
3709 { HP-Legal csHPLegal }
3710 { HP-Pi-font csHPPiFont }
3711 { HP-Math8 csHPMath8 }
3712 { Adobe-Symbol-Encoding csHPPSMath }
3713 { HP-DeskTop csHPDesktop }
3714 { Ventura-Math csVenturaMath }
3715 { Microsoft-Publishing csMicrosoftPublishing }
3716 { Windows-31J csWindows31J }
3721 proc tcl_encoding {enc} {
3722 global encoding_aliases
3723 set names [encoding names]
3724 set lcnames [string tolower $names]
3725 set enc [string tolower $enc]
3726 set i [lsearch -exact $lcnames $enc]
3728 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3729 if {[regsub {^iso[-_]} $enc iso encx]} {
3730 set i [lsearch -exact $lcnames $encx]
3734 foreach l $encoding_aliases {
3735 set ll [string tolower $l]
3736 if {[lsearch -exact $ll $enc] < 0} continue
3737 # look through the aliases for one that tcl knows about
3739 set i [lsearch -exact $lcnames $e]
3741 if {[regsub {^iso[-_]} $e iso ex]} {
3742 set i [lsearch -exact $lcnames $ex]
3751 return [lindex $names $i]
3758 set diffopts "-U 5 -p"
3759 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3763 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3765 if {$gitencoding == ""} {
3766 set gitencoding "utf-8"
3768 set tclencoding [tcl_encoding $gitencoding]
3769 if {$tclencoding == {}} {
3770 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3773 set mainfont {Helvetica 9}
3774 set textfont {Courier 9}
3775 set findmergefiles 0
3784 set colors {green red blue magenta darkgrey brown orange}
3786 catch {source ~/.gitk}
3788 set namefont $mainfont
3790 font create optionfont -family sans-serif -size -12
3794 switch -regexp -- $arg {
3796 "^-d" { set datemode 1 }
3798 lappend revtreeargs $arg
3803 # check that we can find a .git directory somewhere...
3805 if {![file isdirectory $gitdir]} {
3806 error_popup "Cannot find the git directory \"$gitdir\"."
3819 makewindow $revtreeargs
3821 getcommits $revtreeargs