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
} {
20 global parsed_args cmdline_files
25 set args
[concat
--default HEAD
$rargs]
26 set args
[split [eval exec git-rev-parse
$args] "\n"]
29 if {![regexp
{^
[0-9a-f]{40}$
} $arg]} {
33 set cmdline_files
[lrange
$args $i end
]
36 lappend parsed_args
$arg
40 # if git-rev-parse failed for some reason...
41 set i
[lsearch
-exact $rargs "--"]
43 set cmdline_files
[lrange
$rargs [expr {$i+1}] end
]
44 set rargs
[lrange
$rargs 0 [expr {$i-1}]]
49 set parsed_args
$rargs
54 proc start_rev_list
{rlargs
} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs
[clock clicks
-milliseconds]
59 set nextupdate
[expr {$startmsecs + 100}]
62 set order
"--topo-order"
64 set order
"--date-order"
67 set commfd
[open
[concat | git-rev-list
--header $order \
68 --parents --boundary $rlargs] r
]
70 puts stderr
"Error executing git-rev-list: $err"
74 fconfigure
$commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure
$commfd -encoding $tclencoding
78 fileevent
$commfd readable
[list getcommitlines
$commfd]
79 . config
-cursor watch
83 proc stop_rev_list
{} {
86 if {![info exists commfd
]} return
95 proc getcommits
{rargs
} {
96 global phase canv mainfont
101 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
102 -font $mainfont -tags textitems
105 proc getcommitlines
{commfd
} {
106 global commitlisted nextupdate
108 global displayorder commitidx commitrow commitdata
109 global parentlist childlist children
111 set stuff
[read $commfd]
113 if {![eof
$commfd]} return
114 # set it blocking so we wait for the process to terminate
115 fconfigure
$commfd -blocking 1
116 if {![catch
{close
$commfd} err
]} {
117 after idle finishcommits
120 if {[string range
$err 0 4] == "usage"} {
122 "Gitk: error reading commits: bad arguments to git-rev-list.\
123 (Note: arguments to gitk are passed to git-rev-list\
124 to allow selection of commits to be displayed.)"
126 set err
"Error reading commits: $err"
134 set i
[string first
"\0" $stuff $start]
136 append leftover
[string range
$stuff $start end
]
141 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
144 set cmit
[string range
$stuff $start [expr {$i - 1}]]
146 set start
[expr {$i + 1}]
147 set j
[string first
"\n" $cmit]
151 set ids
[string range
$cmit 0 [expr {$j - 1}]]
152 if {[string range
$ids 0 0] == "-"} {
154 set ids
[string range
$ids 1 end
]
158 if {[string length
$id] != 40} {
166 if {[string length
$shortcmit] > 80} {
167 set shortcmit
"[string range $shortcmit 0 80]..."
169 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
172 set id
[lindex
$ids 0]
174 set olds
[lrange
$ids 1 end
]
177 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
178 lappend children
($p) $id
185 lappend parentlist
$olds
186 if {[info exists children
($id)]} {
187 lappend childlist
$children($id)
192 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
193 set commitrow
($id) $commitidx
195 lappend displayorder
$id
196 lappend commitlisted
$listed
202 if {[clock clicks
-milliseconds] >= $nextupdate} {
207 proc doupdate
{reading
} {
208 global commfd nextupdate numcommits ncmupdate
211 fileevent
$commfd readable
{}
214 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
215 if {$numcommits < 100} {
216 set ncmupdate
[expr {$numcommits + 1}]
217 } elseif
{$numcommits < 10000} {
218 set ncmupdate
[expr {$numcommits + 10}]
220 set ncmupdate
[expr {$numcommits + 100}]
223 fileevent
$commfd readable
[list getcommitlines
$commfd]
227 proc readcommit
{id
} {
228 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
229 parsecommit
$id $contents 0
232 proc updatecommits
{} {
233 global viewdata curview revtreeargs phase
241 catch
{unset viewdata
($n)}
242 parse_args
$revtreeargs
247 proc parsecommit
{id contents listed
} {
248 global commitinfo cdate
257 set hdrend
[string first
"\n\n" $contents]
259 # should never happen...
260 set hdrend
[string length
$contents]
262 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
263 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
264 foreach line
[split $header "\n"] {
265 set tag
[lindex
$line 0]
266 if {$tag == "author"} {
267 set audate
[lindex
$line end-1
]
268 set auname
[lrange
$line 1 end-2
]
269 } elseif
{$tag == "committer"} {
270 set comdate
[lindex
$line end-1
]
271 set comname
[lrange
$line 1 end-2
]
275 # take the first line of the comment as the headline
276 set i
[string first
"\n" $comment]
278 set headline
[string trim
[string range
$comment 0 $i]]
280 set headline
$comment
283 # git-rev-list indents the comment by 4 spaces;
284 # if we got this via git-cat-file, add the indentation
286 foreach line
[split $comment "\n"] {
287 append newcomment
" "
288 append newcomment
$line
289 append newcomment
"\n"
291 set comment
$newcomment
293 if {$comdate != {}} {
294 set cdate
($id) $comdate
296 set commitinfo
($id) [list
$headline $auname $audate \
297 $comname $comdate $comment]
300 proc getcommit
{id
} {
301 global commitdata commitinfo
303 if {[info exists commitdata
($id)]} {
304 parsecommit
$id $commitdata($id) 1
307 if {![info exists commitinfo
($id)]} {
308 set commitinfo
($id) {"No commit information available"}
315 global tagids idtags headids idheads tagcontents
316 global otherrefids idotherrefs
318 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
321 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
322 while {0 <= [set n
[gets
$refd line
]]} {
323 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
327 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
331 if {$type == "tags"} {
332 set tagids
($name) $id
333 lappend idtags
($id) $name
338 set commit
[exec git-rev-parse
"$id^0"]
339 if {"$commit" != "$id"} {
340 set tagids
($name) $commit
341 lappend idtags
($commit) $name
345 set tagcontents
($name) [exec git-cat-file tag
"$id"]
347 } elseif
{ $type == "heads" } {
348 set headids
($name) $id
349 lappend idheads
($id) $name
351 set otherrefids
($name) $id
352 lappend idotherrefs
($id) $name
358 proc error_popup msg
{
362 message
$w.m
-text $msg -justify center
-aspect 400
363 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
364 button
$w.ok
-text OK
-command "destroy $w"
365 pack
$w.ok
-side bottom
-fill x
366 bind $w <Visibility
> "grab $w; focus $w"
367 bind $w <Key-Return
> "destroy $w"
372 global canv canv2 canv3 linespc charspc ctext cflist
373 global textfont mainfont uifont
374 global findtype findtypemenu findloc findstring fstring geometry
375 global entries sha1entry sha1string sha1but
376 global maincursor textcursor curtextcursor
377 global rowctxmenu mergemax
380 .bar add cascade
-label "File" -menu .bar.
file
381 .bar configure
-font $uifont
383 .bar.
file add
command -label "Update" -command updatecommits
384 .bar.
file add
command -label "Reread references" -command rereadrefs
385 .bar.
file add
command -label "Quit" -command doquit
386 .bar.
file configure
-font $uifont
388 .bar add cascade
-label "Edit" -menu .bar.edit
389 .bar.edit add
command -label "Preferences" -command doprefs
390 .bar.edit configure
-font $uifont
391 menu .bar.view
-font $uifont
392 .bar add cascade
-label "View" -menu .bar.view
393 .bar.view add
command -label "New view..." -command newview
394 .bar.view add
command -label "Delete view" -command delview
-state disabled
395 .bar.view add separator
396 .bar.view add
command -label "All files" -command {showview
0}
398 .bar add cascade
-label "Help" -menu .bar.
help
399 .bar.
help add
command -label "About gitk" -command about
400 .bar.
help add
command -label "Key bindings" -command keys
401 .bar.
help configure
-font $uifont
402 . configure
-menu .bar
404 if {![info exists geometry
(canv1
)]} {
405 set geometry
(canv1
) [expr {45 * $charspc}]
406 set geometry
(canv2
) [expr {30 * $charspc}]
407 set geometry
(canv3
) [expr {15 * $charspc}]
408 set geometry
(canvh
) [expr {25 * $linespc + 4}]
409 set geometry
(ctextw
) 80
410 set geometry
(ctexth
) 30
411 set geometry
(cflistw
) 30
413 panedwindow .ctop
-orient vertical
414 if {[info exists geometry
(width
)]} {
415 .ctop conf
-width $geometry(width
) -height $geometry(height
)
416 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
417 set geometry
(ctexth
) [expr {($texth - 8) /
418 [font metrics
$textfont -linespace]}]
422 pack .ctop.top.bar
-side bottom
-fill x
423 set cscroll .ctop.top.csb
424 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
425 pack
$cscroll -side right
-fill y
426 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
427 pack .ctop.top.clist
-side top
-fill both
-expand 1
429 set canv .ctop.top.clist.canv
430 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
432 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
433 .ctop.top.clist add
$canv
434 set canv2 .ctop.top.clist.canv2
435 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
436 -bg white
-bd 0 -yscrollincr $linespc
437 .ctop.top.clist add
$canv2
438 set canv3 .ctop.top.clist.canv3
439 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
440 -bg white
-bd 0 -yscrollincr $linespc
441 .ctop.top.clist add
$canv3
442 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
444 set sha1entry .ctop.top.bar.sha1
445 set entries
$sha1entry
446 set sha1but .ctop.top.bar.sha1label
447 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
448 -command gotocommit
-width 8 -font $uifont
449 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
450 pack .ctop.top.bar.sha1label
-side left
451 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
452 trace add variable sha1string
write sha1change
453 pack
$sha1entry -side left
-pady 2
455 image create bitmap bm-left
-data {
456 #define left_width 16
457 #define left_height 16
458 static unsigned char left_bits
[] = {
459 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
460 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
461 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
463 image create bitmap bm-right
-data {
464 #define right_width 16
465 #define right_height 16
466 static unsigned char right_bits
[] = {
467 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
468 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
469 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
471 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
472 -state disabled
-width 26
473 pack .ctop.top.bar.leftbut
-side left
-fill y
474 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
475 -state disabled
-width 26
476 pack .ctop.top.bar.rightbut
-side left
-fill y
478 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
479 pack .ctop.top.bar.findbut
-side left
481 set fstring .ctop.top.bar.findstring
482 lappend entries
$fstring
483 entry
$fstring -width 30 -font $textfont -textvariable findstring
-font $textfont
484 pack
$fstring -side left
-expand 1 -fill x
486 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
487 findtype Exact IgnCase Regexp
]
488 .ctop.top.bar.findtype configure
-font $uifont
489 .ctop.top.bar.findtype.menu configure
-font $uifont
490 set findloc
"All fields"
491 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
492 Comments Author Committer Files Pickaxe
493 .ctop.top.bar.findloc configure
-font $uifont
494 .ctop.top.bar.findloc.menu configure
-font $uifont
496 pack .ctop.top.bar.findloc
-side right
497 pack .ctop.top.bar.findtype
-side right
498 # for making sure type==Exact whenever loc==Pickaxe
499 trace add variable findloc
write findlocchange
501 panedwindow .ctop.cdet
-orient horizontal
503 frame .ctop.cdet.left
504 set ctext .ctop.cdet.left.ctext
505 text
$ctext -bg white
-state disabled
-font $textfont \
506 -width $geometry(ctextw
) -height $geometry(ctexth
) \
507 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
508 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
509 pack .ctop.cdet.left.sb
-side right
-fill y
510 pack
$ctext -side left
-fill both
-expand 1
511 .ctop.cdet add .ctop.cdet.left
513 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
514 $ctext tag conf hunksep
-fore blue
515 $ctext tag conf d0
-fore red
516 $ctext tag conf d1
-fore "#00a000"
517 $ctext tag conf m0
-fore red
518 $ctext tag conf m1
-fore blue
519 $ctext tag conf m2
-fore green
520 $ctext tag conf m3
-fore purple
521 $ctext tag conf
m4 -fore brown
522 $ctext tag conf m5
-fore "#009090"
523 $ctext tag conf m6
-fore magenta
524 $ctext tag conf m7
-fore "#808000"
525 $ctext tag conf m8
-fore "#009000"
526 $ctext tag conf m9
-fore "#ff0080"
527 $ctext tag conf m10
-fore cyan
528 $ctext tag conf m11
-fore "#b07070"
529 $ctext tag conf m12
-fore "#70b0f0"
530 $ctext tag conf m13
-fore "#70f0b0"
531 $ctext tag conf m14
-fore "#f0b070"
532 $ctext tag conf m15
-fore "#ff70b0"
533 $ctext tag conf mmax
-fore darkgrey
535 $ctext tag conf mresult
-font [concat
$textfont bold
]
536 $ctext tag conf msep
-font [concat
$textfont bold
]
537 $ctext tag conf found
-back yellow
539 frame .ctop.cdet.right
540 set cflist .ctop.cdet.right.cfiles
541 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
542 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
543 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
544 pack .ctop.cdet.right.sb
-side right
-fill y
545 pack
$cflist -side left
-fill both
-expand 1
546 .ctop.cdet add .ctop.cdet.right
547 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
549 pack .ctop
-side top
-fill both
-expand 1
551 bindall
<1> {selcanvline
%W
%x
%y
}
552 #bindall <B1-Motion> {selcanvline %W %x %y}
553 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
554 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
555 bindall
<2> "canvscan mark %W %x %y"
556 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
557 bindkey
<Home
> selfirstline
558 bindkey
<End
> sellastline
559 bind .
<Key-Up
> "selnextline -1"
560 bind .
<Key-Down
> "selnextline 1"
561 bindkey
<Key-Right
> "goforw"
562 bindkey
<Key-Left
> "goback"
563 bind .
<Key-Prior
> "selnextpage -1"
564 bind .
<Key-Next
> "selnextpage 1"
565 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
566 bind .
<Control-End
> "allcanvs yview moveto 1.0"
567 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
568 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
569 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
570 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
571 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
572 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
573 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
574 bindkey p
"selnextline -1"
575 bindkey n
"selnextline 1"
578 bindkey i
"selnextline -1"
579 bindkey k
"selnextline 1"
582 bindkey b
"$ctext yview scroll -1 pages"
583 bindkey d
"$ctext yview scroll 18 units"
584 bindkey u
"$ctext yview scroll -18 units"
585 bindkey
/ {findnext
1}
586 bindkey
<Key-Return
> {findnext
0}
589 bind .
<Control-q
> doquit
590 bind .
<Control-f
> dofind
591 bind .
<Control-g
> {findnext
0}
592 bind .
<Control-r
> findprev
593 bind .
<Control-equal
> {incrfont
1}
594 bind .
<Control-KP_Add
> {incrfont
1}
595 bind .
<Control-minus
> {incrfont
-1}
596 bind .
<Control-KP_Subtract
> {incrfont
-1}
597 bind $cflist <<ListboxSelect>> listboxsel
598 bind . <Destroy> {savestuff %W}
599 bind . <Button-1> "click %W"
600 bind $fstring <Key-Return> dofind
601 bind $sha1entry <Key-Return> gotocommit
602 bind $sha1entry <<PasteSelection>> clearsha1
604 set maincursor [. cget -cursor]
605 set textcursor [$ctext cget -cursor]
606 set curtextcursor $textcursor
608 set rowctxmenu .rowctxmenu
609 menu $rowctxmenu -tearoff 0
610 $rowctxmenu add command -label "Diff this -> selected" \
611 -command {diffvssel 0}
612 $rowctxmenu add command -label "Diff selected -> this" \
613 -command {diffvssel 1}
614 $rowctxmenu add command -label "Make patch" -command mkpatch
615 $rowctxmenu add command -label "Create tag" -command mktag
616 $rowctxmenu add command -label "Write commit to file" -command writecommit
619 # mouse-2 makes all windows scan vertically, but only the one
620 # the cursor is in scans horizontally
621 proc canvscan {op w x y} {
622 global canv canv2 canv3
623 foreach c [list $canv $canv2 $canv3] {
632 proc scrollcanv {cscroll f0 f1} {
637 # when we make a key binding for the toplevel, make sure
638 # it doesn't get triggered when that key is pressed in the
639 # find string entry widget.
640 proc bindkey {ev script} {
643 set escript [bind Entry $ev]
644 if {$escript == {}} {
645 set escript [bind Entry <Key>]
648 bind $e $ev "$escript; break"
652 # set the focus back to the toplevel for any click outside
663 global canv canv2 canv3 ctext cflist mainfont textfont uifont
664 global stuffsaved findmergefiles maxgraphpct
667 if {$stuffsaved} return
668 if {![winfo viewable .]} return
670 set f [open "~/.gitk-new" w]
671 puts $f [list set mainfont $mainfont]
672 puts $f [list set textfont $textfont]
673 puts $f [list set uifont $uifont]
674 puts $f [list set findmergefiles $findmergefiles]
675 puts $f [list set maxgraphpct $maxgraphpct]
676 puts $f [list set maxwidth $maxwidth]
677 puts $f "set geometry(width) [winfo width .ctop]"
678 puts $f "set geometry(height) [winfo height .ctop]"
679 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
680 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
681 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
682 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
683 set wid [expr {([winfo width $ctext] - 8) \
684 / [font measure $textfont "0"]}]
685 puts $f "set geometry(ctextw) $wid"
686 set wid [expr {([winfo width $cflist] - 11) \
687 / [font measure [$cflist cget -font] "0"]}]
688 puts $f "set geometry(cflistw) $wid"
690 file rename -force "~/.gitk-new" "~/.gitk"
695 proc resizeclistpanes {win w} {
697 if {[info exists oldwidth($win)]} {
698 set s0 [$win sash coord 0]
699 set s1 [$win sash coord 1]
701 set sash0 [expr {int($w/2 - 2)}]
702 set sash1 [expr {int($w*5/6 - 2)}]
704 set factor [expr {1.0 * $w / $oldwidth($win)}]
705 set sash0 [expr {int($factor * [lindex $s0 0])}]
706 set sash1 [expr {int($factor * [lindex $s1 0])}]
710 if {$sash1 < $sash0 + 20} {
711 set sash1 [expr {$sash0 + 20}]
713 if {$sash1 > $w - 10} {
714 set sash1 [expr {$w - 10}]
715 if {$sash0 > $sash1 - 20} {
716 set sash0 [expr {$sash1 - 20}]
720 $win sash place 0 $sash0 [lindex $s0 1]
721 $win sash place 1 $sash1 [lindex $s1 1]
723 set oldwidth($win) $w
726 proc resizecdetpanes {win w} {
728 if {[info exists oldwidth($win)]} {
729 set s0 [$win sash coord 0]
731 set sash0 [expr {int($w*3/4 - 2)}]
733 set factor [expr {1.0 * $w / $oldwidth($win)}]
734 set sash0 [expr {int($factor * [lindex $s0 0])}]
738 if {$sash0 > $w - 15} {
739 set sash0 [expr {$w - 15}]
742 $win sash place 0 $sash0 [lindex $s0 1]
744 set oldwidth($win) $w
748 global canv canv2 canv3
754 proc bindall {event action} {
755 global canv canv2 canv3
756 bind $canv $event $action
757 bind $canv2 $event $action
758 bind $canv3 $event $action
763 if {[winfo exists $w]} {
768 wm title $w "About gitk"
770 Gitk - a commit viewer for git
772 Copyright © 2005-2006 Paul Mackerras
774 Use and redistribute under the terms of the GNU General Public License} \
775 -justify center -aspect 400
776 pack $w.m -side top -fill x -padx 20 -pady 20
777 button $w.ok -text Close -command "destroy $w"
778 pack $w.ok -side bottom
783 if {[winfo exists $w]} {
788 wm title $w "Gitk key bindings"
793 <Home> Move to first commit
794 <End> Move to last commit
795 <Up>, p, i Move up one commit
796 <Down>, n, k Move down one commit
797 <Left>, z, j Go back in history list
798 <Right>, x, l Go forward in history list
799 <PageUp> Move up one page in commit list
800 <PageDown> Move down one page in commit list
801 <Ctrl-Home> Scroll to top of commit list
802 <Ctrl-End> Scroll to bottom of commit list
803 <Ctrl-Up> Scroll commit list up one line
804 <Ctrl-Down> Scroll commit list down one line
805 <Ctrl-PageUp> Scroll commit list up one page
806 <Ctrl-PageDown> Scroll commit list down one page
807 <Delete>, b Scroll diff view up one page
808 <Backspace> Scroll diff view up one page
809 <Space> Scroll diff view down one page
810 u Scroll diff view up 18 lines
811 d Scroll diff view down 18 lines
813 <Ctrl-G> Move to next find hit
814 <Ctrl-R> Move to previous find hit
815 <Return> Move to next find hit
816 / Move to next find hit, or redo find
817 ? Move to previous find hit
818 f Scroll diff view to next file
819 <Ctrl-KP+> Increase font size
820 <Ctrl-plus> Increase font size
821 <Ctrl-KP-> Decrease font size
822 <Ctrl-minus> Decrease font size
824 -justify left -bg white -border 2 -relief sunken
825 pack $w.m -side top -fill both
826 button $w.ok -text Close -command "destroy $w"
827 pack $w.ok -side bottom
831 global newviewname nextviewnum newviewtop
834 if {[winfo exists $top]} {
840 wm title $top "Gitk view definition"
841 label $top.nl -text "Name"
842 entry $top.name -width 20 -textvariable newviewname
843 set newviewname "View $nextviewnum"
844 grid $top.nl $top.name -sticky w
845 label $top.l -text "Files and directories to include:"
846 grid $top.l - -sticky w -pady 10
847 text $top.t -width 30 -height 10
848 grid $top.t - -sticky w
850 button $top.buts.ok -text "OK" -command newviewok
851 button $top.buts.can -text "Cancel" -command newviewcan
852 grid $top.buts.ok $top.buts.can
853 grid columnconfigure $top.buts 0 -weight 1 -uniform a
854 grid columnconfigure $top.buts 1 -weight 1 -uniform a
855 grid $top.buts - -pady 10 -sticky ew
860 global newviewtop nextviewnum
861 global viewname viewfiles
865 set viewname($n) [$newviewtop.name get]
867 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
868 set ft [string trim $f]
873 set viewfiles($n) $files
874 catch {destroy $newviewtop}
876 .bar.view add command -label $viewname($n) -command [list showview $n]
877 after idle showview $n
883 catch {destroy $newviewtop}
888 global curview viewdata
890 if {$curview == 0} return
891 set nmenu [.bar.view index end]
892 set targetcmd [list showview $curview]
893 for {set i 5} {$i <= $nmenu} {incr i} {
894 if {[.bar.view entrycget $i -command] eq $targetcmd} {
899 set viewdata($curview) {}
907 foreach i [array names $var] {
908 lappend ret $i [set $var\($i\)]
913 proc unflatten {var l} {
923 global curview viewdata viewfiles
924 global displayorder parentlist childlist rowidlist rowoffsets
925 global colormap rowtextx commitrow
926 global numcommits rowrangelist commitlisted idrowranges
927 global selectedline currentid canv canvy0
928 global matchinglines treediffs
930 global pending_select phase
931 global commitidx rowlaidout rowoptim linesegends leftover
932 global commfd nextupdate
934 if {$n == $curview} return
936 if {[info exists selectedline]} {
938 set y [yc $selectedline]
939 set ymax [lindex [$canv cget -scrollregion] 3]
940 set span [$canv yview]
941 set ytop [expr {[lindex $span 0] * $ymax}]
942 set ybot [expr {[lindex $span 1] * $ymax}]
943 if {$ytop < $y && $y < $ybot} {
944 set yscreen [expr {$y - $ytop}]
946 set yscreen [expr {($ybot - $ytop) / 2}]
954 set viewdata($curview) \
955 [list $phase $displayorder $parentlist $childlist $rowidlist \
956 $rowoffsets $rowrangelist $commitlisted \
957 [flatten children] [flatten idrowranges] \
959 $commitidx $rowlaidout $rowoptim $numcommits \
960 $linesegends $leftover $commfd]
961 fileevent $commfd readable {}
962 } elseif {![info exists viewdata($curview)]} {
963 set viewdata($curview) \
964 [list {} $displayorder $parentlist $childlist $rowidlist \
965 $rowoffsets $rowrangelist $commitlisted]
968 catch {unset matchinglines}
969 catch {unset treediffs}
973 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
975 if {![info exists viewdata($n)]} {
976 set args $parsed_args
977 if {$viewfiles($n) ne {}} {
978 set args [concat $args "--" $viewfiles($n)]
980 set pending_select $selid
986 set phase [lindex $v 0]
987 set displayorder [lindex $v 1]
988 set parentlist [lindex $v 2]
989 set childlist [lindex $v 3]
990 set rowidlist [lindex $v 4]
991 set rowoffsets [lindex $v 5]
992 set rowrangelist [lindex $v 6]
993 set commitlisted [lindex $v 7]
995 set numcommits [llength $displayorder]
996 catch {unset idrowranges}
997 catch {unset children}
999 unflatten children [lindex $v 8]
1000 unflatten idrowranges [lindex $v 9]
1001 unflatten idinlist [lindex $v 10]
1002 set commitidx [lindex $v 11]
1003 set rowlaidout [lindex $v 12]
1004 set rowoptim [lindex $v 13]
1005 set numcommits [lindex $v 14]
1006 set linesegends [lindex $v 15]
1007 set leftover [lindex $v 16]
1008 set commfd [lindex $v 17]
1009 fileevent $commfd readable [list getcommitlines $commfd]
1010 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1013 catch {unset colormap}
1014 catch {unset rowtextx}
1015 catch {unset commitrow}
1018 foreach id $displayorder {
1019 set commitrow($id) $row
1025 if {$selid ne {} && [info exists commitrow($selid)]} {
1026 set row $commitrow($selid)
1027 # try to get the selected row in the same position on the screen
1028 set ymax [lindex [$canv cget -scrollregion] 3]
1029 set ytop [expr {[yc $row] - $yscreen}]
1033 set yf [expr {$ytop * 1.0 / $ymax}]
1035 allcanvs yview moveto $yf
1040 proc shortids {ids} {
1043 if {[llength $id] > 1} {
1044 lappend res [shortids $id]
1045 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1046 lappend res [string range $id 0 7]
1054 proc incrange {l x o} {
1057 set e [lindex $l $x]
1059 lset l $x [expr {$e + $o}]
1068 for {} {$n > 0} {incr n -1} {
1074 proc usedinrange {id l1 l2} {
1075 global children commitrow childlist
1077 if {[info exists commitrow($id)]} {
1078 set r $commitrow($id)
1079 if {$l1 <= $r && $r <= $l2} {
1080 return [expr {$r - $l1 + 1}]
1082 set kids [lindex $childlist $r]
1084 set kids $children($id)
1087 set r $commitrow($c)
1088 if {$l1 <= $r && $r <= $l2} {
1089 return [expr {$r - $l1 + 1}]
1095 proc sanity {row {full 0}} {
1096 global rowidlist rowoffsets
1099 set ids [lindex $rowidlist $row]
1102 if {$id eq {}} continue
1103 if {$col < [llength $ids] - 1 &&
1104 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1105 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1107 set o [lindex $rowoffsets $row $col]
1113 if {[lindex $rowidlist $y $x] != $id} {
1114 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1115 puts " id=[shortids $id] check started at row $row"
1116 for {set i $row} {$i >= $y} {incr i -1} {
1117 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1122 set o [lindex $rowoffsets $y $x]
1127 proc makeuparrow {oid x y z} {
1128 global rowidlist rowoffsets uparrowlen idrowranges
1130 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1133 set off0 [lindex $rowoffsets $y]
1134 for {set x0 $x} {1} {incr x0} {
1135 if {$x0 >= [llength $off0]} {
1136 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1139 set z [lindex $off0 $x0]
1145 set z [expr {$x0 - $x}]
1146 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1147 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1149 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1150 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1151 lappend idrowranges($oid) $y
1154 proc initlayout {} {
1155 global rowidlist rowoffsets displayorder commitlisted
1156 global rowlaidout rowoptim
1157 global idinlist rowchk rowrangelist idrowranges
1158 global commitidx numcommits canvxmax canv
1160 global parentlist childlist children
1161 global colormap rowtextx commitrow
1171 catch {unset children}
1175 catch {unset idinlist}
1176 catch {unset rowchk}
1179 set canvxmax [$canv cget -width]
1180 catch {unset colormap}
1181 catch {unset rowtextx}
1182 catch {unset commitrow}
1183 catch {unset idrowranges}
1187 proc setcanvscroll {} {
1188 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1190 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1191 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1192 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1193 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1196 proc visiblerows {} {
1197 global canv numcommits linespc
1199 set ymax [lindex [$canv cget -scrollregion] 3]
1200 if {$ymax eq {} || $ymax == 0} return
1202 set y0 [expr {int([lindex $f 0] * $ymax)}]
1203 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1207 set y1 [expr {int([lindex $f 1] * $ymax)}]
1208 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1209 if {$r1 >= $numcommits} {
1210 set r1 [expr {$numcommits - 1}]
1212 return [list $r0 $r1]
1215 proc layoutmore {} {
1216 global rowlaidout rowoptim commitidx numcommits optim_delay
1220 set rowlaidout [layoutrows $row $commitidx 0]
1221 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1222 if {$orow > $rowoptim} {
1223 optimize_rows $rowoptim 0 $orow
1226 set canshow [expr {$rowoptim - $optim_delay}]
1227 if {$canshow > $numcommits} {
1232 proc showstuff {canshow} {
1233 global numcommits commitrow pending_select selectedline
1234 global linesegends idrowranges idrangedrawn
1236 if {$numcommits == 0} {
1238 set phase "incrdraw"
1242 set numcommits $canshow
1244 set rows [visiblerows]
1245 set r0 [lindex $rows 0]
1246 set r1 [lindex $rows 1]
1248 for {set r $row} {$r < $canshow} {incr r} {
1249 foreach id [lindex $linesegends [expr {$r+1}]] {
1251 foreach {s e} [rowranges $id] {
1253 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1254 && ![info exists idrangedrawn($id,$i)]} {
1256 set idrangedrawn($id,$i) 1
1261 if {$canshow > $r1} {
1264 while {$row < $canshow} {
1268 if {[info exists pending_select] &&
1269 [info exists commitrow($pending_select)] &&
1270 $commitrow($pending_select) < $numcommits} {
1271 selectline $commitrow($pending_select) 1
1273 if {![info exists selectedline] && ![info exists pending_select]} {
1278 proc layoutrows {row endrow last} {
1279 global rowidlist rowoffsets displayorder
1280 global uparrowlen downarrowlen maxwidth mingaplen
1281 global childlist parentlist
1282 global idrowranges linesegends
1284 global idinlist rowchk rowrangelist
1286 set idlist [lindex $rowidlist $row]
1287 set offs [lindex $rowoffsets $row]
1288 while {$row < $endrow} {
1289 set id [lindex $displayorder $row]
1292 foreach p [lindex $parentlist $row] {
1293 if {![info exists idinlist($p)]} {
1295 } elseif {!$idinlist($p)} {
1300 set nev [expr {[llength $idlist] + [llength $newolds]
1301 + [llength $oldolds] - $maxwidth + 1}]
1303 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1304 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1305 set i [lindex $idlist $x]
1306 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1307 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1308 [expr {$row + $uparrowlen + $mingaplen}]]
1310 set idlist [lreplace $idlist $x $x]
1311 set offs [lreplace $offs $x $x]
1312 set offs [incrange $offs $x 1]
1314 set rm1 [expr {$row - 1}]
1316 lappend idrowranges($i) $rm1
1317 if {[incr nev -1] <= 0} break
1320 set rowchk($id) [expr {$row + $r}]
1323 lset rowidlist $row $idlist
1324 lset rowoffsets $row $offs
1326 lappend linesegends $lse
1327 set col [lsearch -exact $idlist $id]
1329 set col [llength $idlist]
1331 lset rowidlist $row $idlist
1333 if {[lindex $childlist $row] ne {}} {
1334 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1338 lset rowoffsets $row $offs
1340 makeuparrow $id $col $row $z
1346 if {[info exists idrowranges($id)]} {
1347 set ranges $idrowranges($id)
1349 unset idrowranges($id)
1351 lappend rowrangelist $ranges
1353 set offs [ntimes [llength $idlist] 0]
1354 set l [llength $newolds]
1355 set idlist [eval lreplace \$idlist $col $col $newolds]
1358 set offs [lrange $offs 0 [expr {$col - 1}]]
1359 foreach x $newolds {
1364 set tmp [expr {[llength $idlist] - [llength $offs]}]
1366 set offs [concat $offs [ntimes $tmp $o]]
1371 foreach i $newolds {
1373 set idrowranges($i) $row
1376 foreach oid $oldolds {
1377 set idinlist($oid) 1
1378 set idlist [linsert $idlist $col $oid]
1379 set offs [linsert $offs $col $o]
1380 makeuparrow $oid $col $row $o
1383 lappend rowidlist $idlist
1384 lappend rowoffsets $offs
1389 proc addextraid {id row} {
1390 global displayorder commitrow commitinfo
1392 global parentlist childlist children
1395 lappend displayorder $id
1396 lappend parentlist {}
1397 set commitrow($id) $row
1399 if {![info exists commitinfo($id)]} {
1400 set commitinfo($id) {"No commit information available"}
1402 if {[info exists children($id)]} {
1403 lappend childlist $children($id)
1406 lappend childlist {}
1410 proc layouttail {} {
1411 global rowidlist rowoffsets idinlist commitidx
1412 global idrowranges rowrangelist
1415 set idlist [lindex $rowidlist $row]
1416 while {$idlist ne {}} {
1417 set col [expr {[llength $idlist] - 1}]
1418 set id [lindex $idlist $col]
1421 lappend idrowranges($id) $row
1422 lappend rowrangelist $idrowranges($id)
1423 unset idrowranges($id)
1425 set offs [ntimes $col 0]
1426 set idlist [lreplace $idlist $col $col]
1427 lappend rowidlist $idlist
1428 lappend rowoffsets $offs
1431 foreach id [array names idinlist] {
1433 lset rowidlist $row [list $id]
1434 lset rowoffsets $row 0
1435 makeuparrow $id 0 $row 0
1436 lappend idrowranges($id) $row
1437 lappend rowrangelist $idrowranges($id)
1438 unset idrowranges($id)
1440 lappend rowidlist {}
1441 lappend rowoffsets {}
1445 proc insert_pad {row col npad} {
1446 global rowidlist rowoffsets
1448 set pad [ntimes $npad {}]
1449 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1450 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1451 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1454 proc optimize_rows {row col endrow} {
1455 global rowidlist rowoffsets idrowranges displayorder
1457 for {} {$row < $endrow} {incr row} {
1458 set idlist [lindex $rowidlist $row]
1459 set offs [lindex $rowoffsets $row]
1461 for {} {$col < [llength $offs]} {incr col} {
1462 if {[lindex $idlist $col] eq {}} {
1466 set z [lindex $offs $col]
1467 if {$z eq {}} continue
1469 set x0 [expr {$col + $z}]
1470 set y0 [expr {$row - 1}]
1471 set z0 [lindex $rowoffsets $y0 $x0]
1473 set id [lindex $idlist $col]
1474 set ranges [rowranges $id]
1475 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1479 if {$z < -1 || ($z < 0 && $isarrow)} {
1480 set npad [expr {-1 - $z + $isarrow}]
1481 set offs [incrange $offs $col $npad]
1482 insert_pad $y0 $x0 $npad
1484 optimize_rows $y0 $x0 $row
1486 set z [lindex $offs $col]
1487 set x0 [expr {$col + $z}]
1488 set z0 [lindex $rowoffsets $y0 $x0]
1489 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1490 set npad [expr {$z - 1 + $isarrow}]
1491 set y1 [expr {$row + 1}]
1492 set offs2 [lindex $rowoffsets $y1]
1496 if {$z eq {} || $x1 + $z < $col} continue
1497 if {$x1 + $z > $col} {
1500 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1503 set pad [ntimes $npad {}]
1504 set idlist [eval linsert \$idlist $col $pad]
1505 set tmp [eval linsert \$offs $col $pad]
1507 set offs [incrange $tmp $col [expr {-$npad}]]
1508 set z [lindex $offs $col]
1511 if {$z0 eq {} && !$isarrow} {
1512 # this line links to its first child on row $row-2
1513 set rm2 [expr {$row - 2}]
1514 set id [lindex $displayorder $rm2]
1515 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1517 set z0 [expr {$xc - $x0}]
1520 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1521 insert_pad $y0 $x0 1
1522 set offs [incrange $offs $col 1]
1523 optimize_rows $y0 [expr {$x0 + 1}] $row
1528 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1529 set o [lindex $offs $col]
1531 # check if this is the link to the first child
1532 set id [lindex $idlist $col]
1533 set ranges [rowranges $id]
1534 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1535 # it is, work out offset to child
1536 set y0 [expr {$row - 1}]
1537 set id [lindex $displayorder $y0]
1538 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1540 set o [expr {$x0 - $col}]
1544 if {$o eq {} || $o <= 0} break
1546 if {$o ne {} && [incr col] < [llength $idlist]} {
1547 set y1 [expr {$row + 1}]
1548 set offs2 [lindex $rowoffsets $y1]
1552 if {$z eq {} || $x1 + $z < $col} continue
1553 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1556 set idlist [linsert $idlist $col {}]
1557 set tmp [linsert $offs $col {}]
1559 set offs [incrange $tmp $col -1]
1562 lset rowidlist $row $idlist
1563 lset rowoffsets $row $offs
1569 global canvx0 linespc
1570 return [expr {$canvx0 + $col * $linespc}]
1574 global canvy0 linespc
1575 return [expr {$canvy0 + $row * $linespc}]
1578 proc linewidth {id} {
1579 global thickerline lthickness
1582 if {[info exists thickerline] && $id eq $thickerline} {
1583 set wid [expr {2 * $lthickness}]
1588 proc rowranges {id} {
1589 global phase idrowranges commitrow rowlaidout rowrangelist
1593 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1594 set ranges [lindex $rowrangelist $commitrow($id)]
1595 } elseif {[info exists idrowranges($id)]} {
1596 set ranges $idrowranges($id)
1601 proc drawlineseg {id i} {
1602 global rowoffsets rowidlist
1604 global canv colormap linespc
1605 global numcommits commitrow
1607 set ranges [rowranges $id]
1609 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1610 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1614 set startrow [lindex $ranges [expr {2 * $i}]]
1615 set row [lindex $ranges [expr {2 * $i + 1}]]
1616 if {$startrow == $row} return
1619 set col [lsearch -exact [lindex $rowidlist $row] $id]
1621 puts "oops: drawline: id $id not on row $row"
1627 set o [lindex $rowoffsets $row $col]
1630 # changing direction
1631 set x [xc $row $col]
1633 lappend coords $x $y
1639 set x [xc $row $col]
1641 lappend coords $x $y
1643 # draw the link to the first child as part of this line
1645 set child [lindex $displayorder $row]
1646 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1648 set x [xc $row $ccol]
1650 if {$ccol < $col - 1} {
1651 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1652 } elseif {$ccol > $col + 1} {
1653 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1655 lappend coords $x $y
1658 if {[llength $coords] < 4} return
1660 # This line has an arrow at the lower end: check if the arrow is
1661 # on a diagonal segment, and if so, work around the Tk 8.4
1662 # refusal to draw arrows on diagonal lines.
1663 set x0 [lindex $coords 0]
1664 set x1 [lindex $coords 2]
1666 set y0 [lindex $coords 1]
1667 set y1 [lindex $coords 3]
1668 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1669 # we have a nearby vertical segment, just trim off the diag bit
1670 set coords [lrange $coords 2 end]
1672 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1673 set xi [expr {$x0 - $slope * $linespc / 2}]
1674 set yi [expr {$y0 - $linespc / 2}]
1675 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1679 set arrow [expr {2 * ($i > 0) + $downarrow}]
1680 set arrow [lindex {none first last both} $arrow]
1681 set t [$canv create line $coords -width [linewidth $id] \
1682 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1687 proc drawparentlinks {id row col olds} {
1688 global rowidlist canv colormap
1690 set row2 [expr {$row + 1}]
1691 set x [xc $row $col]
1694 set ids [lindex $rowidlist $row2]
1695 # rmx = right-most X coord used
1698 set i [lsearch -exact $ids $p]
1700 puts "oops, parent $p of $id not in list"
1703 set x2 [xc $row2 $i]
1707 set ranges [rowranges $p]
1708 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1709 && $row2 < [lindex $ranges 1]} {
1710 # drawlineseg will do this one for us
1714 # should handle duplicated parents here...
1715 set coords [list $x $y]
1716 if {$i < $col - 1} {
1717 lappend coords [xc $row [expr {$i + 1}]] $y
1718 } elseif {$i > $col + 1} {
1719 lappend coords [xc $row [expr {$i - 1}]] $y
1721 lappend coords $x2 $y2
1722 set t [$canv create line $coords -width [linewidth $p] \
1723 -fill $colormap($p) -tags lines.$p]
1730 proc drawlines {id} {
1731 global colormap canv
1733 global childlist iddrawn commitrow rowidlist
1735 $canv delete lines.$id
1736 set nr [expr {[llength [rowranges $id]] / 2}]
1737 for {set i 0} {$i < $nr} {incr i} {
1738 if {[info exists idrangedrawn($id,$i)]} {
1742 foreach child [lindex $childlist $commitrow($id)] {
1743 if {[info exists iddrawn($child)]} {
1744 set row $commitrow($child)
1745 set col [lsearch -exact [lindex $rowidlist $row] $child]
1747 drawparentlinks $child $row $col [list $id]
1753 proc drawcmittext {id row col rmx} {
1754 global linespc canv canv2 canv3 canvy0
1755 global commitlisted commitinfo rowidlist
1756 global rowtextx idpos idtags idheads idotherrefs
1757 global linehtag linentag linedtag
1758 global mainfont namefont canvxmax
1760 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1761 set x [xc $row $col]
1763 set orad [expr {$linespc / 3}]
1764 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1765 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1766 -fill $ofill -outline black -width 1]
1768 $canv bind $t <1> {selcanvline {} %x %y}
1769 set xt [xc $row [llength [lindex $rowidlist $row]]]
1773 set rowtextx($row) $xt
1774 set idpos($id) [list $x $xt $y]
1775 if {[info exists idtags($id)] || [info exists idheads($id)]
1776 || [info exists idotherrefs($id)]} {
1777 set xt [drawtags $id $x $xt $y]
1779 set headline [lindex $commitinfo($id) 0]
1780 set name [lindex $commitinfo($id) 1]
1781 set date [lindex $commitinfo($id) 2]
1782 set date [formatdate $date]
1783 set linehtag($row) [$canv create text $xt $y -anchor w \
1784 -text $headline -font $mainfont ]
1785 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1786 set linentag($row) [$canv2 create text 3 $y -anchor w \
1787 -text $name -font $namefont]
1788 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1789 -text $date -font $mainfont]
1790 set xr [expr {$xt + [font measure $mainfont $headline]}]
1791 if {$xr > $canvxmax} {
1797 proc drawcmitrow {row} {
1798 global displayorder rowidlist
1799 global idrangedrawn iddrawn
1800 global commitinfo commitlisted parentlist numcommits
1802 if {$row >= $numcommits} return
1803 foreach id [lindex $rowidlist $row] {
1804 if {$id eq {}} continue
1806 foreach {s e} [rowranges $id] {
1808 if {$row < $s} continue
1811 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1813 set idrangedrawn($id,$i) 1
1820 set id [lindex $displayorder $row]
1821 if {[info exists iddrawn($id)]} return
1822 set col [lsearch -exact [lindex $rowidlist $row] $id]
1824 puts "oops, row $row id $id not in list"
1827 if {![info exists commitinfo($id)]} {
1831 set olds [lindex $parentlist $row]
1833 set rmx [drawparentlinks $id $row $col $olds]
1837 drawcmittext $id $row $col $rmx
1841 proc drawfrac {f0 f1} {
1842 global numcommits canv
1845 set ymax [lindex [$canv cget -scrollregion] 3]
1846 if {$ymax eq {} || $ymax == 0} return
1847 set y0 [expr {int($f0 * $ymax)}]
1848 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1852 set y1 [expr {int($f1 * $ymax)}]
1853 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1854 if {$endrow >= $numcommits} {
1855 set endrow [expr {$numcommits - 1}]
1857 for {} {$row <= $endrow} {incr row} {
1862 proc drawvisible {} {
1864 eval drawfrac [$canv yview]
1867 proc clear_display {} {
1868 global iddrawn idrangedrawn
1871 catch {unset iddrawn}
1872 catch {unset idrangedrawn}
1875 proc findcrossings {id} {
1876 global rowidlist parentlist numcommits rowoffsets displayorder
1880 foreach {s e} [rowranges $id] {
1881 if {$e >= $numcommits} {
1882 set e [expr {$numcommits - 1}]
1884 if {$e <= $s} continue
1885 set x [lsearch -exact [lindex $rowidlist $e] $id]
1887 puts "findcrossings: oops, no [shortids $id] in row $e"
1890 for {set row $e} {[incr row -1] >= $s} {} {
1891 set olds [lindex $parentlist $row]
1892 set kid [lindex $displayorder $row]
1893 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1894 if {$kidx < 0} continue
1895 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1897 set px [lsearch -exact $nextrow $p]
1898 if {$px < 0} continue
1899 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1900 if {[lsearch -exact $ccross $p] >= 0} continue
1901 if {$x == $px + ($kidx < $px? -1: 1)} {
1903 } elseif {[lsearch -exact $cross $p] < 0} {
1908 set inc [lindex $rowoffsets $row $x]
1909 if {$inc eq {}} break
1913 return [concat $ccross {{}} $cross]
1916 proc assigncolor {id} {
1917 global colormap colors nextcolor
1918 global commitrow parentlist children childlist
1920 if {[info exists colormap($id)]} return
1921 set ncolors [llength $colors]
1922 if {[info exists commitrow($id)]} {
1923 set kids [lindex $childlist $commitrow($id)]
1924 } elseif {[info exists children($id)]} {
1925 set kids $children($id)
1929 if {[llength $kids] == 1} {
1930 set child [lindex $kids 0]
1931 if {[info exists colormap($child)]
1932 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1933 set colormap($id) $colormap($child)
1939 foreach x [findcrossings $id] {
1941 # delimiter between corner crossings and other crossings
1942 if {[llength $badcolors] >= $ncolors - 1} break
1943 set origbad $badcolors
1945 if {[info exists colormap($x)]
1946 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1947 lappend badcolors $colormap($x)
1950 if {[llength $badcolors] >= $ncolors} {
1951 set badcolors $origbad
1953 set origbad $badcolors
1954 if {[llength $badcolors] < $ncolors - 1} {
1955 foreach child $kids {
1956 if {[info exists colormap($child)]
1957 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1958 lappend badcolors $colormap($child)
1960 foreach p [lindex $parentlist $commitrow($child)] {
1961 if {[info exists colormap($p)]
1962 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1963 lappend badcolors $colormap($p)
1967 if {[llength $badcolors] >= $ncolors} {
1968 set badcolors $origbad
1971 for {set i 0} {$i <= $ncolors} {incr i} {
1972 set c [lindex $colors $nextcolor]
1973 if {[incr nextcolor] >= $ncolors} {
1976 if {[lsearch -exact $badcolors $c]} break
1978 set colormap($id) $c
1981 proc bindline {t id} {
1984 $canv bind $t <Enter> "lineenter %x %y $id"
1985 $canv bind $t <Motion> "linemotion %x %y $id"
1986 $canv bind $t <Leave> "lineleave $id"
1987 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1990 proc drawtags {id x xt y1} {
1991 global idtags idheads idotherrefs
1992 global linespc lthickness
1993 global canv mainfont commitrow rowtextx
1998 if {[info exists idtags($id)]} {
1999 set marks $idtags($id)
2000 set ntags [llength $marks]
2002 if {[info exists idheads($id)]} {
2003 set marks [concat $marks $idheads($id)]
2004 set nheads [llength $idheads($id)]
2006 if {[info exists idotherrefs($id)]} {
2007 set marks [concat $marks $idotherrefs($id)]
2013 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2014 set yt [expr {$y1 - 0.5 * $linespc}]
2015 set yb [expr {$yt + $linespc - 1}]
2018 foreach tag $marks {
2019 set wid [font measure $mainfont $tag]
2022 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2024 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2025 -width $lthickness -fill black -tags tag.$id]
2027 foreach tag $marks x $xvals wid $wvals {
2028 set xl [expr {$x + $delta}]
2029 set xr [expr {$x + $delta + $wid + $lthickness}]
2030 if {[incr ntags -1] >= 0} {
2032 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2033 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2034 -width 1 -outline black -fill yellow -tags tag.$id]
2035 $canv bind $t <1> [list showtag $tag 1]
2036 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2038 # draw a head or other ref
2039 if {[incr nheads -1] >= 0} {
2044 set xl [expr {$xl - $delta/2}]
2045 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2046 -width 1 -outline black -fill $col -tags tag.$id
2048 set t [$canv create text $xl $y1 -anchor w -text $tag \
2049 -font $mainfont -tags tag.$id]
2051 $canv bind $t <1> [list showtag $tag 1]
2057 proc xcoord {i level ln} {
2058 global canvx0 xspc1 xspc2
2060 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2061 if {$i > 0 && $i == $level} {
2062 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2063 } elseif {$i > $level} {
2064 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2069 proc finishcommits {} {
2070 global commitidx phase
2071 global canv mainfont ctext maincursor textcursor
2072 global findinprogress pending_select
2074 if {$commitidx > 0} {
2078 $canv create text 3 3 -anchor nw -text "No commits selected" \
2079 -font $mainfont -tags textitems
2081 if {![info exists findinprogress]} {
2082 . config -cursor $maincursor
2083 settextcursor $textcursor
2086 catch {unset pending_select}
2089 # Don't change the text pane cursor if it is currently the hand cursor,
2090 # showing that we are over a sha1 ID link.
2091 proc settextcursor {c} {
2092 global ctext curtextcursor
2094 if {[$ctext cget -cursor] == $curtextcursor} {
2095 $ctext config -cursor $c
2097 set curtextcursor $c
2103 global canvy0 numcommits linespc
2104 global rowlaidout commitidx
2105 global pending_select
2108 layoutrows $rowlaidout $commitidx 1
2110 optimize_rows $row 0 $commitidx
2111 showstuff $commitidx
2112 if {[info exists pending_select]} {
2116 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2117 #puts "overall $drawmsecs ms for $numcommits commits"
2120 proc findmatches {f} {
2121 global findtype foundstring foundstrlen
2122 if {$findtype == "Regexp"} {
2123 set matches [regexp -indices -all -inline $foundstring $f]
2125 if {$findtype == "IgnCase"} {
2126 set str [string tolower $f]
2132 while {[set j [string first $foundstring $str $i]] >= 0} {
2133 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2134 set i [expr {$j + $foundstrlen}]
2141 global findtype findloc findstring markedmatches commitinfo
2142 global numcommits displayorder linehtag linentag linedtag
2143 global mainfont namefont canv canv2 canv3 selectedline
2144 global matchinglines foundstring foundstrlen matchstring
2150 set matchinglines {}
2151 if {$findloc == "Pickaxe"} {
2155 if {$findtype == "IgnCase"} {
2156 set foundstring [string tolower $findstring]
2158 set foundstring $findstring
2160 set foundstrlen [string length $findstring]
2161 if {$foundstrlen == 0} return
2162 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2163 set matchstring "*$matchstring*"
2164 if {$findloc == "Files"} {
2168 if {![info exists selectedline]} {
2171 set oldsel $selectedline
2174 set fldtypes {Headline Author Date Committer CDate Comment}
2176 foreach id $displayorder {
2177 set d $commitdata($id)
2179 if {$findtype == "Regexp"} {
2180 set doesmatch [regexp $foundstring $d]
2181 } elseif {$findtype == "IgnCase"} {
2182 set doesmatch [string match -nocase $matchstring $d]
2184 set doesmatch [string match $matchstring $d]
2186 if {!$doesmatch} continue
2187 if {![info exists commitinfo($id)]} {
2190 set info $commitinfo($id)
2192 foreach f $info ty $fldtypes {
2193 if {$findloc != "All fields" && $findloc != $ty} {
2196 set matches [findmatches $f]
2197 if {$matches == {}} continue
2199 if {$ty == "Headline"} {
2201 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2202 } elseif {$ty == "Author"} {
2204 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2205 } elseif {$ty == "Date"} {
2207 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2211 lappend matchinglines $l
2212 if {!$didsel && $l > $oldsel} {
2218 if {$matchinglines == {}} {
2220 } elseif {!$didsel} {
2221 findselectline [lindex $matchinglines 0]
2225 proc findselectline {l} {
2226 global findloc commentend ctext
2228 if {$findloc == "All fields" || $findloc == "Comments"} {
2229 # highlight the matches in the comments
2230 set f [$ctext get 1.0 $commentend]
2231 set matches [findmatches $f]
2232 foreach match $matches {
2233 set start [lindex $match 0]
2234 set end [expr {[lindex $match 1] + 1}]
2235 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2240 proc findnext {restart} {
2241 global matchinglines selectedline
2242 if {![info exists matchinglines]} {
2248 if {![info exists selectedline]} return
2249 foreach l $matchinglines {
2250 if {$l > $selectedline} {
2259 global matchinglines selectedline
2260 if {![info exists matchinglines]} {
2264 if {![info exists selectedline]} return
2266 foreach l $matchinglines {
2267 if {$l >= $selectedline} break
2271 findselectline $prev
2277 proc findlocchange {name ix op} {
2278 global findloc findtype findtypemenu
2279 if {$findloc == "Pickaxe"} {
2285 $findtypemenu entryconf 1 -state $state
2286 $findtypemenu entryconf 2 -state $state
2289 proc stopfindproc {{done 0}} {
2290 global findprocpid findprocfile findids
2291 global ctext findoldcursor phase maincursor textcursor
2292 global findinprogress
2294 catch {unset findids}
2295 if {[info exists findprocpid]} {
2297 catch {exec kill $findprocpid}
2299 catch {close $findprocfile}
2302 if {[info exists findinprogress]} {
2303 unset findinprogress
2304 if {$phase != "incrdraw"} {
2305 . config -cursor $maincursor
2306 settextcursor $textcursor
2311 proc findpatches {} {
2312 global findstring selectedline numcommits
2313 global findprocpid findprocfile
2314 global finddidsel ctext displayorder findinprogress
2315 global findinsertpos
2317 if {$numcommits == 0} return
2319 # make a list of all the ids to search, starting at the one
2320 # after the selected line (if any)
2321 if {[info exists selectedline]} {
2327 for {set i 0} {$i < $numcommits} {incr i} {
2328 if {[incr l] >= $numcommits} {
2331 append inputids [lindex $displayorder $l] "\n"
2335 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2338 error_popup "Error starting search process: $err"
2342 set findinsertpos end
2344 set findprocpid [pid $f]
2345 fconfigure $f -blocking 0
2346 fileevent $f readable readfindproc
2348 . config -cursor watch
2350 set findinprogress 1
2353 proc readfindproc {} {
2354 global findprocfile finddidsel
2355 global commitrow matchinglines findinsertpos
2357 set n [gets $findprocfile line]
2359 if {[eof $findprocfile]} {
2367 if {![regexp {^[0-9a-f]{40}} $line id]} {
2368 error_popup "Can't parse git-diff-tree output: $line"
2372 if {![info exists commitrow($id)]} {
2373 puts stderr "spurious id: $id"
2376 set l $commitrow($id)
2380 proc insertmatch {l id} {
2381 global matchinglines findinsertpos finddidsel
2383 if {$findinsertpos == "end"} {
2384 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2385 set matchinglines [linsert $matchinglines 0 $l]
2388 lappend matchinglines $l
2391 set matchinglines [linsert $matchinglines $findinsertpos $l]
2402 global selectedline numcommits displayorder ctext
2403 global ffileline finddidsel parentlist
2404 global findinprogress findstartline findinsertpos
2405 global treediffs fdiffid fdiffsneeded fdiffpos
2406 global findmergefiles
2408 if {$numcommits == 0} return
2410 if {[info exists selectedline]} {
2411 set l [expr {$selectedline + 1}]
2416 set findstartline $l
2420 set id [lindex $displayorder $l]
2421 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2422 if {![info exists treediffs($id)]} {
2423 append diffsneeded "$id\n"
2424 lappend fdiffsneeded $id
2427 if {[incr l] >= $numcommits} {
2430 if {$l == $findstartline} break
2433 # start off a git-diff-tree process if needed
2434 if {$diffsneeded ne {}} {
2436 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2438 error_popup "Error starting search process: $err"
2441 catch {unset fdiffid}
2443 fconfigure $df -blocking 0
2444 fileevent $df readable [list readfilediffs $df]
2448 set findinsertpos end
2449 set id [lindex $displayorder $l]
2450 . config -cursor watch
2452 set findinprogress 1
2457 proc readfilediffs {df} {
2458 global findid fdiffid fdiffs
2460 set n [gets $df line]
2464 if {[catch {close $df} err]} {
2467 error_popup "Error in git-diff-tree: $err"
2468 } elseif {[info exists findid]} {
2472 error_popup "Couldn't find diffs for $id"
2477 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2478 # start of a new string of diffs
2482 } elseif {[string match ":*" $line]} {
2483 lappend fdiffs [lindex $line 5]
2487 proc donefilediff {} {
2488 global fdiffid fdiffs treediffs findid
2489 global fdiffsneeded fdiffpos
2491 if {[info exists fdiffid]} {
2492 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2493 && $fdiffpos < [llength $fdiffsneeded]} {
2494 # git-diff-tree doesn't output anything for a commit
2495 # which doesn't change anything
2496 set nullid [lindex $fdiffsneeded $fdiffpos]
2497 set treediffs($nullid) {}
2498 if {[info exists findid] && $nullid eq $findid} {
2506 if {![info exists treediffs($fdiffid)]} {
2507 set treediffs($fdiffid) $fdiffs
2509 if {[info exists findid] && $fdiffid eq $findid} {
2517 global findid treediffs parentlist
2518 global ffileline findstartline finddidsel
2519 global displayorder numcommits matchinglines findinprogress
2520 global findmergefiles
2524 set id [lindex $displayorder $l]
2525 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2526 if {![info exists treediffs($id)]} {
2532 foreach f $treediffs($id) {
2533 set x [findmatches $f]
2543 if {[incr l] >= $numcommits} {
2546 if {$l == $findstartline} break
2554 # mark a commit as matching by putting a yellow background
2555 # behind the headline
2556 proc markheadline {l id} {
2557 global canv mainfont linehtag
2560 set bbox [$canv bbox $linehtag($l)]
2561 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2565 # mark the bits of a headline, author or date that match a find string
2566 proc markmatches {canv l str tag matches font} {
2567 set bbox [$canv bbox $tag]
2568 set x0 [lindex $bbox 0]
2569 set y0 [lindex $bbox 1]
2570 set y1 [lindex $bbox 3]
2571 foreach match $matches {
2572 set start [lindex $match 0]
2573 set end [lindex $match 1]
2574 if {$start > $end} continue
2575 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2576 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2577 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2578 [expr {$x0+$xlen+2}] $y1 \
2579 -outline {} -tags matches -fill yellow]
2584 proc unmarkmatches {} {
2585 global matchinglines findids
2586 allcanvs delete matches
2587 catch {unset matchinglines}
2588 catch {unset findids}
2591 proc selcanvline {w x y} {
2592 global canv canvy0 ctext linespc
2594 set ymax [lindex [$canv cget -scrollregion] 3]
2595 if {$ymax == {}} return
2596 set yfrac [lindex [$canv yview] 0]
2597 set y [expr {$y + $yfrac * $ymax}]
2598 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2603 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2609 proc commit_descriptor {p} {
2612 if {[info exists commitinfo($p)]} {
2613 set l [lindex $commitinfo($p) 0]
2618 # append some text to the ctext widget, and make any SHA1 ID
2619 # that we know about be a clickable link.
2620 proc appendwithlinks {text} {
2621 global ctext commitrow linknum
2623 set start [$ctext index "end - 1c"]
2624 $ctext insert end $text
2625 $ctext insert end "\n"
2626 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2630 set linkid [string range $text $s $e]
2631 if {![info exists commitrow($linkid)]} continue
2633 $ctext tag add link "$start + $s c" "$start + $e c"
2634 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2635 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2638 $ctext tag conf link -foreground blue -underline 1
2639 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2640 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2643 proc viewnextline {dir} {
2647 set ymax [lindex [$canv cget -scrollregion] 3]
2648 set wnow [$canv yview]
2649 set wtop [expr {[lindex $wnow 0] * $ymax}]
2650 set newtop [expr {$wtop + $dir * $linespc}]
2653 } elseif {$newtop > $ymax} {
2656 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2659 proc selectline {l isnew} {
2660 global canv canv2 canv3 ctext commitinfo selectedline
2661 global displayorder linehtag linentag linedtag
2662 global canvy0 linespc parentlist childlist
2663 global cflist currentid sha1entry
2664 global commentend idtags linknum
2665 global mergemax numcommits pending_select
2667 catch {unset pending_select}
2670 if {$l < 0 || $l >= $numcommits} return
2671 set y [expr {$canvy0 + $l * $linespc}]
2672 set ymax [lindex [$canv cget -scrollregion] 3]
2673 set ytop [expr {$y - $linespc - 1}]
2674 set ybot [expr {$y + $linespc + 1}]
2675 set wnow [$canv yview]
2676 set wtop [expr {[lindex $wnow 0] * $ymax}]
2677 set wbot [expr {[lindex $wnow 1] * $ymax}]
2678 set wh [expr {$wbot - $wtop}]
2680 if {$ytop < $wtop} {
2681 if {$ybot < $wtop} {
2682 set newtop [expr {$y - $wh / 2.0}]
2685 if {$newtop > $wtop - $linespc} {
2686 set newtop [expr {$wtop - $linespc}]
2689 } elseif {$ybot > $wbot} {
2690 if {$ytop > $wbot} {
2691 set newtop [expr {$y - $wh / 2.0}]
2693 set newtop [expr {$ybot - $wh}]
2694 if {$newtop < $wtop + $linespc} {
2695 set newtop [expr {$wtop + $linespc}]
2699 if {$newtop != $wtop} {
2703 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2707 if {![info exists linehtag($l)]} return
2709 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2710 -tags secsel -fill [$canv cget -selectbackground]]
2712 $canv2 delete secsel
2713 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2714 -tags secsel -fill [$canv2 cget -selectbackground]]
2716 $canv3 delete secsel
2717 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2718 -tags secsel -fill [$canv3 cget -selectbackground]]
2722 addtohistory [list selectline $l 0]
2727 set id [lindex $displayorder $l]
2729 $sha1entry delete 0 end
2730 $sha1entry insert 0 $id
2731 $sha1entry selection from 0
2732 $sha1entry selection to end
2734 $ctext conf -state normal
2735 $ctext delete 0.0 end
2737 $ctext mark set fmark.0 0.0
2738 $ctext mark gravity fmark.0 left
2739 set info $commitinfo($id)
2740 set date [formatdate [lindex $info 2]]
2741 $ctext insert end "Author: [lindex $info 1] $date\n"
2742 set date [formatdate [lindex $info 4]]
2743 $ctext insert end "Committer: [lindex $info 3] $date\n"
2744 if {[info exists idtags($id)]} {
2745 $ctext insert end "Tags:"
2746 foreach tag $idtags($id) {
2747 $ctext insert end " $tag"
2749 $ctext insert end "\n"
2753 set olds [lindex $parentlist $l]
2754 if {[llength $olds] > 1} {
2757 if {$np >= $mergemax} {
2762 $ctext insert end "Parent: " $tag
2763 appendwithlinks [commit_descriptor $p]
2768 append comment "Parent: [commit_descriptor $p]\n"
2772 foreach c [lindex $childlist $l] {
2773 append comment "Child: [commit_descriptor $c]\n"
2776 append comment [lindex $info 5]
2778 # make anything that looks like a SHA1 ID be a clickable link
2779 appendwithlinks $comment
2781 $ctext tag delete Comments
2782 $ctext tag remove found 1.0 end
2783 $ctext conf -state disabled
2784 set commentend [$ctext index "end - 1c"]
2786 $cflist delete 0 end
2787 $cflist insert end "Comments"
2788 if {[llength $olds] <= 1} {
2795 proc selfirstline {} {
2800 proc sellastline {} {
2803 set l [expr {$numcommits - 1}]
2807 proc selnextline {dir} {
2809 if {![info exists selectedline]} return
2810 set l [expr {$selectedline + $dir}]
2815 proc selnextpage {dir} {
2816 global canv linespc selectedline numcommits
2818 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2822 allcanvs yview scroll [expr {$dir * $lpp}] units
2823 if {![info exists selectedline]} return
2824 set l [expr {$selectedline + $dir * $lpp}]
2827 } elseif {$l >= $numcommits} {
2828 set l [expr $numcommits - 1]
2834 proc unselectline {} {
2835 global selectedline currentid
2837 catch {unset selectedline}
2838 catch {unset currentid}
2839 allcanvs delete secsel
2842 proc addtohistory {cmd} {
2843 global history historyindex
2845 if {$historyindex > 0
2846 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2850 if {$historyindex < [llength $history]} {
2851 set history [lreplace $history $historyindex end $cmd]
2853 lappend history $cmd
2856 if {$historyindex > 1} {
2857 .ctop.top.bar.leftbut conf -state normal
2859 .ctop.top.bar.leftbut conf -state disabled
2861 .ctop.top.bar.rightbut conf -state disabled
2865 global history historyindex
2867 if {$historyindex > 1} {
2868 incr historyindex -1
2869 set cmd [lindex $history [expr {$historyindex - 1}]]
2871 .ctop.top.bar.rightbut conf -state normal
2873 if {$historyindex <= 1} {
2874 .ctop.top.bar.leftbut conf -state disabled
2879 global history historyindex
2881 if {$historyindex < [llength $history]} {
2882 set cmd [lindex $history $historyindex]
2885 .ctop.top.bar.leftbut conf -state normal
2887 if {$historyindex >= [llength $history]} {
2888 .ctop.top.bar.rightbut conf -state disabled
2892 proc mergediff {id l} {
2893 global diffmergeid diffopts mdifffd
2894 global difffilestart diffids
2899 catch {unset difffilestart}
2900 # this doesn't seem to actually affect anything...
2901 set env(GIT_DIFF_OPTS) $diffopts
2902 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2903 if {[catch {set mdf [open $cmd r]} err]} {
2904 error_popup "Error getting merge diffs: $err"
2907 fconfigure $mdf -blocking 0
2908 set mdifffd($id) $mdf
2909 set np [llength [lindex $parentlist $l]]
2910 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2911 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2914 proc getmergediffline {mdf id np} {
2915 global diffmergeid ctext cflist nextupdate mergemax
2916 global difffilestart mdifffd
2918 set n [gets $mdf line]
2925 if {![info exists diffmergeid] || $id != $diffmergeid
2926 || $mdf != $mdifffd($id)} {
2929 $ctext conf -state normal
2930 if {[regexp {^diff --cc (.*)} $line match fname]} {
2931 # start of a new file
2932 $ctext insert end "\n"
2933 set here [$ctext index "end - 1c"]
2934 set i [$cflist index end]
2935 $ctext mark set fmark.$i $here
2936 $ctext mark gravity fmark.$i left
2937 set difffilestart([expr {$i-1}]) $here
2938 $cflist insert end $fname
2939 set l [expr {(78 - [string length $fname]) / 2}]
2940 set pad [string range "----------------------------------------" 1 $l]
2941 $ctext insert end "$pad $fname $pad\n" filesep
2942 } elseif {[regexp {^@@} $line]} {
2943 $ctext insert end "$line\n" hunksep
2944 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2947 # parse the prefix - one ' ', '-' or '+' for each parent
2952 for {set j 0} {$j < $np} {incr j} {
2953 set c [string range $line $j $j]
2956 } elseif {$c == "-"} {
2958 } elseif {$c == "+"} {
2967 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2968 # line doesn't appear in result, parents in $minuses have the line
2969 set num [lindex $minuses 0]
2970 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2971 # line appears in result, parents in $pluses don't have the line
2972 lappend tags mresult
2973 set num [lindex $spaces 0]
2976 if {$num >= $mergemax} {
2981 $ctext insert end "$line\n" $tags
2983 $ctext conf -state disabled
2984 if {[clock clicks -milliseconds] >= $nextupdate} {
2986 fileevent $mdf readable {}
2988 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2992 proc startdiff {ids} {
2993 global treediffs diffids treepending diffmergeid
2996 catch {unset diffmergeid}
2997 if {![info exists treediffs($ids)]} {
2998 if {![info exists treepending]} {
3006 proc addtocflist {ids} {
3007 global treediffs cflist
3008 foreach f $treediffs($ids) {
3009 $cflist insert end $f
3014 proc gettreediffs {ids} {
3015 global treediff treepending
3016 set treepending $ids
3019 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3021 fconfigure $gdtf -blocking 0
3022 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3025 proc gettreediffline {gdtf ids} {
3026 global treediff treediffs treepending diffids diffmergeid
3028 set n [gets $gdtf line]
3030 if {![eof $gdtf]} return
3032 set treediffs($ids) $treediff
3034 if {$ids != $diffids} {
3035 if {![info exists diffmergeid]} {
3036 gettreediffs $diffids
3043 set file [lindex $line 5]
3044 lappend treediff $file
3047 proc getblobdiffs {ids} {
3048 global diffopts blobdifffd diffids env curdifftag curtagstart
3049 global difffilestart nextupdate diffinhdr treediffs
3051 set env(GIT_DIFF_OPTS) $diffopts
3052 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3053 if {[catch {set bdf [open $cmd r]} err]} {
3054 puts "error getting diffs: $err"
3058 fconfigure $bdf -blocking 0
3059 set blobdifffd($ids) $bdf
3060 set curdifftag Comments
3062 catch {unset difffilestart}
3063 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3064 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3067 proc getblobdiffline {bdf ids} {
3068 global diffids blobdifffd ctext curdifftag curtagstart
3069 global diffnexthead diffnextnote difffilestart
3070 global nextupdate diffinhdr treediffs
3072 set n [gets $bdf line]
3076 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3077 $ctext tag add $curdifftag $curtagstart end
3082 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3085 $ctext conf -state normal
3086 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3087 # start of a new file
3088 $ctext insert end "\n"
3089 $ctext tag add $curdifftag $curtagstart end
3090 set curtagstart [$ctext index "end - 1c"]
3092 set here [$ctext index "end - 1c"]
3093 set i [lsearch -exact $treediffs($diffids) $fname]
3095 set difffilestart($i) $here
3097 $ctext mark set fmark.$i $here
3098 $ctext mark gravity fmark.$i left
3100 if {$newname != $fname} {
3101 set i [lsearch -exact $treediffs($diffids) $newname]
3103 set difffilestart($i) $here
3105 $ctext mark set fmark.$i $here
3106 $ctext mark gravity fmark.$i left
3109 set curdifftag "f:$fname"
3110 $ctext tag delete $curdifftag
3111 set l [expr {(78 - [string length $header]) / 2}]
3112 set pad [string range "----------------------------------------" 1 $l]
3113 $ctext insert end "$pad $header $pad\n" filesep
3115 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3117 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3119 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3120 $line match f1l f1c f2l f2c rest]} {
3121 $ctext insert end "$line\n" hunksep
3124 set x [string range $line 0 0]
3125 if {$x == "-" || $x == "+"} {
3126 set tag [expr {$x == "+"}]
3127 $ctext insert end "$line\n" d$tag
3128 } elseif {$x == " "} {
3129 $ctext insert end "$line\n"
3130 } elseif {$diffinhdr || $x == "\\"} {
3131 # e.g. "\ No newline at end of file"
3132 $ctext insert end "$line\n" filesep
3134 # Something else we don't recognize
3135 if {$curdifftag != "Comments"} {
3136 $ctext insert end "\n"
3137 $ctext tag add $curdifftag $curtagstart end
3138 set curtagstart [$ctext index "end - 1c"]
3139 set curdifftag Comments
3141 $ctext insert end "$line\n" filesep
3144 $ctext conf -state disabled
3145 if {[clock clicks -milliseconds] >= $nextupdate} {
3147 fileevent $bdf readable {}
3149 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3154 global difffilestart ctext
3155 set here [$ctext index @0,0]
3156 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3157 if {[$ctext compare $difffilestart($i) > $here]} {
3158 if {![info exists pos]
3159 || [$ctext compare $difffilestart($i) < $pos]} {
3160 set pos $difffilestart($i)
3164 if {[info exists pos]} {
3169 proc listboxsel {} {
3170 global ctext cflist currentid
3171 if {![info exists currentid]} return
3172 set sel [lsort [$cflist curselection]]
3173 if {$sel eq {}} return
3174 set first [lindex $sel 0]
3175 catch {$ctext yview fmark.$first}
3179 global linespc charspc canvx0 canvy0 mainfont
3180 global xspc1 xspc2 lthickness
3182 set linespc [font metrics $mainfont -linespace]
3183 set charspc [font measure $mainfont "m"]
3184 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3185 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3186 set lthickness [expr {int($linespc / 9) + 1}]
3187 set xspc1(0) $linespc
3195 set ymax [lindex [$canv cget -scrollregion] 3]
3196 if {$ymax eq {} || $ymax == 0} return
3197 set span [$canv yview]
3200 allcanvs yview moveto [lindex $span 0]
3202 if {[info exists selectedline]} {
3203 selectline $selectedline 0
3207 proc incrfont {inc} {
3208 global mainfont namefont textfont ctext canv phase
3209 global stopped entries
3211 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3212 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3213 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3215 $ctext conf -font $textfont
3216 $ctext tag conf filesep -font [concat $textfont bold]
3217 foreach e $entries {
3218 $e conf -font $mainfont
3220 if {$phase eq "getcommits"} {
3221 $canv itemconf textitems -font $mainfont
3227 global sha1entry sha1string
3228 if {[string length $sha1string] == 40} {
3229 $sha1entry delete 0 end
3233 proc sha1change {n1 n2 op} {
3234 global sha1string currentid sha1but
3235 if {$sha1string == {}
3236 || ([info exists currentid] && $sha1string == $currentid)} {
3241 if {[$sha1but cget -state] == $state} return
3242 if {$state == "normal"} {
3243 $sha1but conf -state normal -relief raised -text "Goto: "
3245 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3249 proc gotocommit {} {
3250 global sha1string currentid commitrow tagids headids
3251 global displayorder numcommits
3253 if {$sha1string == {}
3254 || ([info exists currentid] && $sha1string == $currentid)} return
3255 if {[info exists tagids($sha1string)]} {
3256 set id $tagids($sha1string)
3257 } elseif {[info exists headids($sha1string)]} {
3258 set id $headids($sha1string)
3260 set id [string tolower $sha1string]
3261 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3263 foreach i $displayorder {
3264 if {[string match $id* $i]} {
3268 if {$matches ne {}} {
3269 if {[llength $matches] > 1} {
3270 error_popup "Short SHA1 id $id is ambiguous"
3273 set id [lindex $matches 0]
3277 if {[info exists commitrow($id)]} {
3278 selectline $commitrow($id) 1
3281 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3286 error_popup "$type $sha1string is not known"
3289 proc lineenter {x y id} {
3290 global hoverx hovery hoverid hovertimer
3291 global commitinfo canv
3293 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3297 if {[info exists hovertimer]} {
3298 after cancel $hovertimer
3300 set hovertimer [after 500 linehover]
3304 proc linemotion {x y id} {
3305 global hoverx hovery hoverid hovertimer
3307 if {[info exists hoverid] && $id == $hoverid} {
3310 if {[info exists hovertimer]} {
3311 after cancel $hovertimer
3313 set hovertimer [after 500 linehover]
3317 proc lineleave {id} {
3318 global hoverid hovertimer canv
3320 if {[info exists hoverid] && $id == $hoverid} {
3322 if {[info exists hovertimer]} {
3323 after cancel $hovertimer
3331 global hoverx hovery hoverid hovertimer
3332 global canv linespc lthickness
3333 global commitinfo mainfont
3335 set text [lindex $commitinfo($hoverid) 0]
3336 set ymax [lindex [$canv cget -scrollregion] 3]
3337 if {$ymax == {}} return
3338 set yfrac [lindex [$canv yview] 0]
3339 set x [expr {$hoverx + 2 * $linespc}]
3340 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3341 set x0 [expr {$x - 2 * $lthickness}]
3342 set y0 [expr {$y - 2 * $lthickness}]
3343 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3344 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3345 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3346 -fill \#ffff80 -outline black -width 1 -tags hover]
3348 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3352 proc clickisonarrow {id y} {
3355 set ranges [rowranges $id]
3356 set thresh [expr {2 * $lthickness + 6}]
3357 set n [expr {[llength $ranges] - 1}]
3358 for {set i 1} {$i < $n} {incr i} {
3359 set row [lindex $ranges $i]
3360 if {abs([yc $row] - $y) < $thresh} {
3367 proc arrowjump {id n y} {
3370 # 1 <-> 2, 3 <-> 4, etc...
3371 set n [expr {(($n - 1) ^ 1) + 1}]
3372 set row [lindex [rowranges $id] $n]
3374 set ymax [lindex [$canv cget -scrollregion] 3]
3375 if {$ymax eq {} || $ymax <= 0} return
3376 set view [$canv yview]
3377 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3378 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3382 allcanvs yview moveto $yfrac
3385 proc lineclick {x y id isnew} {
3386 global ctext commitinfo childlist commitrow cflist canv thickerline
3388 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3393 # draw this line thicker than normal
3397 set ymax [lindex [$canv cget -scrollregion] 3]
3398 if {$ymax eq {}} return
3399 set yfrac [lindex [$canv yview] 0]
3400 set y [expr {$y + $yfrac * $ymax}]
3402 set dirn [clickisonarrow $id $y]
3404 arrowjump $id $dirn $y
3409 addtohistory [list lineclick $x $y $id 0]
3411 # fill the details pane with info about this line
3412 $ctext conf -state normal
3413 $ctext delete 0.0 end
3414 $ctext tag conf link -foreground blue -underline 1
3415 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3416 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3417 $ctext insert end "Parent:\t"
3418 $ctext insert end $id [list link link0]
3419 $ctext tag bind link0 <1> [list selbyid $id]
3420 set info $commitinfo($id)
3421 $ctext insert end "\n\t[lindex $info 0]\n"
3422 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3423 set date [formatdate [lindex $info 2]]
3424 $ctext insert end "\tDate:\t$date\n"
3425 set kids [lindex $childlist $commitrow($id)]
3427 $ctext insert end "\nChildren:"
3429 foreach child $kids {
3431 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3432 set info $commitinfo($child)
3433 $ctext insert end "\n\t"
3434 $ctext insert end $child [list link link$i]
3435 $ctext tag bind link$i <1> [list selbyid $child]
3436 $ctext insert end "\n\t[lindex $info 0]"
3437 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3438 set date [formatdate [lindex $info 2]]
3439 $ctext insert end "\n\tDate:\t$date\n"
3442 $ctext conf -state disabled
3444 $cflist delete 0 end
3447 proc normalline {} {
3449 if {[info exists thickerline]} {
3458 if {[info exists commitrow($id)]} {
3459 selectline $commitrow($id) 1
3465 if {![info exists startmstime]} {
3466 set startmstime [clock clicks -milliseconds]
3468 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3471 proc rowmenu {x y id} {
3472 global rowctxmenu commitrow selectedline rowmenuid
3474 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3479 $rowctxmenu entryconfigure 0 -state $state
3480 $rowctxmenu entryconfigure 1 -state $state
3481 $rowctxmenu entryconfigure 2 -state $state
3483 tk_popup $rowctxmenu $x $y
3486 proc diffvssel {dirn} {
3487 global rowmenuid selectedline displayorder
3489 if {![info exists selectedline]} return
3491 set oldid [lindex $displayorder $selectedline]
3492 set newid $rowmenuid
3494 set oldid $rowmenuid
3495 set newid [lindex $displayorder $selectedline]
3497 addtohistory [list doseldiff $oldid $newid]
3498 doseldiff $oldid $newid
3501 proc doseldiff {oldid newid} {
3505 $ctext conf -state normal
3506 $ctext delete 0.0 end
3507 $ctext mark set fmark.0 0.0
3508 $ctext mark gravity fmark.0 left
3509 $cflist delete 0 end
3510 $cflist insert end "Top"
3511 $ctext insert end "From "
3512 $ctext tag conf link -foreground blue -underline 1
3513 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3514 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3515 $ctext tag bind link0 <1> [list selbyid $oldid]
3516 $ctext insert end $oldid [list link link0]
3517 $ctext insert end "\n "
3518 $ctext insert end [lindex $commitinfo($oldid) 0]
3519 $ctext insert end "\n\nTo "
3520 $ctext tag bind link1 <1> [list selbyid $newid]
3521 $ctext insert end $newid [list link link1]
3522 $ctext insert end "\n "
3523 $ctext insert end [lindex $commitinfo($newid) 0]
3524 $ctext insert end "\n"
3525 $ctext conf -state disabled
3526 $ctext tag delete Comments
3527 $ctext tag remove found 1.0 end
3528 startdiff [list $oldid $newid]
3532 global rowmenuid currentid commitinfo patchtop patchnum
3534 if {![info exists currentid]} return
3535 set oldid $currentid
3536 set oldhead [lindex $commitinfo($oldid) 0]
3537 set newid $rowmenuid
3538 set newhead [lindex $commitinfo($newid) 0]
3541 catch {destroy $top}
3543 label $top.title -text "Generate patch"
3544 grid $top.title - -pady 10
3545 label $top.from -text "From:"
3546 entry $top.fromsha1 -width 40 -relief flat
3547 $top.fromsha1 insert 0 $oldid
3548 $top.fromsha1 conf -state readonly
3549 grid $top.from $top.fromsha1 -sticky w
3550 entry $top.fromhead -width 60 -relief flat
3551 $top.fromhead insert 0 $oldhead
3552 $top.fromhead conf -state readonly
3553 grid x $top.fromhead -sticky w
3554 label $top.to -text "To:"
3555 entry $top.tosha1 -width 40 -relief flat
3556 $top.tosha1 insert 0 $newid
3557 $top.tosha1 conf -state readonly
3558 grid $top.to $top.tosha1 -sticky w
3559 entry $top.tohead -width 60 -relief flat
3560 $top.tohead insert 0 $newhead
3561 $top.tohead conf -state readonly
3562 grid x $top.tohead -sticky w
3563 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3564 grid $top.rev x -pady 10
3565 label $top.flab -text "Output file:"
3566 entry $top.fname -width 60
3567 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3569 grid $top.flab $top.fname -sticky w
3571 button $top.buts.gen -text "Generate" -command mkpatchgo
3572 button $top.buts.can -text "Cancel" -command mkpatchcan
3573 grid $top.buts.gen $top.buts.can
3574 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3575 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3576 grid $top.buts - -pady 10 -sticky ew
3580 proc mkpatchrev {} {
3583 set oldid [$patchtop.fromsha1 get]
3584 set oldhead [$patchtop.fromhead get]
3585 set newid [$patchtop.tosha1 get]
3586 set newhead [$patchtop.tohead get]
3587 foreach e [list fromsha1 fromhead tosha1 tohead] \
3588 v [list $newid $newhead $oldid $oldhead] {
3589 $patchtop.$e conf -state normal
3590 $patchtop.$e delete 0 end
3591 $patchtop.$e insert 0 $v
3592 $patchtop.$e conf -state readonly
3599 set oldid [$patchtop.fromsha1 get]
3600 set newid [$patchtop.tosha1 get]
3601 set fname [$patchtop.fname get]
3602 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3603 error_popup "Error creating patch: $err"
3605 catch {destroy $patchtop}
3609 proc mkpatchcan {} {
3612 catch {destroy $patchtop}
3617 global rowmenuid mktagtop commitinfo
3621 catch {destroy $top}
3623 label $top.title -text "Create tag"
3624 grid $top.title - -pady 10
3625 label $top.id -text "ID:"
3626 entry $top.sha1 -width 40 -relief flat
3627 $top.sha1 insert 0 $rowmenuid
3628 $top.sha1 conf -state readonly
3629 grid $top.id $top.sha1 -sticky w
3630 entry $top.head -width 60 -relief flat
3631 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3632 $top.head conf -state readonly
3633 grid x $top.head -sticky w
3634 label $top.tlab -text "Tag name:"
3635 entry $top.tag -width 60
3636 grid $top.tlab $top.tag -sticky w
3638 button $top.buts.gen -text "Create" -command mktaggo
3639 button $top.buts.can -text "Cancel" -command mktagcan
3640 grid $top.buts.gen $top.buts.can
3641 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3642 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3643 grid $top.buts - -pady 10 -sticky ew
3648 global mktagtop env tagids idtags
3650 set id [$mktagtop.sha1 get]
3651 set tag [$mktagtop.tag get]
3653 error_popup "No tag name specified"
3656 if {[info exists tagids($tag)]} {
3657 error_popup "Tag \"$tag\" already exists"
3662 set fname [file join $dir "refs/tags" $tag]
3663 set f [open $fname w]
3667 error_popup "Error creating tag: $err"
3671 set tagids($tag) $id
3672 lappend idtags($id) $tag
3676 proc redrawtags {id} {
3677 global canv linehtag commitrow idpos selectedline
3679 if {![info exists commitrow($id)]} return
3680 drawcmitrow $commitrow($id)
3681 $canv delete tag.$id
3682 set xt [eval drawtags $id $idpos($id)]
3683 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3684 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3685 selectline $selectedline 0
3692 catch {destroy $mktagtop}
3701 proc writecommit {} {
3702 global rowmenuid wrcomtop commitinfo wrcomcmd
3704 set top .writecommit
3706 catch {destroy $top}
3708 label $top.title -text "Write commit to file"
3709 grid $top.title - -pady 10
3710 label $top.id -text "ID:"
3711 entry $top.sha1 -width 40 -relief flat
3712 $top.sha1 insert 0 $rowmenuid
3713 $top.sha1 conf -state readonly
3714 grid $top.id $top.sha1 -sticky w
3715 entry $top.head -width 60 -relief flat
3716 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3717 $top.head conf -state readonly
3718 grid x $top.head -sticky w
3719 label $top.clab -text "Command:"
3720 entry $top.cmd -width 60 -textvariable wrcomcmd
3721 grid $top.clab $top.cmd -sticky w -pady 10
3722 label $top.flab -text "Output file:"
3723 entry $top.fname -width 60
3724 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3725 grid $top.flab $top.fname -sticky w
3727 button $top.buts.gen -text "Write" -command wrcomgo
3728 button $top.buts.can -text "Cancel" -command wrcomcan
3729 grid $top.buts.gen $top.buts.can
3730 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3731 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3732 grid $top.buts - -pady 10 -sticky ew
3739 set id [$wrcomtop.sha1 get]
3740 set cmd "echo $id | [$wrcomtop.cmd get]"
3741 set fname [$wrcomtop.fname get]
3742 if {[catch {exec sh -c $cmd >$fname &} err]} {
3743 error_popup "Error writing commit: $err"
3745 catch {destroy $wrcomtop}
3752 catch {destroy $wrcomtop}
3756 proc listrefs {id} {
3757 global idtags idheads idotherrefs
3760 if {[info exists idtags($id)]} {
3764 if {[info exists idheads($id)]} {
3768 if {[info exists idotherrefs($id)]} {
3769 set z $idotherrefs($id)
3771 return [list $x $y $z]
3774 proc rereadrefs {} {
3775 global idtags idheads idotherrefs
3777 set refids [concat [array names idtags] \
3778 [array names idheads] [array names idotherrefs]]
3779 foreach id $refids {
3780 if {![info exists ref($id)]} {
3781 set ref($id) [listrefs $id]
3785 set refids [lsort -unique [concat $refids [array names idtags] \
3786 [array names idheads] [array names idotherrefs]]]
3787 foreach id $refids {
3788 set v [listrefs $id]
3789 if {![info exists ref($id)] || $ref($id) != $v} {
3795 proc showtag {tag isnew} {
3796 global ctext cflist tagcontents tagids linknum
3799 addtohistory [list showtag $tag 0]
3801 $ctext conf -state normal
3802 $ctext delete 0.0 end
3804 if {[info exists tagcontents($tag)]} {
3805 set text $tagcontents($tag)
3807 set text "Tag: $tag\nId: $tagids($tag)"
3809 appendwithlinks $text
3810 $ctext conf -state disabled
3811 $cflist delete 0 end
3821 global maxwidth maxgraphpct diffopts findmergefiles
3822 global oldprefs prefstop
3826 if {[winfo exists $top]} {
3830 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3831 set oldprefs($v) [set $v]
3834 wm title $top "Gitk preferences"
3835 label $top.ldisp -text "Commit list display options"
3836 grid $top.ldisp - -sticky w -pady 10
3837 label $top.spacer -text " "
3838 label $top.maxwidthl -text "Maximum graph width (lines)" \
3840 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3841 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3842 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3844 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3845 grid x $top.maxpctl $top.maxpct -sticky w
3846 checkbutton $top.findm -variable findmergefiles
3847 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3849 grid $top.findm $top.findml - -sticky w
3850 label $top.ddisp -text "Diff display options"
3851 grid $top.ddisp - -sticky w -pady 10
3852 label $top.diffoptl -text "Options for diff program" \
3854 entry $top.diffopt -width 20 -textvariable diffopts
3855 grid x $top.diffoptl $top.diffopt -sticky w
3857 button $top.buts.ok -text "OK" -command prefsok
3858 button $top.buts.can -text "Cancel" -command prefscan
3859 grid $top.buts.ok $top.buts.can
3860 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3861 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3862 grid $top.buts - - -pady 10 -sticky ew
3866 global maxwidth maxgraphpct diffopts findmergefiles
3867 global oldprefs prefstop
3869 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3870 set $v $oldprefs($v)
3872 catch {destroy $prefstop}
3877 global maxwidth maxgraphpct
3878 global oldprefs prefstop
3880 catch {destroy $prefstop}
3882 if {$maxwidth != $oldprefs(maxwidth)
3883 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3888 proc formatdate {d} {
3889 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3892 # This list of encoding names and aliases is distilled from
3893 # http://www.iana.org/assignments/character-sets.
3894 # Not all of them are supported by Tcl.
3895 set encoding_aliases {
3896 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3897 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3898 { ISO-10646-UTF-1 csISO10646UTF1 }
3899 { ISO_646.basic:1983 ref csISO646basic1983 }
3900 { INVARIANT csINVARIANT }
3901 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3902 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3903 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3904 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3905 { NATS-DANO iso-ir-9-1 csNATSDANO }
3906 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3907 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3908 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3909 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3910 { ISO-2022-KR csISO2022KR }
3912 { ISO-2022-JP csISO2022JP }
3913 { ISO-2022-JP-2 csISO2022JP2 }
3914 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3916 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3917 { IT iso-ir-15 ISO646-IT csISO15Italian }
3918 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3919 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3920 { greek7-old iso-ir-18 csISO18Greek7Old }
3921 { latin-greek iso-ir-19 csISO19LatinGreek }
3922 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3923 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3924 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3925 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3926 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3927 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3928 { INIS iso-ir-49 csISO49INIS }
3929 { INIS-8 iso-ir-50 csISO50INIS8 }
3930 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3931 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3932 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3933 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3934 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3935 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3937 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3938 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3939 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3940 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3941 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3942 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3943 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3944 { greek7 iso-ir-88 csISO88Greek7 }
3945 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3946 { iso-ir-90 csISO90 }
3947 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3948 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3949 csISO92JISC62991984b }
3950 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3951 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3952 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3953 csISO95JIS62291984handadd }
3954 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3955 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3956 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3957 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3959 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3960 { T.61-7bit iso-ir-102 csISO102T617bit }
3961 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3962 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3963 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3964 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3965 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3966 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3967 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3968 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3969 arabic csISOLatinArabic }
3970 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3971 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3972 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3973 greek greek8 csISOLatinGreek }
3974 { T.101-G2 iso-ir-128 csISO128T101G2 }
3975 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3977 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3978 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3979 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3980 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3981 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3982 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3983 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3984 csISOLatinCyrillic }
3985 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3986 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3987 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3988 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3989 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3990 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3991 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3992 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3993 { ISO_10367-box iso-ir-155 csISO10367Box }
3994 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3995 { latin-lap lap iso-ir-158 csISO158Lap }
3996 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3997 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4000 { JIS_X0201 X0201 csHalfWidthKatakana }
4001 { KSC5636 ISO646-KR csKSC5636 }
4002 { ISO-10646-UCS-2 csUnicode }
4003 { ISO-10646-UCS-4 csUCS4 }
4004 { DEC-MCS dec csDECMCS }
4005 { hp-roman8 roman8 r8 csHPRoman8 }
4006 { macintosh mac csMacintosh }
4007 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4009 { IBM038 EBCDIC-INT cp038 csIBM038 }
4010 { IBM273 CP273 csIBM273 }
4011 { IBM274 EBCDIC-BE CP274 csIBM274 }
4012 { IBM275 EBCDIC-BR cp275 csIBM275 }
4013 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4014 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4015 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4016 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4017 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4018 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4019 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4020 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4021 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4022 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4023 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4024 { IBM437 cp437 437 csPC8CodePage437 }
4025 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4026 { IBM775 cp775 csPC775Baltic }
4027 { IBM850 cp850 850 csPC850Multilingual }
4028 { IBM851 cp851 851 csIBM851 }
4029 { IBM852 cp852 852 csPCp852 }
4030 { IBM855 cp855 855 csIBM855 }
4031 { IBM857 cp857 857 csIBM857 }
4032 { IBM860 cp860 860 csIBM860 }
4033 { IBM861 cp861 861 cp-is csIBM861 }
4034 { IBM862 cp862 862 csPC862LatinHebrew }
4035 { IBM863 cp863 863 csIBM863 }
4036 { IBM864 cp864 csIBM864 }
4037 { IBM865 cp865 865 csIBM865 }
4038 { IBM866 cp866 866 csIBM866 }
4039 { IBM868 CP868 cp-ar csIBM868 }
4040 { IBM869 cp869 869 cp-gr csIBM869 }
4041 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4042 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4043 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4044 { IBM891 cp891 csIBM891 }
4045 { IBM903 cp903 csIBM903 }
4046 { IBM904 cp904 904 csIBBM904 }
4047 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4048 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4049 { IBM1026 CP1026 csIBM1026 }
4050 { EBCDIC-AT-DE csIBMEBCDICATDE }
4051 { EBCDIC-AT-DE-A csEBCDICATDEA }
4052 { EBCDIC-CA-FR csEBCDICCAFR }
4053 { EBCDIC-DK-NO csEBCDICDKNO }
4054 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4055 { EBCDIC-FI-SE csEBCDICFISE }
4056 { EBCDIC-FI-SE-A csEBCDICFISEA }
4057 { EBCDIC-FR csEBCDICFR }
4058 { EBCDIC-IT csEBCDICIT }
4059 { EBCDIC-PT csEBCDICPT }
4060 { EBCDIC-ES csEBCDICES }
4061 { EBCDIC-ES-A csEBCDICESA }
4062 { EBCDIC-ES-S csEBCDICESS }
4063 { EBCDIC-UK csEBCDICUK }
4064 { EBCDIC-US csEBCDICUS }
4065 { UNKNOWN-8BIT csUnknown8BiT }
4066 { MNEMONIC csMnemonic }
4071 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4072 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4073 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4074 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4075 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4076 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4077 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4078 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4079 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4080 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4081 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4082 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4083 { IBM1047 IBM-1047 }
4084 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4085 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4086 { UNICODE-1-1 csUnicode11 }
4089 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4090 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4092 { ISO-8859-15 ISO_8859-15 Latin-9 }
4093 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4094 { GBK CP936 MS936 windows-936 }
4095 { JIS_Encoding csJISEncoding }
4096 { Shift_JIS MS_Kanji csShiftJIS }
4097 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4099 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4100 { ISO-10646-UCS-Basic csUnicodeASCII }
4101 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4102 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4103 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4104 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4105 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4106 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4107 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4108 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4109 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4110 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4111 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4112 { Ventura-US csVenturaUS }
4113 { Ventura-International csVenturaInternational }
4114 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4115 { PC8-Turkish csPC8Turkish }
4116 { IBM-Symbols csIBMSymbols }
4117 { IBM-Thai csIBMThai }
4118 { HP-Legal csHPLegal }
4119 { HP-Pi-font csHPPiFont }
4120 { HP-Math8 csHPMath8 }
4121 { Adobe-Symbol-Encoding csHPPSMath }
4122 { HP-DeskTop csHPDesktop }
4123 { Ventura-Math csVenturaMath }
4124 { Microsoft-Publishing csMicrosoftPublishing }
4125 { Windows-31J csWindows31J }
4130 proc tcl_encoding {enc} {
4131 global encoding_aliases
4132 set names [encoding names]
4133 set lcnames [string tolower $names]
4134 set enc [string tolower $enc]
4135 set i [lsearch -exact $lcnames $enc]
4137 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4138 if {[regsub {^iso[-_]} $enc iso encx]} {
4139 set i [lsearch -exact $lcnames $encx]
4143 foreach l $encoding_aliases {
4144 set ll [string tolower $l]
4145 if {[lsearch -exact $ll $enc] < 0} continue
4146 # look through the aliases for one that tcl knows about
4148 set i [lsearch -exact $lcnames $e]
4150 if {[regsub {^iso[-_]} $e iso ex]} {
4151 set i [lsearch -exact $lcnames $ex]
4160 return [lindex $names $i]
4167 set diffopts "-U 5 -p"
4168 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4172 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4174 if {$gitencoding == ""} {
4175 set gitencoding "utf-8"
4177 set tclencoding [tcl_encoding $gitencoding]
4178 if {$tclencoding == {}} {
4179 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4182 set mainfont {Helvetica 9}
4183 set textfont {Courier 9}
4184 set uifont {Helvetica 9 bold}
4185 set findmergefiles 0
4194 set colors {green red blue magenta darkgrey brown orange}
4196 catch {source ~/.gitk}
4198 set namefont $mainfont
4200 font create optionfont -family sans-serif -size -12
4204 switch -regexp -- $arg {
4206 "^-d" { set datemode 1 }
4208 lappend revtreeargs $arg
4213 # check that we can find a .git directory somewhere...
4215 if {![file isdirectory $gitdir]} {
4216 error_popup "Cannot find the git directory \"$gitdir\"."
4235 parse_args $revtreeargs
4236 set args $parsed_args
4237 if {$cmdline_files ne {}} {
4238 # create a view for the files/dirs specified on the command line
4241 set viewname(1) "Command line"
4242 set viewfiles(1) $cmdline_files
4243 .bar.view add command -label $viewname(1) -command {showview 1}
4244 .bar.view entryconf 2 -state normal
4245 set args [concat $args "--" $cmdline_files]