2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc parse_args
{rargs
} {
23 set parse_args
[concat
--default HEAD
$rargs]
24 set parsed_args
[split [eval exec git-rev-parse
$parse_args] "\n"]
26 # if git-rev-parse failed for some reason...
30 set parsed_args
$rargs
35 proc start_rev_list
{rlargs
} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
39 set startmsecs
[clock clicks
-milliseconds]
40 set nextupdate
[expr {$startmsecs + 100}]
43 set order
"--topo-order"
45 set order
"--date-order"
48 set commfd
[open
[concat | git-rev-list
--header $order \
51 puts stderr
"Error executing git-rev-list: $err"
55 fconfigure
$commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure
$commfd -encoding $tclencoding
59 fileevent
$commfd readable
[list getcommitlines
$commfd]
60 . config
-cursor watch
64 proc getcommits
{rargs
} {
65 global phase canv mainfont
68 start_rev_list
[parse_args
$rargs]
70 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
71 -font $mainfont -tags textitems
74 proc getcommitlines
{commfd
} {
75 global 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]
118 set ids
[string range
$cmit 0 [expr {$j - 1}]]
121 if {[string length
$id] != 40} {
129 if {[string length
$shortcmit] > 80} {
130 set shortcmit
"[string range $shortcmit 0 80]..."
132 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
135 set id
[lindex
$ids 0]
136 set olds
[lrange
$ids 1 end
]
137 set commitlisted
($id) 1
138 updatechildren
$id $olds
139 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
140 set commitrow
($id) $commitidx
142 lappend displayorder
$id
148 if {[clock clicks
-milliseconds] >= $nextupdate} {
153 proc doupdate
{reading
} {
154 global commfd nextupdate numcommits ncmupdate
157 fileevent
$commfd readable
{}
160 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
161 if {$numcommits < 100} {
162 set ncmupdate
[expr {$numcommits + 1}]
163 } elseif
{$numcommits < 10000} {
164 set ncmupdate
[expr {$numcommits + 10}]
166 set ncmupdate
[expr {$numcommits + 100}]
169 fileevent
$commfd readable
[list getcommitlines
$commfd]
173 proc readcommit
{id
} {
174 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
175 updatechildren
$id {}
176 parsecommit
$id $contents 0
179 proc updatecommits
{rargs
} {
181 foreach v
{children nchildren parents nparents commitlisted
182 colormap selectedline matchinglines treediffs
183 mergefilelist currentid rowtextx commitrow
184 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
185 linesegends crossings cornercrossings
} {
194 proc updatechildren
{id olds
} {
195 global children nchildren parents nparents
197 if {![info exists nchildren
($id)]} {
201 set parents
($id) $olds
202 set nparents
($id) [llength
$olds]
204 if {![info exists nchildren
($p)]} {
205 set children
($p) [list
$id]
207 } elseif
{[lsearch
-exact $children($p) $id] < 0} {
208 lappend children
($p) $id
214 proc parsecommit
{id contents listed
} {
215 global commitinfo cdate
224 set hdrend
[string first
"\n\n" $contents]
226 # should never happen...
227 set hdrend
[string length
$contents]
229 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
230 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
231 foreach line
[split $header "\n"] {
232 set tag
[lindex
$line 0]
233 if {$tag == "author"} {
234 set audate
[lindex
$line end-1
]
235 set auname
[lrange
$line 1 end-2
]
236 } elseif
{$tag == "committer"} {
237 set comdate
[lindex
$line end-1
]
238 set comname
[lrange
$line 1 end-2
]
242 # take the first line of the comment as the headline
243 set i
[string first
"\n" $comment]
245 set headline
[string trim
[string range
$comment 0 $i]]
247 set headline
$comment
250 # git-rev-list indents the comment by 4 spaces;
251 # if we got this via git-cat-file, add the indentation
253 foreach line
[split $comment "\n"] {
254 append newcomment
" "
255 append newcomment
$line
256 append newcomment
"\n"
258 set comment
$newcomment
260 if {$comdate != {}} {
261 set cdate
($id) $comdate
263 set commitinfo
($id) [list
$headline $auname $audate \
264 $comname $comdate $comment]
267 proc getcommit
{id
} {
268 global commitdata commitinfo nparents
270 if {[info exists commitdata
($id)]} {
271 parsecommit
$id $commitdata($id) 1
274 if {![info exists commitinfo
($id)]} {
275 set commitinfo
($id) {"No commit information available"}
283 global tagids idtags headids idheads tagcontents
284 global otherrefids idotherrefs
286 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
289 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
290 while {0 <= [set n
[gets
$refd line
]]} {
291 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
295 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
299 if {$type == "tags"} {
300 set tagids
($name) $id
301 lappend idtags
($id) $name
306 set commit
[exec git-rev-parse
"$id^0"]
307 if {"$commit" != "$id"} {
308 set tagids
($name) $commit
309 lappend idtags
($commit) $name
313 set tagcontents
($name) [exec git-cat-file tag
"$id"]
315 } elseif
{ $type == "heads" } {
316 set headids
($name) $id
317 lappend idheads
($id) $name
319 set otherrefids
($name) $id
320 lappend idotherrefs
($id) $name
326 proc error_popup msg
{
330 message
$w.m
-text $msg -justify center
-aspect 400
331 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
332 button
$w.ok
-text OK
-command "destroy $w"
333 pack
$w.ok
-side bottom
-fill x
334 bind $w <Visibility
> "grab $w; focus $w"
335 bind $w <Key-Return
> "destroy $w"
339 proc makewindow
{rargs
} {
340 global canv canv2 canv3 linespc charspc ctext cflist textfont
341 global findtype findtypemenu findloc findstring fstring geometry
342 global entries sha1entry sha1string sha1but
343 global maincursor textcursor curtextcursor
344 global rowctxmenu mergemax
347 .bar add cascade
-label "File" -menu .bar.
file
349 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
350 .bar.
file add
command -label "Reread references" -command rereadrefs
351 .bar.
file add
command -label "Quit" -command doquit
353 .bar add cascade
-label "Edit" -menu .bar.edit
354 .bar.edit add
command -label "Preferences" -command doprefs
356 .bar add cascade
-label "Help" -menu .bar.
help
357 .bar.
help add
command -label "About gitk" -command about
358 . configure
-menu .bar
360 if {![info exists geometry
(canv1
)]} {
361 set geometry
(canv1
) [expr {45 * $charspc}]
362 set geometry
(canv2
) [expr {30 * $charspc}]
363 set geometry
(canv3
) [expr {15 * $charspc}]
364 set geometry
(canvh
) [expr {25 * $linespc + 4}]
365 set geometry
(ctextw
) 80
366 set geometry
(ctexth
) 30
367 set geometry
(cflistw
) 30
369 panedwindow .ctop
-orient vertical
370 if {[info exists geometry
(width
)]} {
371 .ctop conf
-width $geometry(width
) -height $geometry(height
)
372 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
373 set geometry
(ctexth
) [expr {($texth - 8) /
374 [font metrics
$textfont -linespace]}]
378 pack .ctop.top.bar
-side bottom
-fill x
379 set cscroll .ctop.top.csb
380 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
381 pack
$cscroll -side right
-fill y
382 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
383 pack .ctop.top.clist
-side top
-fill both
-expand 1
385 set canv .ctop.top.clist.canv
386 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
388 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
389 .ctop.top.clist add
$canv
390 set canv2 .ctop.top.clist.canv2
391 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
392 -bg white
-bd 0 -yscrollincr $linespc
393 .ctop.top.clist add
$canv2
394 set canv3 .ctop.top.clist.canv3
395 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
396 -bg white
-bd 0 -yscrollincr $linespc
397 .ctop.top.clist add
$canv3
398 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
400 set sha1entry .ctop.top.bar.sha1
401 set entries
$sha1entry
402 set sha1but .ctop.top.bar.sha1label
403 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
404 -command gotocommit
-width 8
405 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
406 pack .ctop.top.bar.sha1label
-side left
407 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
408 trace add variable sha1string
write sha1change
409 pack
$sha1entry -side left
-pady 2
411 image create bitmap bm-left
-data {
412 #define left_width 16
413 #define left_height 16
414 static unsigned char left_bits
[] = {
415 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
416 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
417 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
419 image create bitmap bm-right
-data {
420 #define right_width 16
421 #define right_height 16
422 static unsigned char right_bits
[] = {
423 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
424 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
425 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
427 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
428 -state disabled
-width 26
429 pack .ctop.top.bar.leftbut
-side left
-fill y
430 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
431 -state disabled
-width 26
432 pack .ctop.top.bar.rightbut
-side left
-fill y
434 button .ctop.top.bar.findbut
-text "Find" -command dofind
435 pack .ctop.top.bar.findbut
-side left
437 set fstring .ctop.top.bar.findstring
438 lappend entries
$fstring
439 entry
$fstring -width 30 -font $textfont -textvariable findstring
440 pack
$fstring -side left
-expand 1 -fill x
442 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
443 findtype Exact IgnCase Regexp
]
444 set findloc
"All fields"
445 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
446 Comments Author Committer Files Pickaxe
447 pack .ctop.top.bar.findloc
-side right
448 pack .ctop.top.bar.findtype
-side right
449 # for making sure type==Exact whenever loc==Pickaxe
450 trace add variable findloc
write findlocchange
452 panedwindow .ctop.cdet
-orient horizontal
454 frame .ctop.cdet.left
455 set ctext .ctop.cdet.left.ctext
456 text
$ctext -bg white
-state disabled
-font $textfont \
457 -width $geometry(ctextw
) -height $geometry(ctexth
) \
458 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
459 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
460 pack .ctop.cdet.left.sb
-side right
-fill y
461 pack
$ctext -side left
-fill both
-expand 1
462 .ctop.cdet add .ctop.cdet.left
464 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
465 $ctext tag conf hunksep
-fore blue
466 $ctext tag conf d0
-fore red
467 $ctext tag conf d1
-fore "#00a000"
468 $ctext tag conf m0
-fore red
469 $ctext tag conf m1
-fore blue
470 $ctext tag conf m2
-fore green
471 $ctext tag conf m3
-fore purple
472 $ctext tag conf
m4 -fore brown
473 $ctext tag conf m5
-fore "#009090"
474 $ctext tag conf m6
-fore magenta
475 $ctext tag conf m7
-fore "#808000"
476 $ctext tag conf m8
-fore "#009000"
477 $ctext tag conf m9
-fore "#ff0080"
478 $ctext tag conf m10
-fore cyan
479 $ctext tag conf m11
-fore "#b07070"
480 $ctext tag conf m12
-fore "#70b0f0"
481 $ctext tag conf m13
-fore "#70f0b0"
482 $ctext tag conf m14
-fore "#f0b070"
483 $ctext tag conf m15
-fore "#ff70b0"
484 $ctext tag conf mmax
-fore darkgrey
486 $ctext tag conf mresult
-font [concat
$textfont bold
]
487 $ctext tag conf msep
-font [concat
$textfont bold
]
488 $ctext tag conf found
-back yellow
490 frame .ctop.cdet.right
491 set cflist .ctop.cdet.right.cfiles
492 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
493 -yscrollcommand ".ctop.cdet.right.sb set"
494 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
495 pack .ctop.cdet.right.sb
-side right
-fill y
496 pack
$cflist -side left
-fill both
-expand 1
497 .ctop.cdet add .ctop.cdet.right
498 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
500 pack .ctop
-side top
-fill both
-expand 1
502 bindall
<1> {selcanvline
%W
%x
%y
}
503 #bindall <B1-Motion> {selcanvline %W %x %y}
504 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
505 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
506 bindall
<2> "allcanvs scan mark 0 %y"
507 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
508 bind .
<Key-Up
> "selnextline -1"
509 bind .
<Key-Down
> "selnextline 1"
510 bind .
<Key-Right
> "goforw"
511 bind .
<Key-Left
> "goback"
512 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
513 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
514 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
515 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
516 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
517 bindkey p
"selnextline -1"
518 bindkey n
"selnextline 1"
521 bindkey i
"selnextline -1"
522 bindkey k
"selnextline 1"
525 bindkey b
"$ctext yview scroll -1 pages"
526 bindkey d
"$ctext yview scroll 18 units"
527 bindkey u
"$ctext yview scroll -18 units"
528 bindkey
/ {findnext
1}
529 bindkey
<Key-Return
> {findnext
0}
532 bind .
<Control-q
> doquit
533 bind .
<Control-f
> dofind
534 bind .
<Control-g
> {findnext
0}
535 bind .
<Control-r
> findprev
536 bind .
<Control-equal
> {incrfont
1}
537 bind .
<Control-KP_Add
> {incrfont
1}
538 bind .
<Control-minus
> {incrfont
-1}
539 bind .
<Control-KP_Subtract
> {incrfont
-1}
540 bind $cflist <<ListboxSelect>> listboxsel
541 bind . <Destroy> {savestuff %W}
542 bind . <Button-1> "click %W"
543 bind $fstring <Key-Return> dofind
544 bind $sha1entry <Key-Return> gotocommit
545 bind $sha1entry <<PasteSelection>> clearsha1
547 set maincursor [. cget -cursor]
548 set textcursor [$ctext cget -cursor]
549 set curtextcursor $textcursor
551 set rowctxmenu .rowctxmenu
552 menu $rowctxmenu -tearoff 0
553 $rowctxmenu add command -label "Diff this -> selected" \
554 -command {diffvssel 0}
555 $rowctxmenu add command -label "Diff selected -> this" \
556 -command {diffvssel 1}
557 $rowctxmenu add command -label "Make patch" -command mkpatch
558 $rowctxmenu add command -label "Create tag" -command mktag
559 $rowctxmenu add command -label "Write commit to file" -command writecommit
562 proc scrollcanv {cscroll f0 f1} {
567 # when we make a key binding for the toplevel, make sure
568 # it doesn't get triggered when that key is pressed in the
569 # find string entry widget.
570 proc bindkey {ev script} {
573 set escript [bind Entry $ev]
574 if {$escript == {}} {
575 set escript [bind Entry <Key>]
578 bind $e $ev "$escript; break"
582 # set the focus back to the toplevel for any click outside
593 global canv canv2 canv3 ctext cflist mainfont textfont
594 global stuffsaved findmergefiles maxgraphpct
597 if {$stuffsaved} return
598 if {![winfo viewable .]} return
600 set f [open "~/.gitk-new" w]
601 puts $f [list set mainfont $mainfont]
602 puts $f [list set textfont $textfont]
603 puts $f [list set findmergefiles $findmergefiles]
604 puts $f [list set maxgraphpct $maxgraphpct]
605 puts $f [list set maxwidth $maxwidth]
606 puts $f "set geometry(width) [winfo width .ctop]"
607 puts $f "set geometry(height) [winfo height .ctop]"
608 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
609 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
610 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
611 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
612 set wid [expr {([winfo width $ctext] - 8) \
613 / [font measure $textfont "0"]}]
614 puts $f "set geometry(ctextw) $wid"
615 set wid [expr {([winfo width $cflist] - 11) \
616 / [font measure [$cflist cget -font] "0"]}]
617 puts $f "set geometry(cflistw) $wid"
619 file rename -force "~/.gitk-new" "~/.gitk"
624 proc resizeclistpanes {win w} {
626 if {[info exists oldwidth($win)]} {
627 set s0 [$win sash coord 0]
628 set s1 [$win sash coord 1]
630 set sash0 [expr {int($w/2 - 2)}]
631 set sash1 [expr {int($w*5/6 - 2)}]
633 set factor [expr {1.0 * $w / $oldwidth($win)}]
634 set sash0 [expr {int($factor * [lindex $s0 0])}]
635 set sash1 [expr {int($factor * [lindex $s1 0])}]
639 if {$sash1 < $sash0 + 20} {
640 set sash1 [expr {$sash0 + 20}]
642 if {$sash1 > $w - 10} {
643 set sash1 [expr {$w - 10}]
644 if {$sash0 > $sash1 - 20} {
645 set sash0 [expr {$sash1 - 20}]
649 $win sash place 0 $sash0 [lindex $s0 1]
650 $win sash place 1 $sash1 [lindex $s1 1]
652 set oldwidth($win) $w
655 proc resizecdetpanes {win w} {
657 if {[info exists oldwidth($win)]} {
658 set s0 [$win sash coord 0]
660 set sash0 [expr {int($w*3/4 - 2)}]
662 set factor [expr {1.0 * $w / $oldwidth($win)}]
663 set sash0 [expr {int($factor * [lindex $s0 0])}]
667 if {$sash0 > $w - 15} {
668 set sash0 [expr {$w - 15}]
671 $win sash place 0 $sash0 [lindex $s0 1]
673 set oldwidth($win) $w
677 global canv canv2 canv3
683 proc bindall {event action} {
684 global canv canv2 canv3
685 bind $canv $event $action
686 bind $canv2 $event $action
687 bind $canv3 $event $action
692 if {[winfo exists $w]} {
697 wm title $w "About gitk"
699 Gitk - a commit viewer for git
701 Copyright © 2005-2006 Paul Mackerras
703 Use and redistribute under the terms of the GNU General Public License} \
704 -justify center -aspect 400
705 pack $w.m -side top -fill x -padx 20 -pady 20
706 button $w.ok -text Close -command "destroy $w"
707 pack $w.ok -side bottom
710 proc shortids {ids} {
713 if {[llength $id] > 1} {
714 lappend res [shortids $id]
715 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
716 lappend res [string range $id 0 7]
724 proc incrange {l x o} {
729 lset l $x [expr {$e + $o}]
738 for {} {$n > 0} {incr n -1} {
744 proc usedinrange {id l1 l2} {
745 global children commitrow
747 if {[info exists commitrow($id)]} {
748 set r $commitrow($id)
749 if {$l1 <= $r && $r <= $l2} {
750 return [expr {$r - $l1 + 1}]
753 foreach c $children($id) {
754 if {[info exists commitrow($c)]} {
756 if {$l1 <= $r && $r <= $l2} {
757 return [expr {$r - $l1 + 1}]
764 proc sanity {row {full 0}} {
765 global rowidlist rowoffsets
768 set ids [lindex $rowidlist $row]
771 if {$id eq {}} continue
772 if {$col < [llength $ids] - 1 &&
773 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
774 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
776 set o [lindex $rowoffsets $row $col]
782 if {[lindex $rowidlist $y $x] != $id} {
783 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
784 puts " id=[shortids $id] check started at row $row"
785 for {set i $row} {$i >= $y} {incr i -1} {
786 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
791 set o [lindex $rowoffsets $y $x]
796 proc makeuparrow {oid x y z} {
797 global rowidlist rowoffsets uparrowlen idrowranges
799 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
802 set off0 [lindex $rowoffsets $y]
803 for {set x0 $x} {1} {incr x0} {
804 if {$x0 >= [llength $off0]} {
805 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
808 set z [lindex $off0 $x0]
814 set z [expr {$x0 - $x}]
815 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
816 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
818 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
819 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
820 lappend idrowranges($oid) $y
824 global rowidlist rowoffsets displayorder
825 global rowlaidout rowoptim
826 global idinlist rowchk
827 global commitidx numcommits
836 catch {unset idinlist}
842 proc visiblerows {} {
843 global canv numcommits linespc
845 set ymax [lindex [$canv cget -scrollregion] 3]
846 if {$ymax eq {} || $ymax == 0} return
848 set y0 [expr {int([lindex $f 0] * $ymax)}]
849 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
853 set y1 [expr {int([lindex $f 1] * $ymax)}]
854 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
855 if {$r1 >= $numcommits} {
856 set r1 [expr {$numcommits - 1}]
858 return [list $r0 $r1]
862 global rowlaidout rowoptim commitidx numcommits optim_delay
866 set rowlaidout [layoutrows $row $commitidx 0]
867 set orow [expr {$rowlaidout - $uparrowlen - 1}]
868 if {$orow > $rowoptim} {
869 checkcrossings $rowoptim $orow
870 optimize_rows $rowoptim 0 $orow
873 set canshow [expr {$rowoptim - $optim_delay}]
874 if {$canshow > $numcommits} {
879 proc showstuff {canshow} {
881 global canvy0 linespc
882 global linesegends idrowranges idrangedrawn
884 if {$numcommits == 0} {
890 set numcommits $canshow
891 allcanvs conf -scrollregion \
892 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
893 set rows [visiblerows]
894 set r0 [lindex $rows 0]
895 set r1 [lindex $rows 1]
896 for {set r $row} {$r < $canshow} {incr r} {
897 if {[info exists linesegends($r)]} {
898 foreach id $linesegends($r) {
900 foreach {s e} $idrowranges($id) {
902 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
903 && ![info exists idrangedrawn($id,$i)]} {
905 set idrangedrawn($id,$i) 1
911 if {$canshow > $r1} {
914 while {$row < $canshow} {
920 proc layoutrows {row endrow last} {
921 global rowidlist rowoffsets displayorder
922 global uparrowlen downarrowlen maxwidth mingaplen
923 global nchildren parents nparents
924 global idrowranges linesegends
926 global idinlist rowchk
928 set idlist [lindex $rowidlist $row]
929 set offs [lindex $rowoffsets $row]
930 while {$row < $endrow} {
931 set id [lindex $displayorder $row]
934 foreach p $parents($id) {
935 if {![info exists idinlist($p)]} {
937 } elseif {!$idinlist($p)} {
941 set nev [expr {[llength $idlist] + [llength $newolds]
942 + [llength $oldolds] - $maxwidth + 1}]
944 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
945 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
946 set i [lindex $idlist $x]
947 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
948 set r [usedinrange $i [expr {$row - $downarrowlen}] \
949 [expr {$row + $uparrowlen + $mingaplen}]]
951 set idlist [lreplace $idlist $x $x]
952 set offs [lreplace $offs $x $x]
953 set offs [incrange $offs $x 1]
955 lappend linesegends($row) $i
956 lappend idrowranges($i) [expr {$row-1}]
957 if {[incr nev -1] <= 0} break
960 set rowchk($id) [expr {$row + $r}]
963 lset rowidlist $row $idlist
964 lset rowoffsets $row $offs
966 set col [lsearch -exact $idlist $id]
968 set col [llength $idlist]
970 lset rowidlist $row $idlist
972 if {$nchildren($id) > 0} {
973 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
977 lset rowoffsets $row $offs
979 makeuparrow $id $col $row $z
984 if {[info exists idrowranges($id)]} {
985 lappend linesegends($row) $id
986 lappend idrowranges($id) $row
989 set offs [ntimes [llength $idlist] 0]
990 set l [llength $newolds]
991 set idlist [eval lreplace \$idlist $col $col $newolds]
994 set offs [lrange $offs 0 [expr {$col - 1}]]
1000 set tmp [expr {[llength $idlist] - [llength $offs]}]
1002 set offs [concat $offs [ntimes $tmp $o]]
1007 foreach i $newolds {
1009 set idrowranges($i) $row
1012 foreach oid $oldolds {
1013 set idinlist($oid) 1
1014 set idlist [linsert $idlist $col $oid]
1015 set offs [linsert $offs $col $o]
1016 makeuparrow $oid $col $row $o
1019 lappend rowidlist $idlist
1020 lappend rowoffsets $offs
1025 proc addextraid {id row} {
1026 global displayorder commitrow commitinfo nparents
1030 lappend displayorder $id
1031 set commitrow($id) $row
1033 if {![info exists commitinfo($id)]} {
1034 set commitinfo($id) {"No commit information available"}
1039 proc layouttail {} {
1040 global rowidlist rowoffsets idinlist commitidx
1041 global idrowranges linesegends
1044 set idlist [lindex $rowidlist $row]
1045 while {$idlist ne {}} {
1046 set col [expr {[llength $idlist] - 1}]
1047 set id [lindex $idlist $col]
1050 lappend linesegends($row) $id
1051 lappend idrowranges($id) $row
1053 set offs [ntimes $col 0]
1054 set idlist [lreplace $idlist $col $col]
1055 lappend rowidlist $idlist
1056 lappend rowoffsets $offs
1059 foreach id [array names idinlist] {
1061 lset rowidlist $row [list $id]
1062 lset rowoffsets $row 0
1063 makeuparrow $id 0 $row 0
1064 lappend linesegends($row) $id
1065 lappend idrowranges($id) $row
1067 lappend rowidlist {}
1068 lappend rowoffsets {}
1072 proc insert_pad {row col npad} {
1073 global rowidlist rowoffsets
1075 set pad [ntimes $npad {}]
1076 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1077 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1078 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1081 proc optimize_rows {row col endrow} {
1082 global rowidlist rowoffsets idrowranges
1084 for {} {$row < $endrow} {incr row} {
1085 set idlist [lindex $rowidlist $row]
1086 set offs [lindex $rowoffsets $row]
1088 for {} {$col < [llength $offs]} {incr col} {
1089 if {[lindex $idlist $col] eq {}} {
1093 set z [lindex $offs $col]
1094 if {$z eq {}} continue
1096 set x0 [expr {$col + $z}]
1097 set y0 [expr {$row - 1}]
1098 set z0 [lindex $rowoffsets $y0 $x0]
1100 set id [lindex $idlist $col]
1101 if {[info exists idrowranges($id)] &&
1102 $y0 > [lindex $idrowranges($id) 0]} {
1106 if {$z < -1 || ($z < 0 && $isarrow)} {
1107 set npad [expr {-1 - $z + $isarrow}]
1108 set offs [incrange $offs $col $npad]
1109 insert_pad $y0 $x0 $npad
1111 optimize_rows $y0 $x0 $row
1113 set z [lindex $offs $col]
1114 set x0 [expr {$col + $z}]
1115 set z0 [lindex $rowoffsets $y0 $x0]
1116 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1117 set npad [expr {$z - 1 + $isarrow}]
1118 set y1 [expr {$row + 1}]
1119 set offs2 [lindex $rowoffsets $y1]
1123 if {$z eq {} || $x1 + $z < $col} continue
1124 if {$x1 + $z > $col} {
1127 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1130 set pad [ntimes $npad {}]
1131 set idlist [eval linsert \$idlist $col $pad]
1132 set tmp [eval linsert \$offs $col $pad]
1134 set offs [incrange $tmp $col [expr {-$npad}]]
1135 set z [lindex $offs $col]
1138 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1139 insert_pad $y0 $x0 1
1140 set offs [incrange $offs $col 1]
1141 optimize_rows $y0 [expr {$x0 + 1}] $row
1145 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1146 set o [lindex $offs $col]
1147 if {$o eq {} || $o <= 0} break
1149 if {[incr col] < [llength $idlist]} {
1150 set y1 [expr {$row + 1}]
1151 set offs2 [lindex $rowoffsets $y1]
1155 if {$z eq {} || $x1 + $z < $col} continue
1156 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1159 set idlist [linsert $idlist $col {}]
1160 set tmp [linsert $offs $col {}]
1162 set offs [incrange $tmp $col -1]
1165 lset rowidlist $row $idlist
1166 lset rowoffsets $row $offs
1172 global canvx0 linespc
1173 return [expr {$canvx0 + $col * $linespc}]
1177 global canvy0 linespc
1178 return [expr {$canvy0 + $row * $linespc}]
1181 proc linewidth {id} {
1182 global thickerline lthickness
1185 if {[info exists thickerline] && $id eq $thickerline} {
1186 set wid [expr {2 * $lthickness}]
1191 proc drawlineseg {id i} {
1192 global rowoffsets rowidlist idrowranges
1193 global canv colormap
1195 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1196 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1197 if {$startrow == $row} return
1200 set col [lsearch -exact [lindex $rowidlist $row] $id]
1202 puts "oops: drawline: id $id not on row $row"
1208 set o [lindex $rowoffsets $row $col]
1211 # changing direction
1212 set x [xc $row $col]
1214 lappend coords $x $y
1220 if {$coords eq {}} return
1221 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1222 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1223 set arrow [lindex {none first last both} $arrow]
1224 set x [xc $row $col]
1226 lappend coords $x $y
1227 set t [$canv create line $coords -width [linewidth $id] \
1228 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1233 proc drawparentlinks {id row col olds} {
1234 global rowidlist canv colormap
1236 set row2 [expr {$row + 1}]
1237 set x [xc $row $col]
1240 set ids [lindex $rowidlist $row2]
1241 # rmx = right-most X coord used
1244 set i [lsearch -exact $ids $p]
1246 puts "oops, parent $p of $id not in list"
1250 # should handle duplicated parents here...
1251 set coords [list $x $y]
1252 if {$i < $col - 1} {
1253 lappend coords [xc $row [expr {$i + 1}]] $y
1254 } elseif {$i > $col + 1} {
1255 lappend coords [xc $row [expr {$i - 1}]] $y
1257 set x2 [xc $row2 $i]
1261 lappend coords $x2 $y2
1262 set t [$canv create line $coords -width [linewidth $p] \
1263 -fill $colormap($p) -tags lines.$p]
1270 proc drawlines {id} {
1271 global colormap canv
1272 global idrowranges idrangedrawn
1273 global children iddrawn commitrow rowidlist
1275 $canv delete lines.$id
1276 set nr [expr {[llength $idrowranges($id)] / 2}]
1277 for {set i 0} {$i < $nr} {incr i} {
1278 if {[info exists idrangedrawn($id,$i)]} {
1282 if {[info exists children($id)]} {
1283 foreach child $children($id) {
1284 if {[info exists iddrawn($child)]} {
1285 set row $commitrow($child)
1286 set col [lsearch -exact [lindex $rowidlist $row] $child]
1288 drawparentlinks $child $row $col [list $id]
1295 proc drawcmittext {id row col rmx} {
1296 global linespc canv canv2 canv3 canvy0
1297 global commitlisted commitinfo rowidlist
1298 global rowtextx idpos idtags idheads idotherrefs
1299 global linehtag linentag linedtag
1300 global mainfont namefont
1302 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1303 set x [xc $row $col]
1305 set orad [expr {$linespc / 3}]
1306 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1307 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1308 -fill $ofill -outline black -width 1]
1310 $canv bind $t <1> {selcanvline {} %x %y}
1311 set xt [xc $row [llength [lindex $rowidlist $row]]]
1315 set rowtextx($row) $xt
1316 set idpos($id) [list $x $xt $y]
1317 if {[info exists idtags($id)] || [info exists idheads($id)]
1318 || [info exists idotherrefs($id)]} {
1319 set xt [drawtags $id $x $xt $y]
1321 set headline [lindex $commitinfo($id) 0]
1322 set name [lindex $commitinfo($id) 1]
1323 set date [lindex $commitinfo($id) 2]
1324 set date [formatdate $date]
1325 set linehtag($row) [$canv create text $xt $y -anchor w \
1326 -text $headline -font $mainfont ]
1327 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1328 set linentag($row) [$canv2 create text 3 $y -anchor w \
1329 -text $name -font $namefont]
1330 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1331 -text $date -font $mainfont]
1334 proc drawcmitrow {row} {
1335 global displayorder rowidlist
1336 global idrowranges idrangedrawn iddrawn
1337 global commitinfo commitlisted parents numcommits
1339 if {$row >= $numcommits} return
1340 foreach id [lindex $rowidlist $row] {
1341 if {![info exists idrowranges($id)]} continue
1343 foreach {s e} $idrowranges($id) {
1345 if {$row < $s} continue
1348 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1350 set idrangedrawn($id,$i) 1
1357 set id [lindex $displayorder $row]
1358 if {[info exists iddrawn($id)]} return
1359 set col [lsearch -exact [lindex $rowidlist $row] $id]
1361 puts "oops, row $row id $id not in list"
1364 if {![info exists commitinfo($id)]} {
1368 if {[info exists commitlisted($id)] && [info exists parents($id)]
1369 && $parents($id) ne {}} {
1370 set rmx [drawparentlinks $id $row $col $parents($id)]
1374 drawcmittext $id $row $col $rmx
1378 proc drawfrac {f0 f1} {
1379 global numcommits canv
1382 set ymax [lindex [$canv cget -scrollregion] 3]
1383 if {$ymax eq {} || $ymax == 0} return
1384 set y0 [expr {int($f0 * $ymax)}]
1385 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1389 set y1 [expr {int($f1 * $ymax)}]
1390 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1391 if {$endrow >= $numcommits} {
1392 set endrow [expr {$numcommits - 1}]
1394 for {} {$row <= $endrow} {incr row} {
1399 proc drawvisible {} {
1401 eval drawfrac [$canv yview]
1404 proc clear_display {} {
1405 global iddrawn idrangedrawn
1408 catch {unset iddrawn}
1409 catch {unset idrangedrawn}
1412 proc assigncolor {id} {
1413 global colormap colors nextcolor
1414 global parents nparents children nchildren
1415 global cornercrossings crossings
1417 if {[info exists colormap($id)]} return
1418 set ncolors [llength $colors]
1419 if {$nchildren($id) == 1} {
1420 set child [lindex $children($id) 0]
1421 if {[info exists colormap($child)]
1422 && $nparents($child) == 1} {
1423 set colormap($id) $colormap($child)
1428 if {[info exists cornercrossings($id)]} {
1429 foreach x $cornercrossings($id) {
1430 if {[info exists colormap($x)]
1431 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1432 lappend badcolors $colormap($x)
1435 if {[llength $badcolors] >= $ncolors} {
1439 set origbad $badcolors
1440 if {[llength $badcolors] < $ncolors - 1} {
1441 if {[info exists crossings($id)]} {
1442 foreach x $crossings($id) {
1443 if {[info exists colormap($x)]
1444 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1445 lappend badcolors $colormap($x)
1448 if {[llength $badcolors] >= $ncolors} {
1449 set badcolors $origbad
1452 set origbad $badcolors
1454 if {[llength $badcolors] < $ncolors - 1} {
1455 foreach child $children($id) {
1456 if {[info exists colormap($child)]
1457 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1458 lappend badcolors $colormap($child)
1460 if {[info exists parents($child)]} {
1461 foreach p $parents($child) {
1462 if {[info exists colormap($p)]
1463 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1464 lappend badcolors $colormap($p)
1469 if {[llength $badcolors] >= $ncolors} {
1470 set badcolors $origbad
1473 for {set i 0} {$i <= $ncolors} {incr i} {
1474 set c [lindex $colors $nextcolor]
1475 if {[incr nextcolor] >= $ncolors} {
1478 if {[lsearch -exact $badcolors $c]} break
1480 set colormap($id) $c
1483 proc bindline {t id} {
1486 $canv bind $t <Enter> "lineenter %x %y $id"
1487 $canv bind $t <Motion> "linemotion %x %y $id"
1488 $canv bind $t <Leave> "lineleave $id"
1489 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1492 proc drawtags {id x xt y1} {
1493 global idtags idheads idotherrefs
1494 global linespc lthickness
1495 global canv mainfont commitrow rowtextx
1500 if {[info exists idtags($id)]} {
1501 set marks $idtags($id)
1502 set ntags [llength $marks]
1504 if {[info exists idheads($id)]} {
1505 set marks [concat $marks $idheads($id)]
1506 set nheads [llength $idheads($id)]
1508 if {[info exists idotherrefs($id)]} {
1509 set marks [concat $marks $idotherrefs($id)]
1515 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1516 set yt [expr {$y1 - 0.5 * $linespc}]
1517 set yb [expr {$yt + $linespc - 1}]
1520 foreach tag $marks {
1521 set wid [font measure $mainfont $tag]
1524 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1526 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1527 -width $lthickness -fill black -tags tag.$id]
1529 foreach tag $marks x $xvals wid $wvals {
1530 set xl [expr {$x + $delta}]
1531 set xr [expr {$x + $delta + $wid + $lthickness}]
1532 if {[incr ntags -1] >= 0} {
1534 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1535 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1536 -width 1 -outline black -fill yellow -tags tag.$id]
1537 $canv bind $t <1> [list showtag $tag 1]
1538 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1540 # draw a head or other ref
1541 if {[incr nheads -1] >= 0} {
1546 set xl [expr {$xl - $delta/2}]
1547 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1548 -width 1 -outline black -fill $col -tags tag.$id
1550 set t [$canv create text $xl $y1 -anchor w -text $tag \
1551 -font $mainfont -tags tag.$id]
1553 $canv bind $t <1> [list showtag $tag 1]
1559 proc checkcrossings {row endrow} {
1560 global displayorder parents rowidlist
1562 for {} {$row < $endrow} {incr row} {
1563 set id [lindex $displayorder $row]
1564 set i [lsearch -exact [lindex $rowidlist $row] $id]
1565 if {$i < 0} continue
1566 set idlist [lindex $rowidlist [expr {$row+1}]]
1567 foreach p $parents($id) {
1568 set j [lsearch -exact $idlist $p]
1571 notecrossings $row $p $j $i [expr {$j+1}]
1572 } elseif {$j > $i + 1} {
1573 notecrossings $row $p $i $j [expr {$j-1}]
1580 proc notecrossings {row id lo hi corner} {
1581 global rowidlist crossings cornercrossings
1583 for {set i $lo} {[incr i] < $hi} {} {
1584 set p [lindex [lindex $rowidlist $row] $i]
1585 if {$p == {}} continue
1586 if {$i == $corner} {
1587 if {![info exists cornercrossings($id)]
1588 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1589 lappend cornercrossings($id) $p
1591 if {![info exists cornercrossings($p)]
1592 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1593 lappend cornercrossings($p) $id
1596 if {![info exists crossings($id)]
1597 || [lsearch -exact $crossings($id) $p] < 0} {
1598 lappend crossings($id) $p
1600 if {![info exists crossings($p)]
1601 || [lsearch -exact $crossings($p) $id] < 0} {
1602 lappend crossings($p) $id
1608 proc xcoord {i level ln} {
1609 global canvx0 xspc1 xspc2
1611 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1612 if {$i > 0 && $i == $level} {
1613 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1614 } elseif {$i > $level} {
1615 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1620 proc finishcommits {} {
1621 global commitidx phase
1622 global canv mainfont ctext maincursor textcursor
1624 if {$commitidx > 0} {
1628 $canv create text 3 3 -anchor nw -text "No commits selected" \
1629 -font $mainfont -tags textitems
1631 . config -cursor $maincursor
1632 settextcursor $textcursor
1636 # Don't change the text pane cursor if it is currently the hand cursor,
1637 # showing that we are over a sha1 ID link.
1638 proc settextcursor {c} {
1639 global ctext curtextcursor
1641 if {[$ctext cget -cursor] == $curtextcursor} {
1642 $ctext config -cursor $c
1644 set curtextcursor $c
1650 global canvy0 numcommits linespc
1651 global rowlaidout commitidx
1654 layoutrows $rowlaidout $commitidx 1
1656 optimize_rows $row 0 $commitidx
1657 showstuff $commitidx
1659 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1660 #puts "overall $drawmsecs ms for $numcommits commits"
1663 proc findmatches {f} {
1664 global findtype foundstring foundstrlen
1665 if {$findtype == "Regexp"} {
1666 set matches [regexp -indices -all -inline $foundstring $f]
1668 if {$findtype == "IgnCase"} {
1669 set str [string tolower $f]
1675 while {[set j [string first $foundstring $str $i]] >= 0} {
1676 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1677 set i [expr {$j + $foundstrlen}]
1684 global findtype findloc findstring markedmatches commitinfo
1685 global numcommits displayorder linehtag linentag linedtag
1686 global mainfont namefont canv canv2 canv3 selectedline
1687 global matchinglines foundstring foundstrlen matchstring
1693 set matchinglines {}
1694 if {$findloc == "Pickaxe"} {
1698 if {$findtype == "IgnCase"} {
1699 set foundstring [string tolower $findstring]
1701 set foundstring $findstring
1703 set foundstrlen [string length $findstring]
1704 if {$foundstrlen == 0} return
1705 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1706 set matchstring "*$matchstring*"
1707 if {$findloc == "Files"} {
1711 if {![info exists selectedline]} {
1714 set oldsel $selectedline
1717 set fldtypes {Headline Author Date Committer CDate Comment}
1719 foreach id $displayorder {
1720 set d $commitdata($id)
1722 if {$findtype == "Regexp"} {
1723 set doesmatch [regexp $foundstring $d]
1724 } elseif {$findtype == "IgnCase"} {
1725 set doesmatch [string match -nocase $matchstring $d]
1727 set doesmatch [string match $matchstring $d]
1729 if {!$doesmatch} continue
1730 if {![info exists commitinfo($id)]} {
1733 set info $commitinfo($id)
1735 foreach f $info ty $fldtypes {
1736 if {$findloc != "All fields" && $findloc != $ty} {
1739 set matches [findmatches $f]
1740 if {$matches == {}} continue
1742 if {$ty == "Headline"} {
1744 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1745 } elseif {$ty == "Author"} {
1747 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1748 } elseif {$ty == "Date"} {
1750 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1754 lappend matchinglines $l
1755 if {!$didsel && $l > $oldsel} {
1761 if {$matchinglines == {}} {
1763 } elseif {!$didsel} {
1764 findselectline [lindex $matchinglines 0]
1768 proc findselectline {l} {
1769 global findloc commentend ctext
1771 if {$findloc == "All fields" || $findloc == "Comments"} {
1772 # highlight the matches in the comments
1773 set f [$ctext get 1.0 $commentend]
1774 set matches [findmatches $f]
1775 foreach match $matches {
1776 set start [lindex $match 0]
1777 set end [expr {[lindex $match 1] + 1}]
1778 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1783 proc findnext {restart} {
1784 global matchinglines selectedline
1785 if {![info exists matchinglines]} {
1791 if {![info exists selectedline]} return
1792 foreach l $matchinglines {
1793 if {$l > $selectedline} {
1802 global matchinglines selectedline
1803 if {![info exists matchinglines]} {
1807 if {![info exists selectedline]} return
1809 foreach l $matchinglines {
1810 if {$l >= $selectedline} break
1814 findselectline $prev
1820 proc findlocchange {name ix op} {
1821 global findloc findtype findtypemenu
1822 if {$findloc == "Pickaxe"} {
1828 $findtypemenu entryconf 1 -state $state
1829 $findtypemenu entryconf 2 -state $state
1832 proc stopfindproc {{done 0}} {
1833 global findprocpid findprocfile findids
1834 global ctext findoldcursor phase maincursor textcursor
1835 global findinprogress
1837 catch {unset findids}
1838 if {[info exists findprocpid]} {
1840 catch {exec kill $findprocpid}
1842 catch {close $findprocfile}
1845 if {[info exists findinprogress]} {
1846 unset findinprogress
1847 if {$phase != "incrdraw"} {
1848 . config -cursor $maincursor
1849 settextcursor $textcursor
1854 proc findpatches {} {
1855 global findstring selectedline numcommits
1856 global findprocpid findprocfile
1857 global finddidsel ctext displayorder findinprogress
1858 global findinsertpos
1860 if {$numcommits == 0} return
1862 # make a list of all the ids to search, starting at the one
1863 # after the selected line (if any)
1864 if {[info exists selectedline]} {
1870 for {set i 0} {$i < $numcommits} {incr i} {
1871 if {[incr l] >= $numcommits} {
1874 append inputids [lindex $displayorder $l] "\n"
1878 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1881 error_popup "Error starting search process: $err"
1885 set findinsertpos end
1887 set findprocpid [pid $f]
1888 fconfigure $f -blocking 0
1889 fileevent $f readable readfindproc
1891 . config -cursor watch
1893 set findinprogress 1
1896 proc readfindproc {} {
1897 global findprocfile finddidsel
1898 global commitrow matchinglines findinsertpos
1900 set n [gets $findprocfile line]
1902 if {[eof $findprocfile]} {
1910 if {![regexp {^[0-9a-f]{40}} $line id]} {
1911 error_popup "Can't parse git-diff-tree output: $line"
1915 if {![info exists commitrow($id)]} {
1916 puts stderr "spurious id: $id"
1919 set l $commitrow($id)
1923 proc insertmatch {l id} {
1924 global matchinglines findinsertpos finddidsel
1926 if {$findinsertpos == "end"} {
1927 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1928 set matchinglines [linsert $matchinglines 0 $l]
1931 lappend matchinglines $l
1934 set matchinglines [linsert $matchinglines $findinsertpos $l]
1945 global selectedline numcommits displayorder ctext
1946 global ffileline finddidsel parents nparents
1947 global findinprogress findstartline findinsertpos
1948 global treediffs fdiffid fdiffsneeded fdiffpos
1949 global findmergefiles
1951 if {$numcommits == 0} return
1953 if {[info exists selectedline]} {
1954 set l [expr {$selectedline + 1}]
1959 set findstartline $l
1963 set id [lindex $displayorder $l]
1964 if {$findmergefiles || $nparents($id) == 1} {
1965 if {![info exists treediffs($id)]} {
1966 append diffsneeded "$id\n"
1967 lappend fdiffsneeded $id
1970 if {[incr l] >= $numcommits} {
1973 if {$l == $findstartline} break
1976 # start off a git-diff-tree process if needed
1977 if {$diffsneeded ne {}} {
1979 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1981 error_popup "Error starting search process: $err"
1984 catch {unset fdiffid}
1986 fconfigure $df -blocking 0
1987 fileevent $df readable [list readfilediffs $df]
1991 set findinsertpos end
1992 set id [lindex $displayorder $l]
1993 . config -cursor watch
1995 set findinprogress 1
2000 proc readfilediffs {df} {
2001 global findid fdiffid fdiffs
2003 set n [gets $df line]
2007 if {[catch {close $df} err]} {
2010 error_popup "Error in git-diff-tree: $err"
2011 } elseif {[info exists findid]} {
2015 error_popup "Couldn't find diffs for $id"
2020 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2021 # start of a new string of diffs
2025 } elseif {[string match ":*" $line]} {
2026 lappend fdiffs [lindex $line 5]
2030 proc donefilediff {} {
2031 global fdiffid fdiffs treediffs findid
2032 global fdiffsneeded fdiffpos
2034 if {[info exists fdiffid]} {
2035 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2036 && $fdiffpos < [llength $fdiffsneeded]} {
2037 # git-diff-tree doesn't output anything for a commit
2038 # which doesn't change anything
2039 set nullid [lindex $fdiffsneeded $fdiffpos]
2040 set treediffs($nullid) {}
2041 if {[info exists findid] && $nullid eq $findid} {
2049 if {![info exists treediffs($fdiffid)]} {
2050 set treediffs($fdiffid) $fdiffs
2052 if {[info exists findid] && $fdiffid eq $findid} {
2059 proc findcont {id} {
2060 global findid treediffs parents nparents
2061 global ffileline findstartline finddidsel
2062 global displayorder numcommits matchinglines findinprogress
2063 global findmergefiles
2067 if {$findmergefiles || $nparents($id) == 1} {
2068 if {![info exists treediffs($id)]} {
2074 foreach f $treediffs($id) {
2075 set x [findmatches $f]
2085 if {[incr l] >= $numcommits} {
2088 if {$l == $findstartline} break
2089 set id [lindex $displayorder $l]
2097 # mark a commit as matching by putting a yellow background
2098 # behind the headline
2099 proc markheadline {l id} {
2100 global canv mainfont linehtag
2103 set bbox [$canv bbox $linehtag($l)]
2104 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2108 # mark the bits of a headline, author or date that match a find string
2109 proc markmatches {canv l str tag matches font} {
2110 set bbox [$canv bbox $tag]
2111 set x0 [lindex $bbox 0]
2112 set y0 [lindex $bbox 1]
2113 set y1 [lindex $bbox 3]
2114 foreach match $matches {
2115 set start [lindex $match 0]
2116 set end [lindex $match 1]
2117 if {$start > $end} continue
2118 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2119 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2120 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2121 [expr {$x0+$xlen+2}] $y1 \
2122 -outline {} -tags matches -fill yellow]
2127 proc unmarkmatches {} {
2128 global matchinglines findids
2129 allcanvs delete matches
2130 catch {unset matchinglines}
2131 catch {unset findids}
2134 proc selcanvline {w x y} {
2135 global canv canvy0 ctext linespc
2137 set ymax [lindex [$canv cget -scrollregion] 3]
2138 if {$ymax == {}} return
2139 set yfrac [lindex [$canv yview] 0]
2140 set y [expr {$y + $yfrac * $ymax}]
2141 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2146 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2152 proc commit_descriptor {p} {
2155 if {[info exists commitinfo($p)]} {
2156 set l [lindex $commitinfo($p) 0]
2161 # append some text to the ctext widget, and make any SHA1 ID
2162 # that we know about be a clickable link.
2163 proc appendwithlinks {text} {
2164 global ctext commitrow linknum
2166 set start [$ctext index "end - 1c"]
2167 $ctext insert end $text
2168 $ctext insert end "\n"
2169 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2173 set linkid [string range $text $s $e]
2174 if {![info exists commitrow($linkid)]} continue
2176 $ctext tag add link "$start + $s c" "$start + $e c"
2177 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2178 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2181 $ctext tag conf link -foreground blue -underline 1
2182 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2183 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2186 proc selectline {l isnew} {
2187 global canv canv2 canv3 ctext commitinfo selectedline
2188 global displayorder linehtag linentag linedtag
2189 global canvy0 linespc parents nparents children
2190 global cflist currentid sha1entry
2191 global commentend idtags linknum
2192 global mergemax numcommits
2196 if {$l < 0 || $l >= $numcommits} return
2197 set y [expr {$canvy0 + $l * $linespc}]
2198 set ymax [lindex [$canv cget -scrollregion] 3]
2199 set ytop [expr {$y - $linespc - 1}]
2200 set ybot [expr {$y + $linespc + 1}]
2201 set wnow [$canv yview]
2202 set wtop [expr {[lindex $wnow 0] * $ymax}]
2203 set wbot [expr {[lindex $wnow 1] * $ymax}]
2204 set wh [expr {$wbot - $wtop}]
2206 if {$ytop < $wtop} {
2207 if {$ybot < $wtop} {
2208 set newtop [expr {$y - $wh / 2.0}]
2211 if {$newtop > $wtop - $linespc} {
2212 set newtop [expr {$wtop - $linespc}]
2215 } elseif {$ybot > $wbot} {
2216 if {$ytop > $wbot} {
2217 set newtop [expr {$y - $wh / 2.0}]
2219 set newtop [expr {$ybot - $wh}]
2220 if {$newtop < $wtop + $linespc} {
2221 set newtop [expr {$wtop + $linespc}]
2225 if {$newtop != $wtop} {
2229 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2233 if {![info exists linehtag($l)]} return
2235 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2236 -tags secsel -fill [$canv cget -selectbackground]]
2238 $canv2 delete secsel
2239 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2240 -tags secsel -fill [$canv2 cget -selectbackground]]
2242 $canv3 delete secsel
2243 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2244 -tags secsel -fill [$canv3 cget -selectbackground]]
2248 addtohistory [list selectline $l 0]
2253 set id [lindex $displayorder $l]
2255 $sha1entry delete 0 end
2256 $sha1entry insert 0 $id
2257 $sha1entry selection from 0
2258 $sha1entry selection to end
2260 $ctext conf -state normal
2261 $ctext delete 0.0 end
2263 $ctext mark set fmark.0 0.0
2264 $ctext mark gravity fmark.0 left
2265 set info $commitinfo($id)
2266 set date [formatdate [lindex $info 2]]
2267 $ctext insert end "Author: [lindex $info 1] $date\n"
2268 set date [formatdate [lindex $info 4]]
2269 $ctext insert end "Committer: [lindex $info 3] $date\n"
2270 if {[info exists idtags($id)]} {
2271 $ctext insert end "Tags:"
2272 foreach tag $idtags($id) {
2273 $ctext insert end " $tag"
2275 $ctext insert end "\n"
2279 if {$nparents($id) > 1} {
2281 foreach p $parents($id) {
2282 if {$np >= $mergemax} {
2287 $ctext insert end "Parent: " $tag
2288 appendwithlinks [commit_descriptor $p]
2292 if {[info exists parents($id)]} {
2293 foreach p $parents($id) {
2294 append comment "Parent: [commit_descriptor $p]\n"
2299 if {[info exists children($id)]} {
2300 foreach c $children($id) {
2301 append comment "Child: [commit_descriptor $c]\n"
2305 append comment [lindex $info 5]
2307 # make anything that looks like a SHA1 ID be a clickable link
2308 appendwithlinks $comment
2310 $ctext tag delete Comments
2311 $ctext tag remove found 1.0 end
2312 $ctext conf -state disabled
2313 set commentend [$ctext index "end - 1c"]
2315 $cflist delete 0 end
2316 $cflist insert end "Comments"
2317 if {$nparents($id) == 1} {
2319 } elseif {$nparents($id) > 1} {
2324 proc selnextline {dir} {
2326 if {![info exists selectedline]} return
2327 set l [expr {$selectedline + $dir}]
2332 proc unselectline {} {
2335 catch {unset selectedline}
2336 allcanvs delete secsel
2339 proc addtohistory {cmd} {
2340 global history historyindex
2342 if {$historyindex > 0
2343 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2347 if {$historyindex < [llength $history]} {
2348 set history [lreplace $history $historyindex end $cmd]
2350 lappend history $cmd
2353 if {$historyindex > 1} {
2354 .ctop.top.bar.leftbut conf -state normal
2356 .ctop.top.bar.leftbut conf -state disabled
2358 .ctop.top.bar.rightbut conf -state disabled
2362 global history historyindex
2364 if {$historyindex > 1} {
2365 incr historyindex -1
2366 set cmd [lindex $history [expr {$historyindex - 1}]]
2368 .ctop.top.bar.rightbut conf -state normal
2370 if {$historyindex <= 1} {
2371 .ctop.top.bar.leftbut conf -state disabled
2376 global history historyindex
2378 if {$historyindex < [llength $history]} {
2379 set cmd [lindex $history $historyindex]
2382 .ctop.top.bar.leftbut conf -state normal
2384 if {$historyindex >= [llength $history]} {
2385 .ctop.top.bar.rightbut conf -state disabled
2389 proc mergediff {id} {
2390 global parents diffmergeid diffopts mdifffd
2391 global difffilestart
2394 catch {unset difffilestart}
2395 # this doesn't seem to actually affect anything...
2396 set env(GIT_DIFF_OPTS) $diffopts
2397 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2398 if {[catch {set mdf [open $cmd r]} err]} {
2399 error_popup "Error getting merge diffs: $err"
2402 fconfigure $mdf -blocking 0
2403 set mdifffd($id) $mdf
2404 fileevent $mdf readable [list getmergediffline $mdf $id]
2405 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2408 proc getmergediffline {mdf id} {
2409 global diffmergeid ctext cflist nextupdate nparents mergemax
2410 global difffilestart
2412 set n [gets $mdf line]
2419 if {![info exists diffmergeid] || $id != $diffmergeid} {
2422 $ctext conf -state normal
2423 if {[regexp {^diff --cc (.*)} $line match fname]} {
2424 # start of a new file
2425 $ctext insert end "\n"
2426 set here [$ctext index "end - 1c"]
2427 set i [$cflist index end]
2428 $ctext mark set fmark.$i $here
2429 $ctext mark gravity fmark.$i left
2430 set difffilestart([expr {$i-1}]) $here
2431 $cflist insert end $fname
2432 set l [expr {(78 - [string length $fname]) / 2}]
2433 set pad [string range "----------------------------------------" 1 $l]
2434 $ctext insert end "$pad $fname $pad\n" filesep
2435 } elseif {[regexp {^@@} $line]} {
2436 $ctext insert end "$line\n" hunksep
2437 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2440 # parse the prefix - one ' ', '-' or '+' for each parent
2441 set np $nparents($id)
2446 for {set j 0} {$j < $np} {incr j} {
2447 set c [string range $line $j $j]
2450 } elseif {$c == "-"} {
2452 } elseif {$c == "+"} {
2461 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2462 # line doesn't appear in result, parents in $minuses have the line
2463 set num [lindex $minuses 0]
2464 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2465 # line appears in result, parents in $pluses don't have the line
2466 lappend tags mresult
2467 set num [lindex $spaces 0]
2470 if {$num >= $mergemax} {
2475 $ctext insert end "$line\n" $tags
2477 $ctext conf -state disabled
2478 if {[clock clicks -milliseconds] >= $nextupdate} {
2480 fileevent $mdf readable {}
2482 fileevent $mdf readable [list getmergediffline $mdf $id]
2486 proc startdiff {ids} {
2487 global treediffs diffids treepending diffmergeid
2490 catch {unset diffmergeid}
2491 if {![info exists treediffs($ids)]} {
2492 if {![info exists treepending]} {
2500 proc addtocflist {ids} {
2501 global treediffs cflist
2502 foreach f $treediffs($ids) {
2503 $cflist insert end $f
2508 proc gettreediffs {ids} {
2509 global treediff parents treepending
2510 set treepending $ids
2513 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2515 fconfigure $gdtf -blocking 0
2516 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2519 proc gettreediffline {gdtf ids} {
2520 global treediff treediffs treepending diffids diffmergeid
2522 set n [gets $gdtf line]
2524 if {![eof $gdtf]} return
2526 set treediffs($ids) $treediff
2528 if {$ids != $diffids} {
2529 gettreediffs $diffids
2531 if {[info exists diffmergeid]} {
2539 set file [lindex $line 5]
2540 lappend treediff $file
2543 proc getblobdiffs {ids} {
2544 global diffopts blobdifffd diffids env curdifftag curtagstart
2545 global difffilestart nextupdate diffinhdr treediffs
2547 set env(GIT_DIFF_OPTS) $diffopts
2548 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2549 if {[catch {set bdf [open $cmd r]} err]} {
2550 puts "error getting diffs: $err"
2554 fconfigure $bdf -blocking 0
2555 set blobdifffd($ids) $bdf
2556 set curdifftag Comments
2558 catch {unset difffilestart}
2559 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2560 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2563 proc getblobdiffline {bdf ids} {
2564 global diffids blobdifffd ctext curdifftag curtagstart
2565 global diffnexthead diffnextnote difffilestart
2566 global nextupdate diffinhdr treediffs
2568 set n [gets $bdf line]
2572 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2573 $ctext tag add $curdifftag $curtagstart end
2578 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2581 $ctext conf -state normal
2582 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2583 # start of a new file
2584 $ctext insert end "\n"
2585 $ctext tag add $curdifftag $curtagstart end
2586 set curtagstart [$ctext index "end - 1c"]
2588 set here [$ctext index "end - 1c"]
2589 set i [lsearch -exact $treediffs($diffids) $fname]
2591 set difffilestart($i) $here
2593 $ctext mark set fmark.$i $here
2594 $ctext mark gravity fmark.$i left
2596 if {$newname != $fname} {
2597 set i [lsearch -exact $treediffs($diffids) $newname]
2599 set difffilestart($i) $here
2601 $ctext mark set fmark.$i $here
2602 $ctext mark gravity fmark.$i left
2605 set curdifftag "f:$fname"
2606 $ctext tag delete $curdifftag
2607 set l [expr {(78 - [string length $header]) / 2}]
2608 set pad [string range "----------------------------------------" 1 $l]
2609 $ctext insert end "$pad $header $pad\n" filesep
2611 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2613 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2615 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2616 $line match f1l f1c f2l f2c rest]} {
2617 $ctext insert end "$line\n" hunksep
2620 set x [string range $line 0 0]
2621 if {$x == "-" || $x == "+"} {
2622 set tag [expr {$x == "+"}]
2623 $ctext insert end "$line\n" d$tag
2624 } elseif {$x == " "} {
2625 $ctext insert end "$line\n"
2626 } elseif {$diffinhdr || $x == "\\"} {
2627 # e.g. "\ No newline at end of file"
2628 $ctext insert end "$line\n" filesep
2630 # Something else we don't recognize
2631 if {$curdifftag != "Comments"} {
2632 $ctext insert end "\n"
2633 $ctext tag add $curdifftag $curtagstart end
2634 set curtagstart [$ctext index "end - 1c"]
2635 set curdifftag Comments
2637 $ctext insert end "$line\n" filesep
2640 $ctext conf -state disabled
2641 if {[clock clicks -milliseconds] >= $nextupdate} {
2643 fileevent $bdf readable {}
2645 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2650 global difffilestart ctext
2651 set here [$ctext index @0,0]
2652 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2653 if {[$ctext compare $difffilestart($i) > $here]} {
2654 if {![info exists pos]
2655 || [$ctext compare $difffilestart($i) < $pos]} {
2656 set pos $difffilestart($i)
2660 if {[info exists pos]} {
2665 proc listboxsel {} {
2666 global ctext cflist currentid
2667 if {![info exists currentid]} return
2668 set sel [lsort [$cflist curselection]]
2669 if {$sel eq {}} return
2670 set first [lindex $sel 0]
2671 catch {$ctext yview fmark.$first}
2675 global linespc charspc canvx0 canvy0 mainfont
2676 global xspc1 xspc2 lthickness
2678 set linespc [font metrics $mainfont -linespace]
2679 set charspc [font measure $mainfont "m"]
2680 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2681 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2682 set lthickness [expr {int($linespc / 9) + 1}]
2683 set xspc1(0) $linespc
2688 global canv canvy0 linespc numcommits
2691 set ymax [lindex [$canv cget -scrollregion] 3]
2692 if {$ymax eq {} || $ymax == 0} return
2693 set span [$canv yview]
2695 allcanvs conf -scrollregion \
2696 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2697 allcanvs yview moveto [lindex $span 0]
2699 if {[info exists selectedline]} {
2700 selectline $selectedline 0
2704 proc incrfont {inc} {
2705 global mainfont namefont textfont ctext canv phase
2706 global stopped entries
2708 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2709 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2710 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2712 $ctext conf -font $textfont
2713 $ctext tag conf filesep -font [concat $textfont bold]
2714 foreach e $entries {
2715 $e conf -font $mainfont
2717 if {$phase == "getcommits"} {
2718 $canv itemconf textitems -font $mainfont
2724 global sha1entry sha1string
2725 if {[string length $sha1string] == 40} {
2726 $sha1entry delete 0 end
2730 proc sha1change {n1 n2 op} {
2731 global sha1string currentid sha1but
2732 if {$sha1string == {}
2733 || ([info exists currentid] && $sha1string == $currentid)} {
2738 if {[$sha1but cget -state] == $state} return
2739 if {$state == "normal"} {
2740 $sha1but conf -state normal -relief raised -text "Goto: "
2742 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2746 proc gotocommit {} {
2747 global sha1string currentid commitrow tagids
2748 global displayorder numcommits
2750 if {$sha1string == {}
2751 || ([info exists currentid] && $sha1string == $currentid)} return
2752 if {[info exists tagids($sha1string)]} {
2753 set id $tagids($sha1string)
2755 set id [string tolower $sha1string]
2756 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2758 foreach i $displayorder {
2759 if {[string match $id* $i]} {
2763 if {$matches ne {}} {
2764 if {[llength $matches] > 1} {
2765 error_popup "Short SHA1 id $id is ambiguous"
2768 set id [lindex $matches 0]
2772 if {[info exists commitrow($id)]} {
2773 selectline $commitrow($id) 1
2776 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2781 error_popup "$type $sha1string is not known"
2784 proc lineenter {x y id} {
2785 global hoverx hovery hoverid hovertimer
2786 global commitinfo canv
2788 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2792 if {[info exists hovertimer]} {
2793 after cancel $hovertimer
2795 set hovertimer [after 500 linehover]
2799 proc linemotion {x y id} {
2800 global hoverx hovery hoverid hovertimer
2802 if {[info exists hoverid] && $id == $hoverid} {
2805 if {[info exists hovertimer]} {
2806 after cancel $hovertimer
2808 set hovertimer [after 500 linehover]
2812 proc lineleave {id} {
2813 global hoverid hovertimer canv
2815 if {[info exists hoverid] && $id == $hoverid} {
2817 if {[info exists hovertimer]} {
2818 after cancel $hovertimer
2826 global hoverx hovery hoverid hovertimer
2827 global canv linespc lthickness
2828 global commitinfo mainfont
2830 set text [lindex $commitinfo($hoverid) 0]
2831 set ymax [lindex [$canv cget -scrollregion] 3]
2832 if {$ymax == {}} return
2833 set yfrac [lindex [$canv yview] 0]
2834 set x [expr {$hoverx + 2 * $linespc}]
2835 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2836 set x0 [expr {$x - 2 * $lthickness}]
2837 set y0 [expr {$y - 2 * $lthickness}]
2838 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2839 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2840 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2841 -fill \#ffff80 -outline black -width 1 -tags hover]
2843 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2847 proc clickisonarrow {id y} {
2848 global lthickness idrowranges
2850 set thresh [expr {2 * $lthickness + 6}]
2851 set n [expr {[llength $idrowranges($id)] - 1}]
2852 for {set i 1} {$i < $n} {incr i} {
2853 set row [lindex $idrowranges($id) $i]
2854 if {abs([yc $row] - $y) < $thresh} {
2861 proc arrowjump {id n y} {
2862 global idrowranges canv
2864 # 1 <-> 2, 3 <-> 4, etc...
2865 set n [expr {(($n - 1) ^ 1) + 1}]
2866 set row [lindex $idrowranges($id) $n]
2868 set ymax [lindex [$canv cget -scrollregion] 3]
2869 if {$ymax eq {} || $ymax <= 0} return
2870 set view [$canv yview]
2871 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2872 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2876 allcanvs yview moveto $yfrac
2879 proc lineclick {x y id isnew} {
2880 global ctext commitinfo children cflist canv thickerline
2882 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2887 # draw this line thicker than normal
2891 set ymax [lindex [$canv cget -scrollregion] 3]
2892 if {$ymax eq {}} return
2893 set yfrac [lindex [$canv yview] 0]
2894 set y [expr {$y + $yfrac * $ymax}]
2896 set dirn [clickisonarrow $id $y]
2898 arrowjump $id $dirn $y
2903 addtohistory [list lineclick $x $y $id 0]
2905 # fill the details pane with info about this line
2906 $ctext conf -state normal
2907 $ctext delete 0.0 end
2908 $ctext tag conf link -foreground blue -underline 1
2909 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2910 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2911 $ctext insert end "Parent:\t"
2912 $ctext insert end $id [list link link0]
2913 $ctext tag bind link0 <1> [list selbyid $id]
2914 set info $commitinfo($id)
2915 $ctext insert end "\n\t[lindex $info 0]\n"
2916 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2917 set date [formatdate [lindex $info 2]]
2918 $ctext insert end "\tDate:\t$date\n"
2919 if {[info exists children($id)]} {
2920 $ctext insert end "\nChildren:"
2922 foreach child $children($id) {
2924 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2925 set info $commitinfo($child)
2926 $ctext insert end "\n\t"
2927 $ctext insert end $child [list link link$i]
2928 $ctext tag bind link$i <1> [list selbyid $child]
2929 $ctext insert end "\n\t[lindex $info 0]"
2930 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2931 set date [formatdate [lindex $info 2]]
2932 $ctext insert end "\n\tDate:\t$date\n"
2935 $ctext conf -state disabled
2937 $cflist delete 0 end
2940 proc normalline {} {
2942 if {[info exists thickerline]} {
2951 if {[info exists commitrow($id)]} {
2952 selectline $commitrow($id) 1
2958 if {![info exists startmstime]} {
2959 set startmstime [clock clicks -milliseconds]
2961 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2964 proc rowmenu {x y id} {
2965 global rowctxmenu commitrow selectedline rowmenuid
2967 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2972 $rowctxmenu entryconfigure 0 -state $state
2973 $rowctxmenu entryconfigure 1 -state $state
2974 $rowctxmenu entryconfigure 2 -state $state
2976 tk_popup $rowctxmenu $x $y
2979 proc diffvssel {dirn} {
2980 global rowmenuid selectedline displayorder
2982 if {![info exists selectedline]} return
2984 set oldid [lindex $displayorder $selectedline]
2985 set newid $rowmenuid
2987 set oldid $rowmenuid
2988 set newid [lindex $displayorder $selectedline]
2990 addtohistory [list doseldiff $oldid $newid]
2991 doseldiff $oldid $newid
2994 proc doseldiff {oldid newid} {
2998 $ctext conf -state normal
2999 $ctext delete 0.0 end
3000 $ctext mark set fmark.0 0.0
3001 $ctext mark gravity fmark.0 left
3002 $cflist delete 0 end
3003 $cflist insert end "Top"
3004 $ctext insert end "From "
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 tag bind link0 <1> [list selbyid $oldid]
3009 $ctext insert end $oldid [list link link0]
3010 $ctext insert end "\n "
3011 $ctext insert end [lindex $commitinfo($oldid) 0]
3012 $ctext insert end "\n\nTo "
3013 $ctext tag bind link1 <1> [list selbyid $newid]
3014 $ctext insert end $newid [list link link1]
3015 $ctext insert end "\n "
3016 $ctext insert end [lindex $commitinfo($newid) 0]
3017 $ctext insert end "\n"
3018 $ctext conf -state disabled
3019 $ctext tag delete Comments
3020 $ctext tag remove found 1.0 end
3021 startdiff [list $oldid $newid]
3025 global rowmenuid currentid commitinfo patchtop patchnum
3027 if {![info exists currentid]} return
3028 set oldid $currentid
3029 set oldhead [lindex $commitinfo($oldid) 0]
3030 set newid $rowmenuid
3031 set newhead [lindex $commitinfo($newid) 0]
3034 catch {destroy $top}
3036 label $top.title -text "Generate patch"
3037 grid $top.title - -pady 10
3038 label $top.from -text "From:"
3039 entry $top.fromsha1 -width 40 -relief flat
3040 $top.fromsha1 insert 0 $oldid
3041 $top.fromsha1 conf -state readonly
3042 grid $top.from $top.fromsha1 -sticky w
3043 entry $top.fromhead -width 60 -relief flat
3044 $top.fromhead insert 0 $oldhead
3045 $top.fromhead conf -state readonly
3046 grid x $top.fromhead -sticky w
3047 label $top.to -text "To:"
3048 entry $top.tosha1 -width 40 -relief flat
3049 $top.tosha1 insert 0 $newid
3050 $top.tosha1 conf -state readonly
3051 grid $top.to $top.tosha1 -sticky w
3052 entry $top.tohead -width 60 -relief flat
3053 $top.tohead insert 0 $newhead
3054 $top.tohead conf -state readonly
3055 grid x $top.tohead -sticky w
3056 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3057 grid $top.rev x -pady 10
3058 label $top.flab -text "Output file:"
3059 entry $top.fname -width 60
3060 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3062 grid $top.flab $top.fname -sticky w
3064 button $top.buts.gen -text "Generate" -command mkpatchgo
3065 button $top.buts.can -text "Cancel" -command mkpatchcan
3066 grid $top.buts.gen $top.buts.can
3067 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3068 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3069 grid $top.buts - -pady 10 -sticky ew
3073 proc mkpatchrev {} {
3076 set oldid [$patchtop.fromsha1 get]
3077 set oldhead [$patchtop.fromhead get]
3078 set newid [$patchtop.tosha1 get]
3079 set newhead [$patchtop.tohead get]
3080 foreach e [list fromsha1 fromhead tosha1 tohead] \
3081 v [list $newid $newhead $oldid $oldhead] {
3082 $patchtop.$e conf -state normal
3083 $patchtop.$e delete 0 end
3084 $patchtop.$e insert 0 $v
3085 $patchtop.$e conf -state readonly
3092 set oldid [$patchtop.fromsha1 get]
3093 set newid [$patchtop.tosha1 get]
3094 set fname [$patchtop.fname get]
3095 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3096 error_popup "Error creating patch: $err"
3098 catch {destroy $patchtop}
3102 proc mkpatchcan {} {
3105 catch {destroy $patchtop}
3110 global rowmenuid mktagtop commitinfo
3114 catch {destroy $top}
3116 label $top.title -text "Create tag"
3117 grid $top.title - -pady 10
3118 label $top.id -text "ID:"
3119 entry $top.sha1 -width 40 -relief flat
3120 $top.sha1 insert 0 $rowmenuid
3121 $top.sha1 conf -state readonly
3122 grid $top.id $top.sha1 -sticky w
3123 entry $top.head -width 60 -relief flat
3124 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3125 $top.head conf -state readonly
3126 grid x $top.head -sticky w
3127 label $top.tlab -text "Tag name:"
3128 entry $top.tag -width 60
3129 grid $top.tlab $top.tag -sticky w
3131 button $top.buts.gen -text "Create" -command mktaggo
3132 button $top.buts.can -text "Cancel" -command mktagcan
3133 grid $top.buts.gen $top.buts.can
3134 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3135 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3136 grid $top.buts - -pady 10 -sticky ew
3141 global mktagtop env tagids idtags
3143 set id [$mktagtop.sha1 get]
3144 set tag [$mktagtop.tag get]
3146 error_popup "No tag name specified"
3149 if {[info exists tagids($tag)]} {
3150 error_popup "Tag \"$tag\" already exists"
3155 set fname [file join $dir "refs/tags" $tag]
3156 set f [open $fname w]
3160 error_popup "Error creating tag: $err"
3164 set tagids($tag) $id
3165 lappend idtags($id) $tag
3169 proc redrawtags {id} {
3170 global canv linehtag commitrow idpos selectedline
3172 if {![info exists commitrow($id)]} return
3173 drawcmitrow $commitrow($id)
3174 $canv delete tag.$id
3175 set xt [eval drawtags $id $idpos($id)]
3176 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3177 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3178 selectline $selectedline 0
3185 catch {destroy $mktagtop}
3194 proc writecommit {} {
3195 global rowmenuid wrcomtop commitinfo wrcomcmd
3197 set top .writecommit
3199 catch {destroy $top}
3201 label $top.title -text "Write commit to file"
3202 grid $top.title - -pady 10
3203 label $top.id -text "ID:"
3204 entry $top.sha1 -width 40 -relief flat
3205 $top.sha1 insert 0 $rowmenuid
3206 $top.sha1 conf -state readonly
3207 grid $top.id $top.sha1 -sticky w
3208 entry $top.head -width 60 -relief flat
3209 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3210 $top.head conf -state readonly
3211 grid x $top.head -sticky w
3212 label $top.clab -text "Command:"
3213 entry $top.cmd -width 60 -textvariable wrcomcmd
3214 grid $top.clab $top.cmd -sticky w -pady 10
3215 label $top.flab -text "Output file:"
3216 entry $top.fname -width 60
3217 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3218 grid $top.flab $top.fname -sticky w
3220 button $top.buts.gen -text "Write" -command wrcomgo
3221 button $top.buts.can -text "Cancel" -command wrcomcan
3222 grid $top.buts.gen $top.buts.can
3223 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3224 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3225 grid $top.buts - -pady 10 -sticky ew
3232 set id [$wrcomtop.sha1 get]
3233 set cmd "echo $id | [$wrcomtop.cmd get]"
3234 set fname [$wrcomtop.fname get]
3235 if {[catch {exec sh -c $cmd >$fname &} err]} {
3236 error_popup "Error writing commit: $err"
3238 catch {destroy $wrcomtop}
3245 catch {destroy $wrcomtop}
3249 proc listrefs {id} {
3250 global idtags idheads idotherrefs
3253 if {[info exists idtags($id)]} {
3257 if {[info exists idheads($id)]} {
3261 if {[info exists idotherrefs($id)]} {
3262 set z $idotherrefs($id)
3264 return [list $x $y $z]
3267 proc rereadrefs {} {
3268 global idtags idheads idotherrefs
3269 global tagids headids otherrefids
3271 set refids [concat [array names idtags] \
3272 [array names idheads] [array names idotherrefs]]
3273 foreach id $refids {
3274 if {![info exists ref($id)]} {
3275 set ref($id) [listrefs $id]
3279 set refids [lsort -unique [concat $refids [array names idtags] \
3280 [array names idheads] [array names idotherrefs]]]
3281 foreach id $refids {
3282 set v [listrefs $id]
3283 if {![info exists ref($id)] || $ref($id) != $v} {
3289 proc showtag {tag isnew} {
3290 global ctext cflist tagcontents tagids linknum
3293 addtohistory [list showtag $tag 0]
3295 $ctext conf -state normal
3296 $ctext delete 0.0 end
3298 if {[info exists tagcontents($tag)]} {
3299 set text $tagcontents($tag)
3301 set text "Tag: $tag\nId: $tagids($tag)"
3303 appendwithlinks $text
3304 $ctext conf -state disabled
3305 $cflist delete 0 end
3315 global maxwidth maxgraphpct diffopts findmergefiles
3316 global oldprefs prefstop
3320 if {[winfo exists $top]} {
3324 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3325 set oldprefs($v) [set $v]
3328 wm title $top "Gitk preferences"
3329 label $top.ldisp -text "Commit list display options"
3330 grid $top.ldisp - -sticky w -pady 10
3331 label $top.spacer -text " "
3332 label $top.maxwidthl -text "Maximum graph width (lines)" \
3334 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3335 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3336 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3338 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3339 grid x $top.maxpctl $top.maxpct -sticky w
3340 checkbutton $top.findm -variable findmergefiles
3341 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3343 grid $top.findm $top.findml - -sticky w
3344 label $top.ddisp -text "Diff display options"
3345 grid $top.ddisp - -sticky w -pady 10
3346 label $top.diffoptl -text "Options for diff program" \
3348 entry $top.diffopt -width 20 -textvariable diffopts
3349 grid x $top.diffoptl $top.diffopt -sticky w
3351 button $top.buts.ok -text "OK" -command prefsok
3352 button $top.buts.can -text "Cancel" -command prefscan
3353 grid $top.buts.ok $top.buts.can
3354 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3355 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3356 grid $top.buts - - -pady 10 -sticky ew
3360 global maxwidth maxgraphpct diffopts findmergefiles
3361 global oldprefs prefstop
3363 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3364 set $v $oldprefs($v)
3366 catch {destroy $prefstop}
3371 global maxwidth maxgraphpct
3372 global oldprefs prefstop
3374 catch {destroy $prefstop}
3376 if {$maxwidth != $oldprefs(maxwidth)
3377 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3382 proc formatdate {d} {
3383 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3386 # This list of encoding names and aliases is distilled from
3387 # http://www.iana.org/assignments/character-sets.
3388 # Not all of them are supported by Tcl.
3389 set encoding_aliases {
3390 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3391 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3392 { ISO-10646-UTF-1 csISO10646UTF1 }
3393 { ISO_646.basic:1983 ref csISO646basic1983 }
3394 { INVARIANT csINVARIANT }
3395 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3396 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3397 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3398 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3399 { NATS-DANO iso-ir-9-1 csNATSDANO }
3400 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3401 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3402 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3403 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3404 { ISO-2022-KR csISO2022KR }
3406 { ISO-2022-JP csISO2022JP }
3407 { ISO-2022-JP-2 csISO2022JP2 }
3408 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3410 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3411 { IT iso-ir-15 ISO646-IT csISO15Italian }
3412 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3413 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3414 { greek7-old iso-ir-18 csISO18Greek7Old }
3415 { latin-greek iso-ir-19 csISO19LatinGreek }
3416 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3417 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3418 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3419 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3420 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3421 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3422 { INIS iso-ir-49 csISO49INIS }
3423 { INIS-8 iso-ir-50 csISO50INIS8 }
3424 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3425 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3426 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3427 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3428 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3429 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3431 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3432 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3433 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3434 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3435 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3436 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3437 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3438 { greek7 iso-ir-88 csISO88Greek7 }
3439 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3440 { iso-ir-90 csISO90 }
3441 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3442 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3443 csISO92JISC62991984b }
3444 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3445 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3446 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3447 csISO95JIS62291984handadd }
3448 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3449 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3450 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3451 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3453 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3454 { T.61-7bit iso-ir-102 csISO102T617bit }
3455 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3456 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3457 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3458 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3459 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3460 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3461 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3462 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3463 arabic csISOLatinArabic }
3464 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3465 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3466 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3467 greek greek8 csISOLatinGreek }
3468 { T.101-G2 iso-ir-128 csISO128T101G2 }
3469 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3471 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3472 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3473 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3474 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3475 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3476 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3477 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3478 csISOLatinCyrillic }
3479 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3480 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3481 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3482 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3483 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3484 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3485 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3486 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3487 { ISO_10367-box iso-ir-155 csISO10367Box }
3488 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3489 { latin-lap lap iso-ir-158 csISO158Lap }
3490 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3491 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3494 { JIS_X0201 X0201 csHalfWidthKatakana }
3495 { KSC5636 ISO646-KR csKSC5636 }
3496 { ISO-10646-UCS-2 csUnicode }
3497 { ISO-10646-UCS-4 csUCS4 }
3498 { DEC-MCS dec csDECMCS }
3499 { hp-roman8 roman8 r8 csHPRoman8 }
3500 { macintosh mac csMacintosh }
3501 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3503 { IBM038 EBCDIC-INT cp038 csIBM038 }
3504 { IBM273 CP273 csIBM273 }
3505 { IBM274 EBCDIC-BE CP274 csIBM274 }
3506 { IBM275 EBCDIC-BR cp275 csIBM275 }
3507 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3508 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3509 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3510 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3511 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3512 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3513 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3514 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3515 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3516 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3517 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3518 { IBM437 cp437 437 csPC8CodePage437 }
3519 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3520 { IBM775 cp775 csPC775Baltic }
3521 { IBM850 cp850 850 csPC850Multilingual }
3522 { IBM851 cp851 851 csIBM851 }
3523 { IBM852 cp852 852 csPCp852 }
3524 { IBM855 cp855 855 csIBM855 }
3525 { IBM857 cp857 857 csIBM857 }
3526 { IBM860 cp860 860 csIBM860 }
3527 { IBM861 cp861 861 cp-is csIBM861 }
3528 { IBM862 cp862 862 csPC862LatinHebrew }
3529 { IBM863 cp863 863 csIBM863 }
3530 { IBM864 cp864 csIBM864 }
3531 { IBM865 cp865 865 csIBM865 }
3532 { IBM866 cp866 866 csIBM866 }
3533 { IBM868 CP868 cp-ar csIBM868 }
3534 { IBM869 cp869 869 cp-gr csIBM869 }
3535 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3536 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3537 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3538 { IBM891 cp891 csIBM891 }
3539 { IBM903 cp903 csIBM903 }
3540 { IBM904 cp904 904 csIBBM904 }
3541 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3542 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3543 { IBM1026 CP1026 csIBM1026 }
3544 { EBCDIC-AT-DE csIBMEBCDICATDE }
3545 { EBCDIC-AT-DE-A csEBCDICATDEA }
3546 { EBCDIC-CA-FR csEBCDICCAFR }
3547 { EBCDIC-DK-NO csEBCDICDKNO }
3548 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3549 { EBCDIC-FI-SE csEBCDICFISE }
3550 { EBCDIC-FI-SE-A csEBCDICFISEA }
3551 { EBCDIC-FR csEBCDICFR }
3552 { EBCDIC-IT csEBCDICIT }
3553 { EBCDIC-PT csEBCDICPT }
3554 { EBCDIC-ES csEBCDICES }
3555 { EBCDIC-ES-A csEBCDICESA }
3556 { EBCDIC-ES-S csEBCDICESS }
3557 { EBCDIC-UK csEBCDICUK }
3558 { EBCDIC-US csEBCDICUS }
3559 { UNKNOWN-8BIT csUnknown8BiT }
3560 { MNEMONIC csMnemonic }
3565 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3566 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3567 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3568 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3569 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3570 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3571 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3572 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3573 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3574 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3575 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3576 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3577 { IBM1047 IBM-1047 }
3578 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3579 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3580 { UNICODE-1-1 csUnicode11 }
3583 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3584 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3586 { ISO-8859-15 ISO_8859-15 Latin-9 }
3587 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3588 { GBK CP936 MS936 windows-936 }
3589 { JIS_Encoding csJISEncoding }
3590 { Shift_JIS MS_Kanji csShiftJIS }
3591 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3593 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3594 { ISO-10646-UCS-Basic csUnicodeASCII }
3595 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3596 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3597 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3598 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3599 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3600 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3601 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3602 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3603 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3604 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3605 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3606 { Ventura-US csVenturaUS }
3607 { Ventura-International csVenturaInternational }
3608 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3609 { PC8-Turkish csPC8Turkish }
3610 { IBM-Symbols csIBMSymbols }
3611 { IBM-Thai csIBMThai }
3612 { HP-Legal csHPLegal }
3613 { HP-Pi-font csHPPiFont }
3614 { HP-Math8 csHPMath8 }
3615 { Adobe-Symbol-Encoding csHPPSMath }
3616 { HP-DeskTop csHPDesktop }
3617 { Ventura-Math csVenturaMath }
3618 { Microsoft-Publishing csMicrosoftPublishing }
3619 { Windows-31J csWindows31J }
3624 proc tcl_encoding {enc} {
3625 global encoding_aliases
3626 set names [encoding names]
3627 set lcnames [string tolower $names]
3628 set enc [string tolower $enc]
3629 set i [lsearch -exact $lcnames $enc]
3631 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3632 if {[regsub {^iso[-_]} $enc iso encx]} {
3633 set i [lsearch -exact $lcnames $encx]
3637 foreach l $encoding_aliases {
3638 set ll [string tolower $l]
3639 if {[lsearch -exact $ll $enc] < 0} continue
3640 # look through the aliases for one that tcl knows about
3642 set i [lsearch -exact $lcnames $e]
3644 if {[regsub {^iso[-_]} $e iso ex]} {
3645 set i [lsearch -exact $lcnames $ex]
3654 return [lindex $names $i]
3661 set diffopts "-U 5 -p"
3662 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3666 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3668 if {$gitencoding == ""} {
3669 set gitencoding "utf-8"
3671 set tclencoding [tcl_encoding $gitencoding]
3672 if {$tclencoding == {}} {
3673 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3676 set mainfont {Helvetica 9}
3677 set textfont {Courier 9}
3678 set findmergefiles 0
3687 set colors {green red blue magenta darkgrey brown orange}
3689 catch {source ~/.gitk}
3691 set namefont $mainfont
3693 font create optionfont -family sans-serif -size -12
3697 switch -regexp -- $arg {
3699 "^-d" { set datemode 1 }
3701 lappend revtreeargs $arg
3706 # check that we can find a .git directory somewhere...
3708 if {![file isdirectory $gitdir]} {
3709 error_popup "Cannot find the git directory \"$gitdir\"."
3722 makewindow $revtreeargs
3724 getcommits $revtreeargs