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 || [lindex $viewdata($curview) 0] ne {}} {
964 set viewdata($curview) \
965 [list {} $displayorder $parentlist $childlist $rowidlist \
966 $rowoffsets $rowrangelist $commitlisted]
969 catch {unset matchinglines}
970 catch {unset treediffs}
974 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
976 if {![info exists viewdata($n)]} {
977 set args $parsed_args
978 if {$viewfiles($n) ne {}} {
979 set args [concat $args "--" $viewfiles($n)]
981 set pending_select $selid
987 set phase [lindex $v 0]
988 set displayorder [lindex $v 1]
989 set parentlist [lindex $v 2]
990 set childlist [lindex $v 3]
991 set rowidlist [lindex $v 4]
992 set rowoffsets [lindex $v 5]
993 set rowrangelist [lindex $v 6]
994 set commitlisted [lindex $v 7]
996 set numcommits [llength $displayorder]
997 catch {unset idrowranges}
998 catch {unset children}
1000 unflatten children [lindex $v 8]
1001 unflatten idrowranges [lindex $v 9]
1002 unflatten idinlist [lindex $v 10]
1003 set commitidx [lindex $v 11]
1004 set rowlaidout [lindex $v 12]
1005 set rowoptim [lindex $v 13]
1006 set numcommits [lindex $v 14]
1007 set linesegends [lindex $v 15]
1008 set leftover [lindex $v 16]
1009 set commfd [lindex $v 17]
1010 fileevent $commfd readable [list getcommitlines $commfd]
1011 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1014 catch {unset colormap}
1015 catch {unset rowtextx}
1016 catch {unset commitrow}
1019 foreach id $displayorder {
1020 set commitrow($id) $row
1026 if {$selid ne {} && [info exists commitrow($selid)]} {
1027 set row $commitrow($selid)
1028 # try to get the selected row in the same position on the screen
1029 set ymax [lindex [$canv cget -scrollregion] 3]
1030 set ytop [expr {[yc $row] - $yscreen}]
1034 set yf [expr {$ytop * 1.0 / $ymax}]
1036 allcanvs yview moveto $yf
1040 global maincursor textcursor
1041 . config -cursor $maincursor
1042 settextcursor $textcursor
1044 . config -cursor watch
1049 proc shortids {ids} {
1052 if {[llength $id] > 1} {
1053 lappend res [shortids $id]
1054 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1055 lappend res [string range $id 0 7]
1063 proc incrange {l x o} {
1066 set e [lindex $l $x]
1068 lset l $x [expr {$e + $o}]
1077 for {} {$n > 0} {incr n -1} {
1083 proc usedinrange {id l1 l2} {
1084 global children commitrow childlist
1086 if {[info exists commitrow($id)]} {
1087 set r $commitrow($id)
1088 if {$l1 <= $r && $r <= $l2} {
1089 return [expr {$r - $l1 + 1}]
1091 set kids [lindex $childlist $r]
1093 set kids $children($id)
1096 set r $commitrow($c)
1097 if {$l1 <= $r && $r <= $l2} {
1098 return [expr {$r - $l1 + 1}]
1104 proc sanity {row {full 0}} {
1105 global rowidlist rowoffsets
1108 set ids [lindex $rowidlist $row]
1111 if {$id eq {}} continue
1112 if {$col < [llength $ids] - 1 &&
1113 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1114 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1116 set o [lindex $rowoffsets $row $col]
1122 if {[lindex $rowidlist $y $x] != $id} {
1123 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1124 puts " id=[shortids $id] check started at row $row"
1125 for {set i $row} {$i >= $y} {incr i -1} {
1126 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1131 set o [lindex $rowoffsets $y $x]
1136 proc makeuparrow {oid x y z} {
1137 global rowidlist rowoffsets uparrowlen idrowranges
1139 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1142 set off0 [lindex $rowoffsets $y]
1143 for {set x0 $x} {1} {incr x0} {
1144 if {$x0 >= [llength $off0]} {
1145 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1148 set z [lindex $off0 $x0]
1154 set z [expr {$x0 - $x}]
1155 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1156 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1158 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1159 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1160 lappend idrowranges($oid) $y
1163 proc initlayout {} {
1164 global rowidlist rowoffsets displayorder commitlisted
1165 global rowlaidout rowoptim
1166 global idinlist rowchk rowrangelist idrowranges
1167 global commitidx numcommits canvxmax canv
1169 global parentlist childlist children
1170 global colormap rowtextx commitrow
1180 catch {unset children}
1184 catch {unset idinlist}
1185 catch {unset rowchk}
1188 set canvxmax [$canv cget -width]
1189 catch {unset colormap}
1190 catch {unset rowtextx}
1191 catch {unset commitrow}
1192 catch {unset idrowranges}
1196 proc setcanvscroll {} {
1197 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1199 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1200 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1201 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1202 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1205 proc visiblerows {} {
1206 global canv numcommits linespc
1208 set ymax [lindex [$canv cget -scrollregion] 3]
1209 if {$ymax eq {} || $ymax == 0} return
1211 set y0 [expr {int([lindex $f 0] * $ymax)}]
1212 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1216 set y1 [expr {int([lindex $f 1] * $ymax)}]
1217 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1218 if {$r1 >= $numcommits} {
1219 set r1 [expr {$numcommits - 1}]
1221 return [list $r0 $r1]
1224 proc layoutmore {} {
1225 global rowlaidout rowoptim commitidx numcommits optim_delay
1229 set rowlaidout [layoutrows $row $commitidx 0]
1230 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1231 if {$orow > $rowoptim} {
1232 optimize_rows $rowoptim 0 $orow
1235 set canshow [expr {$rowoptim - $optim_delay}]
1236 if {$canshow > $numcommits} {
1241 proc showstuff {canshow} {
1242 global numcommits commitrow pending_select selectedline
1243 global linesegends idrowranges idrangedrawn
1245 if {$numcommits == 0} {
1247 set phase "incrdraw"
1251 set numcommits $canshow
1253 set rows [visiblerows]
1254 set r0 [lindex $rows 0]
1255 set r1 [lindex $rows 1]
1257 for {set r $row} {$r < $canshow} {incr r} {
1258 foreach id [lindex $linesegends [expr {$r+1}]] {
1260 foreach {s e} [rowranges $id] {
1262 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1263 && ![info exists idrangedrawn($id,$i)]} {
1265 set idrangedrawn($id,$i) 1
1270 if {$canshow > $r1} {
1273 while {$row < $canshow} {
1277 if {[info exists pending_select] &&
1278 [info exists commitrow($pending_select)] &&
1279 $commitrow($pending_select) < $numcommits} {
1280 selectline $commitrow($pending_select) 1
1282 if {![info exists selectedline] && ![info exists pending_select]} {
1287 proc layoutrows {row endrow last} {
1288 global rowidlist rowoffsets displayorder
1289 global uparrowlen downarrowlen maxwidth mingaplen
1290 global childlist parentlist
1291 global idrowranges linesegends
1293 global idinlist rowchk rowrangelist
1295 set idlist [lindex $rowidlist $row]
1296 set offs [lindex $rowoffsets $row]
1297 while {$row < $endrow} {
1298 set id [lindex $displayorder $row]
1301 foreach p [lindex $parentlist $row] {
1302 if {![info exists idinlist($p)]} {
1304 } elseif {!$idinlist($p)} {
1309 set nev [expr {[llength $idlist] + [llength $newolds]
1310 + [llength $oldolds] - $maxwidth + 1}]
1312 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1313 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1314 set i [lindex $idlist $x]
1315 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1316 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1317 [expr {$row + $uparrowlen + $mingaplen}]]
1319 set idlist [lreplace $idlist $x $x]
1320 set offs [lreplace $offs $x $x]
1321 set offs [incrange $offs $x 1]
1323 set rm1 [expr {$row - 1}]
1325 lappend idrowranges($i) $rm1
1326 if {[incr nev -1] <= 0} break
1329 set rowchk($id) [expr {$row + $r}]
1332 lset rowidlist $row $idlist
1333 lset rowoffsets $row $offs
1335 lappend linesegends $lse
1336 set col [lsearch -exact $idlist $id]
1338 set col [llength $idlist]
1340 lset rowidlist $row $idlist
1342 if {[lindex $childlist $row] ne {}} {
1343 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1347 lset rowoffsets $row $offs
1349 makeuparrow $id $col $row $z
1355 if {[info exists idrowranges($id)]} {
1356 set ranges $idrowranges($id)
1358 unset idrowranges($id)
1360 lappend rowrangelist $ranges
1362 set offs [ntimes [llength $idlist] 0]
1363 set l [llength $newolds]
1364 set idlist [eval lreplace \$idlist $col $col $newolds]
1367 set offs [lrange $offs 0 [expr {$col - 1}]]
1368 foreach x $newolds {
1373 set tmp [expr {[llength $idlist] - [llength $offs]}]
1375 set offs [concat $offs [ntimes $tmp $o]]
1380 foreach i $newolds {
1382 set idrowranges($i) $row
1385 foreach oid $oldolds {
1386 set idinlist($oid) 1
1387 set idlist [linsert $idlist $col $oid]
1388 set offs [linsert $offs $col $o]
1389 makeuparrow $oid $col $row $o
1392 lappend rowidlist $idlist
1393 lappend rowoffsets $offs
1398 proc addextraid {id row} {
1399 global displayorder commitrow commitinfo
1401 global parentlist childlist children
1404 lappend displayorder $id
1405 lappend parentlist {}
1406 set commitrow($id) $row
1408 if {![info exists commitinfo($id)]} {
1409 set commitinfo($id) {"No commit information available"}
1411 if {[info exists children($id)]} {
1412 lappend childlist $children($id)
1415 lappend childlist {}
1419 proc layouttail {} {
1420 global rowidlist rowoffsets idinlist commitidx
1421 global idrowranges rowrangelist
1424 set idlist [lindex $rowidlist $row]
1425 while {$idlist ne {}} {
1426 set col [expr {[llength $idlist] - 1}]
1427 set id [lindex $idlist $col]
1430 lappend idrowranges($id) $row
1431 lappend rowrangelist $idrowranges($id)
1432 unset idrowranges($id)
1434 set offs [ntimes $col 0]
1435 set idlist [lreplace $idlist $col $col]
1436 lappend rowidlist $idlist
1437 lappend rowoffsets $offs
1440 foreach id [array names idinlist] {
1442 lset rowidlist $row [list $id]
1443 lset rowoffsets $row 0
1444 makeuparrow $id 0 $row 0
1445 lappend idrowranges($id) $row
1446 lappend rowrangelist $idrowranges($id)
1447 unset idrowranges($id)
1449 lappend rowidlist {}
1450 lappend rowoffsets {}
1454 proc insert_pad {row col npad} {
1455 global rowidlist rowoffsets
1457 set pad [ntimes $npad {}]
1458 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1459 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1460 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1463 proc optimize_rows {row col endrow} {
1464 global rowidlist rowoffsets idrowranges displayorder
1466 for {} {$row < $endrow} {incr row} {
1467 set idlist [lindex $rowidlist $row]
1468 set offs [lindex $rowoffsets $row]
1470 for {} {$col < [llength $offs]} {incr col} {
1471 if {[lindex $idlist $col] eq {}} {
1475 set z [lindex $offs $col]
1476 if {$z eq {}} continue
1478 set x0 [expr {$col + $z}]
1479 set y0 [expr {$row - 1}]
1480 set z0 [lindex $rowoffsets $y0 $x0]
1482 set id [lindex $idlist $col]
1483 set ranges [rowranges $id]
1484 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1488 if {$z < -1 || ($z < 0 && $isarrow)} {
1489 set npad [expr {-1 - $z + $isarrow}]
1490 set offs [incrange $offs $col $npad]
1491 insert_pad $y0 $x0 $npad
1493 optimize_rows $y0 $x0 $row
1495 set z [lindex $offs $col]
1496 set x0 [expr {$col + $z}]
1497 set z0 [lindex $rowoffsets $y0 $x0]
1498 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1499 set npad [expr {$z - 1 + $isarrow}]
1500 set y1 [expr {$row + 1}]
1501 set offs2 [lindex $rowoffsets $y1]
1505 if {$z eq {} || $x1 + $z < $col} continue
1506 if {$x1 + $z > $col} {
1509 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1512 set pad [ntimes $npad {}]
1513 set idlist [eval linsert \$idlist $col $pad]
1514 set tmp [eval linsert \$offs $col $pad]
1516 set offs [incrange $tmp $col [expr {-$npad}]]
1517 set z [lindex $offs $col]
1520 if {$z0 eq {} && !$isarrow} {
1521 # this line links to its first child on row $row-2
1522 set rm2 [expr {$row - 2}]
1523 set id [lindex $displayorder $rm2]
1524 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1526 set z0 [expr {$xc - $x0}]
1529 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1530 insert_pad $y0 $x0 1
1531 set offs [incrange $offs $col 1]
1532 optimize_rows $y0 [expr {$x0 + 1}] $row
1537 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1538 set o [lindex $offs $col]
1540 # check if this is the link to the first child
1541 set id [lindex $idlist $col]
1542 set ranges [rowranges $id]
1543 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1544 # it is, work out offset to child
1545 set y0 [expr {$row - 1}]
1546 set id [lindex $displayorder $y0]
1547 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1549 set o [expr {$x0 - $col}]
1553 if {$o eq {} || $o <= 0} break
1555 if {$o ne {} && [incr col] < [llength $idlist]} {
1556 set y1 [expr {$row + 1}]
1557 set offs2 [lindex $rowoffsets $y1]
1561 if {$z eq {} || $x1 + $z < $col} continue
1562 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1565 set idlist [linsert $idlist $col {}]
1566 set tmp [linsert $offs $col {}]
1568 set offs [incrange $tmp $col -1]
1571 lset rowidlist $row $idlist
1572 lset rowoffsets $row $offs
1578 global canvx0 linespc
1579 return [expr {$canvx0 + $col * $linespc}]
1583 global canvy0 linespc
1584 return [expr {$canvy0 + $row * $linespc}]
1587 proc linewidth {id} {
1588 global thickerline lthickness
1591 if {[info exists thickerline] && $id eq $thickerline} {
1592 set wid [expr {2 * $lthickness}]
1597 proc rowranges {id} {
1598 global phase idrowranges commitrow rowlaidout rowrangelist
1602 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1603 set ranges [lindex $rowrangelist $commitrow($id)]
1604 } elseif {[info exists idrowranges($id)]} {
1605 set ranges $idrowranges($id)
1610 proc drawlineseg {id i} {
1611 global rowoffsets rowidlist
1613 global canv colormap linespc
1614 global numcommits commitrow
1616 set ranges [rowranges $id]
1618 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1619 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1623 set startrow [lindex $ranges [expr {2 * $i}]]
1624 set row [lindex $ranges [expr {2 * $i + 1}]]
1625 if {$startrow == $row} return
1628 set col [lsearch -exact [lindex $rowidlist $row] $id]
1630 puts "oops: drawline: id $id not on row $row"
1636 set o [lindex $rowoffsets $row $col]
1639 # changing direction
1640 set x [xc $row $col]
1642 lappend coords $x $y
1648 set x [xc $row $col]
1650 lappend coords $x $y
1652 # draw the link to the first child as part of this line
1654 set child [lindex $displayorder $row]
1655 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1657 set x [xc $row $ccol]
1659 if {$ccol < $col - 1} {
1660 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1661 } elseif {$ccol > $col + 1} {
1662 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1664 lappend coords $x $y
1667 if {[llength $coords] < 4} return
1669 # This line has an arrow at the lower end: check if the arrow is
1670 # on a diagonal segment, and if so, work around the Tk 8.4
1671 # refusal to draw arrows on diagonal lines.
1672 set x0 [lindex $coords 0]
1673 set x1 [lindex $coords 2]
1675 set y0 [lindex $coords 1]
1676 set y1 [lindex $coords 3]
1677 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1678 # we have a nearby vertical segment, just trim off the diag bit
1679 set coords [lrange $coords 2 end]
1681 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1682 set xi [expr {$x0 - $slope * $linespc / 2}]
1683 set yi [expr {$y0 - $linespc / 2}]
1684 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1688 set arrow [expr {2 * ($i > 0) + $downarrow}]
1689 set arrow [lindex {none first last both} $arrow]
1690 set t [$canv create line $coords -width [linewidth $id] \
1691 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1696 proc drawparentlinks {id row col olds} {
1697 global rowidlist canv colormap
1699 set row2 [expr {$row + 1}]
1700 set x [xc $row $col]
1703 set ids [lindex $rowidlist $row2]
1704 # rmx = right-most X coord used
1707 set i [lsearch -exact $ids $p]
1709 puts "oops, parent $p of $id not in list"
1712 set x2 [xc $row2 $i]
1716 set ranges [rowranges $p]
1717 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1718 && $row2 < [lindex $ranges 1]} {
1719 # drawlineseg will do this one for us
1723 # should handle duplicated parents here...
1724 set coords [list $x $y]
1725 if {$i < $col - 1} {
1726 lappend coords [xc $row [expr {$i + 1}]] $y
1727 } elseif {$i > $col + 1} {
1728 lappend coords [xc $row [expr {$i - 1}]] $y
1730 lappend coords $x2 $y2
1731 set t [$canv create line $coords -width [linewidth $p] \
1732 -fill $colormap($p) -tags lines.$p]
1739 proc drawlines {id} {
1740 global colormap canv
1742 global childlist iddrawn commitrow rowidlist
1744 $canv delete lines.$id
1745 set nr [expr {[llength [rowranges $id]] / 2}]
1746 for {set i 0} {$i < $nr} {incr i} {
1747 if {[info exists idrangedrawn($id,$i)]} {
1751 foreach child [lindex $childlist $commitrow($id)] {
1752 if {[info exists iddrawn($child)]} {
1753 set row $commitrow($child)
1754 set col [lsearch -exact [lindex $rowidlist $row] $child]
1756 drawparentlinks $child $row $col [list $id]
1762 proc drawcmittext {id row col rmx} {
1763 global linespc canv canv2 canv3 canvy0
1764 global commitlisted commitinfo rowidlist
1765 global rowtextx idpos idtags idheads idotherrefs
1766 global linehtag linentag linedtag
1767 global mainfont namefont canvxmax
1769 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1770 set x [xc $row $col]
1772 set orad [expr {$linespc / 3}]
1773 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1774 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1775 -fill $ofill -outline black -width 1]
1777 $canv bind $t <1> {selcanvline {} %x %y}
1778 set xt [xc $row [llength [lindex $rowidlist $row]]]
1782 set rowtextx($row) $xt
1783 set idpos($id) [list $x $xt $y]
1784 if {[info exists idtags($id)] || [info exists idheads($id)]
1785 || [info exists idotherrefs($id)]} {
1786 set xt [drawtags $id $x $xt $y]
1788 set headline [lindex $commitinfo($id) 0]
1789 set name [lindex $commitinfo($id) 1]
1790 set date [lindex $commitinfo($id) 2]
1791 set date [formatdate $date]
1792 set linehtag($row) [$canv create text $xt $y -anchor w \
1793 -text $headline -font $mainfont ]
1794 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1795 set linentag($row) [$canv2 create text 3 $y -anchor w \
1796 -text $name -font $namefont]
1797 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1798 -text $date -font $mainfont]
1799 set xr [expr {$xt + [font measure $mainfont $headline]}]
1800 if {$xr > $canvxmax} {
1806 proc drawcmitrow {row} {
1807 global displayorder rowidlist
1808 global idrangedrawn iddrawn
1809 global commitinfo commitlisted parentlist numcommits
1811 if {$row >= $numcommits} return
1812 foreach id [lindex $rowidlist $row] {
1813 if {$id eq {}} continue
1815 foreach {s e} [rowranges $id] {
1817 if {$row < $s} continue
1820 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1822 set idrangedrawn($id,$i) 1
1829 set id [lindex $displayorder $row]
1830 if {[info exists iddrawn($id)]} return
1831 set col [lsearch -exact [lindex $rowidlist $row] $id]
1833 puts "oops, row $row id $id not in list"
1836 if {![info exists commitinfo($id)]} {
1840 set olds [lindex $parentlist $row]
1842 set rmx [drawparentlinks $id $row $col $olds]
1846 drawcmittext $id $row $col $rmx
1850 proc drawfrac {f0 f1} {
1851 global numcommits canv
1854 set ymax [lindex [$canv cget -scrollregion] 3]
1855 if {$ymax eq {} || $ymax == 0} return
1856 set y0 [expr {int($f0 * $ymax)}]
1857 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1861 set y1 [expr {int($f1 * $ymax)}]
1862 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1863 if {$endrow >= $numcommits} {
1864 set endrow [expr {$numcommits - 1}]
1866 for {} {$row <= $endrow} {incr row} {
1871 proc drawvisible {} {
1873 eval drawfrac [$canv yview]
1876 proc clear_display {} {
1877 global iddrawn idrangedrawn
1880 catch {unset iddrawn}
1881 catch {unset idrangedrawn}
1884 proc findcrossings {id} {
1885 global rowidlist parentlist numcommits rowoffsets displayorder
1889 foreach {s e} [rowranges $id] {
1890 if {$e >= $numcommits} {
1891 set e [expr {$numcommits - 1}]
1893 if {$e <= $s} continue
1894 set x [lsearch -exact [lindex $rowidlist $e] $id]
1896 puts "findcrossings: oops, no [shortids $id] in row $e"
1899 for {set row $e} {[incr row -1] >= $s} {} {
1900 set olds [lindex $parentlist $row]
1901 set kid [lindex $displayorder $row]
1902 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1903 if {$kidx < 0} continue
1904 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1906 set px [lsearch -exact $nextrow $p]
1907 if {$px < 0} continue
1908 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1909 if {[lsearch -exact $ccross $p] >= 0} continue
1910 if {$x == $px + ($kidx < $px? -1: 1)} {
1912 } elseif {[lsearch -exact $cross $p] < 0} {
1917 set inc [lindex $rowoffsets $row $x]
1918 if {$inc eq {}} break
1922 return [concat $ccross {{}} $cross]
1925 proc assigncolor {id} {
1926 global colormap colors nextcolor
1927 global commitrow parentlist children childlist
1929 if {[info exists colormap($id)]} return
1930 set ncolors [llength $colors]
1931 if {[info exists commitrow($id)]} {
1932 set kids [lindex $childlist $commitrow($id)]
1933 } elseif {[info exists children($id)]} {
1934 set kids $children($id)
1938 if {[llength $kids] == 1} {
1939 set child [lindex $kids 0]
1940 if {[info exists colormap($child)]
1941 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1942 set colormap($id) $colormap($child)
1948 foreach x [findcrossings $id] {
1950 # delimiter between corner crossings and other crossings
1951 if {[llength $badcolors] >= $ncolors - 1} break
1952 set origbad $badcolors
1954 if {[info exists colormap($x)]
1955 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1956 lappend badcolors $colormap($x)
1959 if {[llength $badcolors] >= $ncolors} {
1960 set badcolors $origbad
1962 set origbad $badcolors
1963 if {[llength $badcolors] < $ncolors - 1} {
1964 foreach child $kids {
1965 if {[info exists colormap($child)]
1966 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1967 lappend badcolors $colormap($child)
1969 foreach p [lindex $parentlist $commitrow($child)] {
1970 if {[info exists colormap($p)]
1971 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1972 lappend badcolors $colormap($p)
1976 if {[llength $badcolors] >= $ncolors} {
1977 set badcolors $origbad
1980 for {set i 0} {$i <= $ncolors} {incr i} {
1981 set c [lindex $colors $nextcolor]
1982 if {[incr nextcolor] >= $ncolors} {
1985 if {[lsearch -exact $badcolors $c]} break
1987 set colormap($id) $c
1990 proc bindline {t id} {
1993 $canv bind $t <Enter> "lineenter %x %y $id"
1994 $canv bind $t <Motion> "linemotion %x %y $id"
1995 $canv bind $t <Leave> "lineleave $id"
1996 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1999 proc drawtags {id x xt y1} {
2000 global idtags idheads idotherrefs
2001 global linespc lthickness
2002 global canv mainfont commitrow rowtextx
2007 if {[info exists idtags($id)]} {
2008 set marks $idtags($id)
2009 set ntags [llength $marks]
2011 if {[info exists idheads($id)]} {
2012 set marks [concat $marks $idheads($id)]
2013 set nheads [llength $idheads($id)]
2015 if {[info exists idotherrefs($id)]} {
2016 set marks [concat $marks $idotherrefs($id)]
2022 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2023 set yt [expr {$y1 - 0.5 * $linespc}]
2024 set yb [expr {$yt + $linespc - 1}]
2027 foreach tag $marks {
2028 set wid [font measure $mainfont $tag]
2031 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2033 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2034 -width $lthickness -fill black -tags tag.$id]
2036 foreach tag $marks x $xvals wid $wvals {
2037 set xl [expr {$x + $delta}]
2038 set xr [expr {$x + $delta + $wid + $lthickness}]
2039 if {[incr ntags -1] >= 0} {
2041 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2042 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2043 -width 1 -outline black -fill yellow -tags tag.$id]
2044 $canv bind $t <1> [list showtag $tag 1]
2045 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2047 # draw a head or other ref
2048 if {[incr nheads -1] >= 0} {
2053 set xl [expr {$xl - $delta/2}]
2054 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2055 -width 1 -outline black -fill $col -tags tag.$id
2057 set t [$canv create text $xl $y1 -anchor w -text $tag \
2058 -font $mainfont -tags tag.$id]
2060 $canv bind $t <1> [list showtag $tag 1]
2066 proc xcoord {i level ln} {
2067 global canvx0 xspc1 xspc2
2069 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2070 if {$i > 0 && $i == $level} {
2071 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2072 } elseif {$i > $level} {
2073 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2078 proc finishcommits {} {
2079 global commitidx phase
2080 global canv mainfont ctext maincursor textcursor
2081 global findinprogress pending_select
2083 if {$commitidx > 0} {
2087 $canv create text 3 3 -anchor nw -text "No commits selected" \
2088 -font $mainfont -tags textitems
2090 if {![info exists findinprogress]} {
2091 . config -cursor $maincursor
2092 settextcursor $textcursor
2095 catch {unset pending_select}
2098 # Don't change the text pane cursor if it is currently the hand cursor,
2099 # showing that we are over a sha1 ID link.
2100 proc settextcursor {c} {
2101 global ctext curtextcursor
2103 if {[$ctext cget -cursor] == $curtextcursor} {
2104 $ctext config -cursor $c
2106 set curtextcursor $c
2112 global canvy0 numcommits linespc
2113 global rowlaidout commitidx
2114 global pending_select
2117 layoutrows $rowlaidout $commitidx 1
2119 optimize_rows $row 0 $commitidx
2120 showstuff $commitidx
2121 if {[info exists pending_select]} {
2125 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2126 #puts "overall $drawmsecs ms for $numcommits commits"
2129 proc findmatches {f} {
2130 global findtype foundstring foundstrlen
2131 if {$findtype == "Regexp"} {
2132 set matches [regexp -indices -all -inline $foundstring $f]
2134 if {$findtype == "IgnCase"} {
2135 set str [string tolower $f]
2141 while {[set j [string first $foundstring $str $i]] >= 0} {
2142 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2143 set i [expr {$j + $foundstrlen}]
2150 global findtype findloc findstring markedmatches commitinfo
2151 global numcommits displayorder linehtag linentag linedtag
2152 global mainfont namefont canv canv2 canv3 selectedline
2153 global matchinglines foundstring foundstrlen matchstring
2159 set matchinglines {}
2160 if {$findloc == "Pickaxe"} {
2164 if {$findtype == "IgnCase"} {
2165 set foundstring [string tolower $findstring]
2167 set foundstring $findstring
2169 set foundstrlen [string length $findstring]
2170 if {$foundstrlen == 0} return
2171 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2172 set matchstring "*$matchstring*"
2173 if {$findloc == "Files"} {
2177 if {![info exists selectedline]} {
2180 set oldsel $selectedline
2183 set fldtypes {Headline Author Date Committer CDate Comment}
2185 foreach id $displayorder {
2186 set d $commitdata($id)
2188 if {$findtype == "Regexp"} {
2189 set doesmatch [regexp $foundstring $d]
2190 } elseif {$findtype == "IgnCase"} {
2191 set doesmatch [string match -nocase $matchstring $d]
2193 set doesmatch [string match $matchstring $d]
2195 if {!$doesmatch} continue
2196 if {![info exists commitinfo($id)]} {
2199 set info $commitinfo($id)
2201 foreach f $info ty $fldtypes {
2202 if {$findloc != "All fields" && $findloc != $ty} {
2205 set matches [findmatches $f]
2206 if {$matches == {}} continue
2208 if {$ty == "Headline"} {
2210 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2211 } elseif {$ty == "Author"} {
2213 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2214 } elseif {$ty == "Date"} {
2216 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2220 lappend matchinglines $l
2221 if {!$didsel && $l > $oldsel} {
2227 if {$matchinglines == {}} {
2229 } elseif {!$didsel} {
2230 findselectline [lindex $matchinglines 0]
2234 proc findselectline {l} {
2235 global findloc commentend ctext
2237 if {$findloc == "All fields" || $findloc == "Comments"} {
2238 # highlight the matches in the comments
2239 set f [$ctext get 1.0 $commentend]
2240 set matches [findmatches $f]
2241 foreach match $matches {
2242 set start [lindex $match 0]
2243 set end [expr {[lindex $match 1] + 1}]
2244 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2249 proc findnext {restart} {
2250 global matchinglines selectedline
2251 if {![info exists matchinglines]} {
2257 if {![info exists selectedline]} return
2258 foreach l $matchinglines {
2259 if {$l > $selectedline} {
2268 global matchinglines selectedline
2269 if {![info exists matchinglines]} {
2273 if {![info exists selectedline]} return
2275 foreach l $matchinglines {
2276 if {$l >= $selectedline} break
2280 findselectline $prev
2286 proc findlocchange {name ix op} {
2287 global findloc findtype findtypemenu
2288 if {$findloc == "Pickaxe"} {
2294 $findtypemenu entryconf 1 -state $state
2295 $findtypemenu entryconf 2 -state $state
2298 proc stopfindproc {{done 0}} {
2299 global findprocpid findprocfile findids
2300 global ctext findoldcursor phase maincursor textcursor
2301 global findinprogress
2303 catch {unset findids}
2304 if {[info exists findprocpid]} {
2306 catch {exec kill $findprocpid}
2308 catch {close $findprocfile}
2311 if {[info exists findinprogress]} {
2312 unset findinprogress
2314 . config -cursor $maincursor
2315 settextcursor $textcursor
2320 proc findpatches {} {
2321 global findstring selectedline numcommits
2322 global findprocpid findprocfile
2323 global finddidsel ctext displayorder findinprogress
2324 global findinsertpos
2326 if {$numcommits == 0} return
2328 # make a list of all the ids to search, starting at the one
2329 # after the selected line (if any)
2330 if {[info exists selectedline]} {
2336 for {set i 0} {$i < $numcommits} {incr i} {
2337 if {[incr l] >= $numcommits} {
2340 append inputids [lindex $displayorder $l] "\n"
2344 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2347 error_popup "Error starting search process: $err"
2351 set findinsertpos end
2353 set findprocpid [pid $f]
2354 fconfigure $f -blocking 0
2355 fileevent $f readable readfindproc
2357 . config -cursor watch
2359 set findinprogress 1
2362 proc readfindproc {} {
2363 global findprocfile finddidsel
2364 global commitrow matchinglines findinsertpos
2366 set n [gets $findprocfile line]
2368 if {[eof $findprocfile]} {
2376 if {![regexp {^[0-9a-f]{40}} $line id]} {
2377 error_popup "Can't parse git-diff-tree output: $line"
2381 if {![info exists commitrow($id)]} {
2382 puts stderr "spurious id: $id"
2385 set l $commitrow($id)
2389 proc insertmatch {l id} {
2390 global matchinglines findinsertpos finddidsel
2392 if {$findinsertpos == "end"} {
2393 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2394 set matchinglines [linsert $matchinglines 0 $l]
2397 lappend matchinglines $l
2400 set matchinglines [linsert $matchinglines $findinsertpos $l]
2411 global selectedline numcommits displayorder ctext
2412 global ffileline finddidsel parentlist
2413 global findinprogress findstartline findinsertpos
2414 global treediffs fdiffid fdiffsneeded fdiffpos
2415 global findmergefiles
2417 if {$numcommits == 0} return
2419 if {[info exists selectedline]} {
2420 set l [expr {$selectedline + 1}]
2425 set findstartline $l
2429 set id [lindex $displayorder $l]
2430 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2431 if {![info exists treediffs($id)]} {
2432 append diffsneeded "$id\n"
2433 lappend fdiffsneeded $id
2436 if {[incr l] >= $numcommits} {
2439 if {$l == $findstartline} break
2442 # start off a git-diff-tree process if needed
2443 if {$diffsneeded ne {}} {
2445 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2447 error_popup "Error starting search process: $err"
2450 catch {unset fdiffid}
2452 fconfigure $df -blocking 0
2453 fileevent $df readable [list readfilediffs $df]
2457 set findinsertpos end
2458 set id [lindex $displayorder $l]
2459 . config -cursor watch
2461 set findinprogress 1
2466 proc readfilediffs {df} {
2467 global findid fdiffid fdiffs
2469 set n [gets $df line]
2473 if {[catch {close $df} err]} {
2476 error_popup "Error in git-diff-tree: $err"
2477 } elseif {[info exists findid]} {
2481 error_popup "Couldn't find diffs for $id"
2486 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2487 # start of a new string of diffs
2491 } elseif {[string match ":*" $line]} {
2492 lappend fdiffs [lindex $line 5]
2496 proc donefilediff {} {
2497 global fdiffid fdiffs treediffs findid
2498 global fdiffsneeded fdiffpos
2500 if {[info exists fdiffid]} {
2501 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2502 && $fdiffpos < [llength $fdiffsneeded]} {
2503 # git-diff-tree doesn't output anything for a commit
2504 # which doesn't change anything
2505 set nullid [lindex $fdiffsneeded $fdiffpos]
2506 set treediffs($nullid) {}
2507 if {[info exists findid] && $nullid eq $findid} {
2515 if {![info exists treediffs($fdiffid)]} {
2516 set treediffs($fdiffid) $fdiffs
2518 if {[info exists findid] && $fdiffid eq $findid} {
2526 global findid treediffs parentlist
2527 global ffileline findstartline finddidsel
2528 global displayorder numcommits matchinglines findinprogress
2529 global findmergefiles
2533 set id [lindex $displayorder $l]
2534 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2535 if {![info exists treediffs($id)]} {
2541 foreach f $treediffs($id) {
2542 set x [findmatches $f]
2552 if {[incr l] >= $numcommits} {
2555 if {$l == $findstartline} break
2563 # mark a commit as matching by putting a yellow background
2564 # behind the headline
2565 proc markheadline {l id} {
2566 global canv mainfont linehtag
2569 set bbox [$canv bbox $linehtag($l)]
2570 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2574 # mark the bits of a headline, author or date that match a find string
2575 proc markmatches {canv l str tag matches font} {
2576 set bbox [$canv bbox $tag]
2577 set x0 [lindex $bbox 0]
2578 set y0 [lindex $bbox 1]
2579 set y1 [lindex $bbox 3]
2580 foreach match $matches {
2581 set start [lindex $match 0]
2582 set end [lindex $match 1]
2583 if {$start > $end} continue
2584 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2585 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2586 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2587 [expr {$x0+$xlen+2}] $y1 \
2588 -outline {} -tags matches -fill yellow]
2593 proc unmarkmatches {} {
2594 global matchinglines findids
2595 allcanvs delete matches
2596 catch {unset matchinglines}
2597 catch {unset findids}
2600 proc selcanvline {w x y} {
2601 global canv canvy0 ctext linespc
2603 set ymax [lindex [$canv cget -scrollregion] 3]
2604 if {$ymax == {}} return
2605 set yfrac [lindex [$canv yview] 0]
2606 set y [expr {$y + $yfrac * $ymax}]
2607 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2612 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2618 proc commit_descriptor {p} {
2621 if {[info exists commitinfo($p)]} {
2622 set l [lindex $commitinfo($p) 0]
2627 # append some text to the ctext widget, and make any SHA1 ID
2628 # that we know about be a clickable link.
2629 proc appendwithlinks {text} {
2630 global ctext commitrow linknum
2632 set start [$ctext index "end - 1c"]
2633 $ctext insert end $text
2634 $ctext insert end "\n"
2635 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2639 set linkid [string range $text $s $e]
2640 if {![info exists commitrow($linkid)]} continue
2642 $ctext tag add link "$start + $s c" "$start + $e c"
2643 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2644 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2647 $ctext tag conf link -foreground blue -underline 1
2648 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2649 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2652 proc viewnextline {dir} {
2656 set ymax [lindex [$canv cget -scrollregion] 3]
2657 set wnow [$canv yview]
2658 set wtop [expr {[lindex $wnow 0] * $ymax}]
2659 set newtop [expr {$wtop + $dir * $linespc}]
2662 } elseif {$newtop > $ymax} {
2665 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2668 proc selectline {l isnew} {
2669 global canv canv2 canv3 ctext commitinfo selectedline
2670 global displayorder linehtag linentag linedtag
2671 global canvy0 linespc parentlist childlist
2672 global cflist currentid sha1entry
2673 global commentend idtags linknum
2674 global mergemax numcommits pending_select
2676 catch {unset pending_select}
2679 if {$l < 0 || $l >= $numcommits} return
2680 set y [expr {$canvy0 + $l * $linespc}]
2681 set ymax [lindex [$canv cget -scrollregion] 3]
2682 set ytop [expr {$y - $linespc - 1}]
2683 set ybot [expr {$y + $linespc + 1}]
2684 set wnow [$canv yview]
2685 set wtop [expr {[lindex $wnow 0] * $ymax}]
2686 set wbot [expr {[lindex $wnow 1] * $ymax}]
2687 set wh [expr {$wbot - $wtop}]
2689 if {$ytop < $wtop} {
2690 if {$ybot < $wtop} {
2691 set newtop [expr {$y - $wh / 2.0}]
2694 if {$newtop > $wtop - $linespc} {
2695 set newtop [expr {$wtop - $linespc}]
2698 } elseif {$ybot > $wbot} {
2699 if {$ytop > $wbot} {
2700 set newtop [expr {$y - $wh / 2.0}]
2702 set newtop [expr {$ybot - $wh}]
2703 if {$newtop < $wtop + $linespc} {
2704 set newtop [expr {$wtop + $linespc}]
2708 if {$newtop != $wtop} {
2712 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2716 if {![info exists linehtag($l)]} return
2718 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2719 -tags secsel -fill [$canv cget -selectbackground]]
2721 $canv2 delete secsel
2722 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2723 -tags secsel -fill [$canv2 cget -selectbackground]]
2725 $canv3 delete secsel
2726 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2727 -tags secsel -fill [$canv3 cget -selectbackground]]
2731 addtohistory [list selectline $l 0]
2736 set id [lindex $displayorder $l]
2738 $sha1entry delete 0 end
2739 $sha1entry insert 0 $id
2740 $sha1entry selection from 0
2741 $sha1entry selection to end
2743 $ctext conf -state normal
2744 $ctext delete 0.0 end
2746 $ctext mark set fmark.0 0.0
2747 $ctext mark gravity fmark.0 left
2748 set info $commitinfo($id)
2749 set date [formatdate [lindex $info 2]]
2750 $ctext insert end "Author: [lindex $info 1] $date\n"
2751 set date [formatdate [lindex $info 4]]
2752 $ctext insert end "Committer: [lindex $info 3] $date\n"
2753 if {[info exists idtags($id)]} {
2754 $ctext insert end "Tags:"
2755 foreach tag $idtags($id) {
2756 $ctext insert end " $tag"
2758 $ctext insert end "\n"
2762 set olds [lindex $parentlist $l]
2763 if {[llength $olds] > 1} {
2766 if {$np >= $mergemax} {
2771 $ctext insert end "Parent: " $tag
2772 appendwithlinks [commit_descriptor $p]
2777 append comment "Parent: [commit_descriptor $p]\n"
2781 foreach c [lindex $childlist $l] {
2782 append comment "Child: [commit_descriptor $c]\n"
2785 append comment [lindex $info 5]
2787 # make anything that looks like a SHA1 ID be a clickable link
2788 appendwithlinks $comment
2790 $ctext tag delete Comments
2791 $ctext tag remove found 1.0 end
2792 $ctext conf -state disabled
2793 set commentend [$ctext index "end - 1c"]
2795 $cflist delete 0 end
2796 $cflist insert end "Comments"
2797 if {[llength $olds] <= 1} {
2804 proc selfirstline {} {
2809 proc sellastline {} {
2812 set l [expr {$numcommits - 1}]
2816 proc selnextline {dir} {
2818 if {![info exists selectedline]} return
2819 set l [expr {$selectedline + $dir}]
2824 proc selnextpage {dir} {
2825 global canv linespc selectedline numcommits
2827 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2831 allcanvs yview scroll [expr {$dir * $lpp}] units
2832 if {![info exists selectedline]} return
2833 set l [expr {$selectedline + $dir * $lpp}]
2836 } elseif {$l >= $numcommits} {
2837 set l [expr $numcommits - 1]
2843 proc unselectline {} {
2844 global selectedline currentid
2846 catch {unset selectedline}
2847 catch {unset currentid}
2848 allcanvs delete secsel
2851 proc addtohistory {cmd} {
2852 global history historyindex curview
2854 set elt [list $curview $cmd]
2855 if {$historyindex > 0
2856 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2860 if {$historyindex < [llength $history]} {
2861 set history [lreplace $history $historyindex end $elt]
2863 lappend history $elt
2866 if {$historyindex > 1} {
2867 .ctop.top.bar.leftbut conf -state normal
2869 .ctop.top.bar.leftbut conf -state disabled
2871 .ctop.top.bar.rightbut conf -state disabled
2877 set view [lindex $elt 0]
2878 set cmd [lindex $elt 1]
2879 if {$curview != $view} {
2886 global history historyindex
2888 if {$historyindex > 1} {
2889 incr historyindex -1
2890 godo [lindex $history [expr {$historyindex - 1}]]
2891 .ctop.top.bar.rightbut conf -state normal
2893 if {$historyindex <= 1} {
2894 .ctop.top.bar.leftbut conf -state disabled
2899 global history historyindex
2901 if {$historyindex < [llength $history]} {
2902 set cmd [lindex $history $historyindex]
2905 .ctop.top.bar.leftbut conf -state normal
2907 if {$historyindex >= [llength $history]} {
2908 .ctop.top.bar.rightbut conf -state disabled
2912 proc mergediff {id l} {
2913 global diffmergeid diffopts mdifffd
2914 global difffilestart diffids
2919 catch {unset difffilestart}
2920 # this doesn't seem to actually affect anything...
2921 set env(GIT_DIFF_OPTS) $diffopts
2922 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2923 if {[catch {set mdf [open $cmd r]} err]} {
2924 error_popup "Error getting merge diffs: $err"
2927 fconfigure $mdf -blocking 0
2928 set mdifffd($id) $mdf
2929 set np [llength [lindex $parentlist $l]]
2930 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2931 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2934 proc getmergediffline {mdf id np} {
2935 global diffmergeid ctext cflist nextupdate mergemax
2936 global difffilestart mdifffd
2938 set n [gets $mdf line]
2945 if {![info exists diffmergeid] || $id != $diffmergeid
2946 || $mdf != $mdifffd($id)} {
2949 $ctext conf -state normal
2950 if {[regexp {^diff --cc (.*)} $line match fname]} {
2951 # start of a new file
2952 $ctext insert end "\n"
2953 set here [$ctext index "end - 1c"]
2954 set i [$cflist index end]
2955 $ctext mark set fmark.$i $here
2956 $ctext mark gravity fmark.$i left
2957 set difffilestart([expr {$i-1}]) $here
2958 $cflist insert end $fname
2959 set l [expr {(78 - [string length $fname]) / 2}]
2960 set pad [string range "----------------------------------------" 1 $l]
2961 $ctext insert end "$pad $fname $pad\n" filesep
2962 } elseif {[regexp {^@@} $line]} {
2963 $ctext insert end "$line\n" hunksep
2964 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2967 # parse the prefix - one ' ', '-' or '+' for each parent
2972 for {set j 0} {$j < $np} {incr j} {
2973 set c [string range $line $j $j]
2976 } elseif {$c == "-"} {
2978 } elseif {$c == "+"} {
2987 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2988 # line doesn't appear in result, parents in $minuses have the line
2989 set num [lindex $minuses 0]
2990 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2991 # line appears in result, parents in $pluses don't have the line
2992 lappend tags mresult
2993 set num [lindex $spaces 0]
2996 if {$num >= $mergemax} {
3001 $ctext insert end "$line\n" $tags
3003 $ctext conf -state disabled
3004 if {[clock clicks -milliseconds] >= $nextupdate} {
3006 fileevent $mdf readable {}
3008 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3012 proc startdiff {ids} {
3013 global treediffs diffids treepending diffmergeid
3016 catch {unset diffmergeid}
3017 if {![info exists treediffs($ids)]} {
3018 if {![info exists treepending]} {
3026 proc addtocflist {ids} {
3027 global treediffs cflist
3028 foreach f $treediffs($ids) {
3029 $cflist insert end $f
3034 proc gettreediffs {ids} {
3035 global treediff treepending
3036 set treepending $ids
3039 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3041 fconfigure $gdtf -blocking 0
3042 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3045 proc gettreediffline {gdtf ids} {
3046 global treediff treediffs treepending diffids diffmergeid
3048 set n [gets $gdtf line]
3050 if {![eof $gdtf]} return
3052 set treediffs($ids) $treediff
3054 if {$ids != $diffids} {
3055 if {![info exists diffmergeid]} {
3056 gettreediffs $diffids
3063 set file [lindex $line 5]
3064 lappend treediff $file
3067 proc getblobdiffs {ids} {
3068 global diffopts blobdifffd diffids env curdifftag curtagstart
3069 global difffilestart nextupdate diffinhdr treediffs
3071 set env(GIT_DIFF_OPTS) $diffopts
3072 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3073 if {[catch {set bdf [open $cmd r]} err]} {
3074 puts "error getting diffs: $err"
3078 fconfigure $bdf -blocking 0
3079 set blobdifffd($ids) $bdf
3080 set curdifftag Comments
3082 catch {unset difffilestart}
3083 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3084 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3087 proc getblobdiffline {bdf ids} {
3088 global diffids blobdifffd ctext curdifftag curtagstart
3089 global diffnexthead diffnextnote difffilestart
3090 global nextupdate diffinhdr treediffs
3092 set n [gets $bdf line]
3096 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3097 $ctext tag add $curdifftag $curtagstart end
3102 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3105 $ctext conf -state normal
3106 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3107 # start of a new file
3108 $ctext insert end "\n"
3109 $ctext tag add $curdifftag $curtagstart end
3110 set curtagstart [$ctext index "end - 1c"]
3112 set here [$ctext index "end - 1c"]
3113 set i [lsearch -exact $treediffs($diffids) $fname]
3115 set difffilestart($i) $here
3117 $ctext mark set fmark.$i $here
3118 $ctext mark gravity fmark.$i left
3120 if {$newname != $fname} {
3121 set i [lsearch -exact $treediffs($diffids) $newname]
3123 set difffilestart($i) $here
3125 $ctext mark set fmark.$i $here
3126 $ctext mark gravity fmark.$i left
3129 set curdifftag "f:$fname"
3130 $ctext tag delete $curdifftag
3131 set l [expr {(78 - [string length $header]) / 2}]
3132 set pad [string range "----------------------------------------" 1 $l]
3133 $ctext insert end "$pad $header $pad\n" filesep
3135 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3137 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3139 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3140 $line match f1l f1c f2l f2c rest]} {
3141 $ctext insert end "$line\n" hunksep
3144 set x [string range $line 0 0]
3145 if {$x == "-" || $x == "+"} {
3146 set tag [expr {$x == "+"}]
3147 $ctext insert end "$line\n" d$tag
3148 } elseif {$x == " "} {
3149 $ctext insert end "$line\n"
3150 } elseif {$diffinhdr || $x == "\\"} {
3151 # e.g. "\ No newline at end of file"
3152 $ctext insert end "$line\n" filesep
3154 # Something else we don't recognize
3155 if {$curdifftag != "Comments"} {
3156 $ctext insert end "\n"
3157 $ctext tag add $curdifftag $curtagstart end
3158 set curtagstart [$ctext index "end - 1c"]
3159 set curdifftag Comments
3161 $ctext insert end "$line\n" filesep
3164 $ctext conf -state disabled
3165 if {[clock clicks -milliseconds] >= $nextupdate} {
3167 fileevent $bdf readable {}
3169 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3174 global difffilestart ctext
3175 set here [$ctext index @0,0]
3176 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3177 if {[$ctext compare $difffilestart($i) > $here]} {
3178 if {![info exists pos]
3179 || [$ctext compare $difffilestart($i) < $pos]} {
3180 set pos $difffilestart($i)
3184 if {[info exists pos]} {
3189 proc listboxsel {} {
3190 global ctext cflist currentid
3191 if {![info exists currentid]} return
3192 set sel [lsort [$cflist curselection]]
3193 if {$sel eq {}} return
3194 set first [lindex $sel 0]
3195 catch {$ctext yview fmark.$first}
3199 global linespc charspc canvx0 canvy0 mainfont
3200 global xspc1 xspc2 lthickness
3202 set linespc [font metrics $mainfont -linespace]
3203 set charspc [font measure $mainfont "m"]
3204 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3205 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3206 set lthickness [expr {int($linespc / 9) + 1}]
3207 set xspc1(0) $linespc
3215 set ymax [lindex [$canv cget -scrollregion] 3]
3216 if {$ymax eq {} || $ymax == 0} return
3217 set span [$canv yview]
3220 allcanvs yview moveto [lindex $span 0]
3222 if {[info exists selectedline]} {
3223 selectline $selectedline 0
3227 proc incrfont {inc} {
3228 global mainfont namefont textfont ctext canv phase
3229 global stopped entries
3231 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3232 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3233 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3235 $ctext conf -font $textfont
3236 $ctext tag conf filesep -font [concat $textfont bold]
3237 foreach e $entries {
3238 $e conf -font $mainfont
3240 if {$phase eq "getcommits"} {
3241 $canv itemconf textitems -font $mainfont
3247 global sha1entry sha1string
3248 if {[string length $sha1string] == 40} {
3249 $sha1entry delete 0 end
3253 proc sha1change {n1 n2 op} {
3254 global sha1string currentid sha1but
3255 if {$sha1string == {}
3256 || ([info exists currentid] && $sha1string == $currentid)} {
3261 if {[$sha1but cget -state] == $state} return
3262 if {$state == "normal"} {
3263 $sha1but conf -state normal -relief raised -text "Goto: "
3265 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3269 proc gotocommit {} {
3270 global sha1string currentid commitrow tagids headids
3271 global displayorder numcommits
3273 if {$sha1string == {}
3274 || ([info exists currentid] && $sha1string == $currentid)} return
3275 if {[info exists tagids($sha1string)]} {
3276 set id $tagids($sha1string)
3277 } elseif {[info exists headids($sha1string)]} {
3278 set id $headids($sha1string)
3280 set id [string tolower $sha1string]
3281 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3283 foreach i $displayorder {
3284 if {[string match $id* $i]} {
3288 if {$matches ne {}} {
3289 if {[llength $matches] > 1} {
3290 error_popup "Short SHA1 id $id is ambiguous"
3293 set id [lindex $matches 0]
3297 if {[info exists commitrow($id)]} {
3298 selectline $commitrow($id) 1
3301 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3306 error_popup "$type $sha1string is not known"
3309 proc lineenter {x y id} {
3310 global hoverx hovery hoverid hovertimer
3311 global commitinfo canv
3313 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3317 if {[info exists hovertimer]} {
3318 after cancel $hovertimer
3320 set hovertimer [after 500 linehover]
3324 proc linemotion {x y id} {
3325 global hoverx hovery hoverid hovertimer
3327 if {[info exists hoverid] && $id == $hoverid} {
3330 if {[info exists hovertimer]} {
3331 after cancel $hovertimer
3333 set hovertimer [after 500 linehover]
3337 proc lineleave {id} {
3338 global hoverid hovertimer canv
3340 if {[info exists hoverid] && $id == $hoverid} {
3342 if {[info exists hovertimer]} {
3343 after cancel $hovertimer
3351 global hoverx hovery hoverid hovertimer
3352 global canv linespc lthickness
3353 global commitinfo mainfont
3355 set text [lindex $commitinfo($hoverid) 0]
3356 set ymax [lindex [$canv cget -scrollregion] 3]
3357 if {$ymax == {}} return
3358 set yfrac [lindex [$canv yview] 0]
3359 set x [expr {$hoverx + 2 * $linespc}]
3360 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3361 set x0 [expr {$x - 2 * $lthickness}]
3362 set y0 [expr {$y - 2 * $lthickness}]
3363 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3364 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3365 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3366 -fill \#ffff80 -outline black -width 1 -tags hover]
3368 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3372 proc clickisonarrow {id y} {
3375 set ranges [rowranges $id]
3376 set thresh [expr {2 * $lthickness + 6}]
3377 set n [expr {[llength $ranges] - 1}]
3378 for {set i 1} {$i < $n} {incr i} {
3379 set row [lindex $ranges $i]
3380 if {abs([yc $row] - $y) < $thresh} {
3387 proc arrowjump {id n y} {
3390 # 1 <-> 2, 3 <-> 4, etc...
3391 set n [expr {(($n - 1) ^ 1) + 1}]
3392 set row [lindex [rowranges $id] $n]
3394 set ymax [lindex [$canv cget -scrollregion] 3]
3395 if {$ymax eq {} || $ymax <= 0} return
3396 set view [$canv yview]
3397 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3398 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3402 allcanvs yview moveto $yfrac
3405 proc lineclick {x y id isnew} {
3406 global ctext commitinfo childlist commitrow cflist canv thickerline
3408 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3413 # draw this line thicker than normal
3417 set ymax [lindex [$canv cget -scrollregion] 3]
3418 if {$ymax eq {}} return
3419 set yfrac [lindex [$canv yview] 0]
3420 set y [expr {$y + $yfrac * $ymax}]
3422 set dirn [clickisonarrow $id $y]
3424 arrowjump $id $dirn $y
3429 addtohistory [list lineclick $x $y $id 0]
3431 # fill the details pane with info about this line
3432 $ctext conf -state normal
3433 $ctext delete 0.0 end
3434 $ctext tag conf link -foreground blue -underline 1
3435 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3436 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3437 $ctext insert end "Parent:\t"
3438 $ctext insert end $id [list link link0]
3439 $ctext tag bind link0 <1> [list selbyid $id]
3440 set info $commitinfo($id)
3441 $ctext insert end "\n\t[lindex $info 0]\n"
3442 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3443 set date [formatdate [lindex $info 2]]
3444 $ctext insert end "\tDate:\t$date\n"
3445 set kids [lindex $childlist $commitrow($id)]
3447 $ctext insert end "\nChildren:"
3449 foreach child $kids {
3451 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3452 set info $commitinfo($child)
3453 $ctext insert end "\n\t"
3454 $ctext insert end $child [list link link$i]
3455 $ctext tag bind link$i <1> [list selbyid $child]
3456 $ctext insert end "\n\t[lindex $info 0]"
3457 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3458 set date [formatdate [lindex $info 2]]
3459 $ctext insert end "\n\tDate:\t$date\n"
3462 $ctext conf -state disabled
3464 $cflist delete 0 end
3467 proc normalline {} {
3469 if {[info exists thickerline]} {
3478 if {[info exists commitrow($id)]} {
3479 selectline $commitrow($id) 1
3485 if {![info exists startmstime]} {
3486 set startmstime [clock clicks -milliseconds]
3488 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3491 proc rowmenu {x y id} {
3492 global rowctxmenu commitrow selectedline rowmenuid
3494 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3499 $rowctxmenu entryconfigure 0 -state $state
3500 $rowctxmenu entryconfigure 1 -state $state
3501 $rowctxmenu entryconfigure 2 -state $state
3503 tk_popup $rowctxmenu $x $y
3506 proc diffvssel {dirn} {
3507 global rowmenuid selectedline displayorder
3509 if {![info exists selectedline]} return
3511 set oldid [lindex $displayorder $selectedline]
3512 set newid $rowmenuid
3514 set oldid $rowmenuid
3515 set newid [lindex $displayorder $selectedline]
3517 addtohistory [list doseldiff $oldid $newid]
3518 doseldiff $oldid $newid
3521 proc doseldiff {oldid newid} {
3525 $ctext conf -state normal
3526 $ctext delete 0.0 end
3527 $ctext mark set fmark.0 0.0
3528 $ctext mark gravity fmark.0 left
3529 $cflist delete 0 end
3530 $cflist insert end "Top"
3531 $ctext insert end "From "
3532 $ctext tag conf link -foreground blue -underline 1
3533 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3534 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3535 $ctext tag bind link0 <1> [list selbyid $oldid]
3536 $ctext insert end $oldid [list link link0]
3537 $ctext insert end "\n "
3538 $ctext insert end [lindex $commitinfo($oldid) 0]
3539 $ctext insert end "\n\nTo "
3540 $ctext tag bind link1 <1> [list selbyid $newid]
3541 $ctext insert end $newid [list link link1]
3542 $ctext insert end "\n "
3543 $ctext insert end [lindex $commitinfo($newid) 0]
3544 $ctext insert end "\n"
3545 $ctext conf -state disabled
3546 $ctext tag delete Comments
3547 $ctext tag remove found 1.0 end
3548 startdiff [list $oldid $newid]
3552 global rowmenuid currentid commitinfo patchtop patchnum
3554 if {![info exists currentid]} return
3555 set oldid $currentid
3556 set oldhead [lindex $commitinfo($oldid) 0]
3557 set newid $rowmenuid
3558 set newhead [lindex $commitinfo($newid) 0]
3561 catch {destroy $top}
3563 label $top.title -text "Generate patch"
3564 grid $top.title - -pady 10
3565 label $top.from -text "From:"
3566 entry $top.fromsha1 -width 40 -relief flat
3567 $top.fromsha1 insert 0 $oldid
3568 $top.fromsha1 conf -state readonly
3569 grid $top.from $top.fromsha1 -sticky w
3570 entry $top.fromhead -width 60 -relief flat
3571 $top.fromhead insert 0 $oldhead
3572 $top.fromhead conf -state readonly
3573 grid x $top.fromhead -sticky w
3574 label $top.to -text "To:"
3575 entry $top.tosha1 -width 40 -relief flat
3576 $top.tosha1 insert 0 $newid
3577 $top.tosha1 conf -state readonly
3578 grid $top.to $top.tosha1 -sticky w
3579 entry $top.tohead -width 60 -relief flat
3580 $top.tohead insert 0 $newhead
3581 $top.tohead conf -state readonly
3582 grid x $top.tohead -sticky w
3583 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3584 grid $top.rev x -pady 10
3585 label $top.flab -text "Output file:"
3586 entry $top.fname -width 60
3587 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3589 grid $top.flab $top.fname -sticky w
3591 button $top.buts.gen -text "Generate" -command mkpatchgo
3592 button $top.buts.can -text "Cancel" -command mkpatchcan
3593 grid $top.buts.gen $top.buts.can
3594 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3595 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3596 grid $top.buts - -pady 10 -sticky ew
3600 proc mkpatchrev {} {
3603 set oldid [$patchtop.fromsha1 get]
3604 set oldhead [$patchtop.fromhead get]
3605 set newid [$patchtop.tosha1 get]
3606 set newhead [$patchtop.tohead get]
3607 foreach e [list fromsha1 fromhead tosha1 tohead] \
3608 v [list $newid $newhead $oldid $oldhead] {
3609 $patchtop.$e conf -state normal
3610 $patchtop.$e delete 0 end
3611 $patchtop.$e insert 0 $v
3612 $patchtop.$e conf -state readonly
3619 set oldid [$patchtop.fromsha1 get]
3620 set newid [$patchtop.tosha1 get]
3621 set fname [$patchtop.fname get]
3622 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3623 error_popup "Error creating patch: $err"
3625 catch {destroy $patchtop}
3629 proc mkpatchcan {} {
3632 catch {destroy $patchtop}
3637 global rowmenuid mktagtop commitinfo
3641 catch {destroy $top}
3643 label $top.title -text "Create tag"
3644 grid $top.title - -pady 10
3645 label $top.id -text "ID:"
3646 entry $top.sha1 -width 40 -relief flat
3647 $top.sha1 insert 0 $rowmenuid
3648 $top.sha1 conf -state readonly
3649 grid $top.id $top.sha1 -sticky w
3650 entry $top.head -width 60 -relief flat
3651 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3652 $top.head conf -state readonly
3653 grid x $top.head -sticky w
3654 label $top.tlab -text "Tag name:"
3655 entry $top.tag -width 60
3656 grid $top.tlab $top.tag -sticky w
3658 button $top.buts.gen -text "Create" -command mktaggo
3659 button $top.buts.can -text "Cancel" -command mktagcan
3660 grid $top.buts.gen $top.buts.can
3661 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3662 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3663 grid $top.buts - -pady 10 -sticky ew
3668 global mktagtop env tagids idtags
3670 set id [$mktagtop.sha1 get]
3671 set tag [$mktagtop.tag get]
3673 error_popup "No tag name specified"
3676 if {[info exists tagids($tag)]} {
3677 error_popup "Tag \"$tag\" already exists"
3682 set fname [file join $dir "refs/tags" $tag]
3683 set f [open $fname w]
3687 error_popup "Error creating tag: $err"
3691 set tagids($tag) $id
3692 lappend idtags($id) $tag
3696 proc redrawtags {id} {
3697 global canv linehtag commitrow idpos selectedline
3699 if {![info exists commitrow($id)]} return
3700 drawcmitrow $commitrow($id)
3701 $canv delete tag.$id
3702 set xt [eval drawtags $id $idpos($id)]
3703 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3704 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3705 selectline $selectedline 0
3712 catch {destroy $mktagtop}
3721 proc writecommit {} {
3722 global rowmenuid wrcomtop commitinfo wrcomcmd
3724 set top .writecommit
3726 catch {destroy $top}
3728 label $top.title -text "Write commit to file"
3729 grid $top.title - -pady 10
3730 label $top.id -text "ID:"
3731 entry $top.sha1 -width 40 -relief flat
3732 $top.sha1 insert 0 $rowmenuid
3733 $top.sha1 conf -state readonly
3734 grid $top.id $top.sha1 -sticky w
3735 entry $top.head -width 60 -relief flat
3736 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3737 $top.head conf -state readonly
3738 grid x $top.head -sticky w
3739 label $top.clab -text "Command:"
3740 entry $top.cmd -width 60 -textvariable wrcomcmd
3741 grid $top.clab $top.cmd -sticky w -pady 10
3742 label $top.flab -text "Output file:"
3743 entry $top.fname -width 60
3744 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3745 grid $top.flab $top.fname -sticky w
3747 button $top.buts.gen -text "Write" -command wrcomgo
3748 button $top.buts.can -text "Cancel" -command wrcomcan
3749 grid $top.buts.gen $top.buts.can
3750 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3751 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3752 grid $top.buts - -pady 10 -sticky ew
3759 set id [$wrcomtop.sha1 get]
3760 set cmd "echo $id | [$wrcomtop.cmd get]"
3761 set fname [$wrcomtop.fname get]
3762 if {[catch {exec sh -c $cmd >$fname &} err]} {
3763 error_popup "Error writing commit: $err"
3765 catch {destroy $wrcomtop}
3772 catch {destroy $wrcomtop}
3776 proc listrefs {id} {
3777 global idtags idheads idotherrefs
3780 if {[info exists idtags($id)]} {
3784 if {[info exists idheads($id)]} {
3788 if {[info exists idotherrefs($id)]} {
3789 set z $idotherrefs($id)
3791 return [list $x $y $z]
3794 proc rereadrefs {} {
3795 global idtags idheads idotherrefs
3797 set refids [concat [array names idtags] \
3798 [array names idheads] [array names idotherrefs]]
3799 foreach id $refids {
3800 if {![info exists ref($id)]} {
3801 set ref($id) [listrefs $id]
3805 set refids [lsort -unique [concat $refids [array names idtags] \
3806 [array names idheads] [array names idotherrefs]]]
3807 foreach id $refids {
3808 set v [listrefs $id]
3809 if {![info exists ref($id)] || $ref($id) != $v} {
3815 proc showtag {tag isnew} {
3816 global ctext cflist tagcontents tagids linknum
3819 addtohistory [list showtag $tag 0]
3821 $ctext conf -state normal
3822 $ctext delete 0.0 end
3824 if {[info exists tagcontents($tag)]} {
3825 set text $tagcontents($tag)
3827 set text "Tag: $tag\nId: $tagids($tag)"
3829 appendwithlinks $text
3830 $ctext conf -state disabled
3831 $cflist delete 0 end
3841 global maxwidth maxgraphpct diffopts findmergefiles
3842 global oldprefs prefstop
3846 if {[winfo exists $top]} {
3850 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3851 set oldprefs($v) [set $v]
3854 wm title $top "Gitk preferences"
3855 label $top.ldisp -text "Commit list display options"
3856 grid $top.ldisp - -sticky w -pady 10
3857 label $top.spacer -text " "
3858 label $top.maxwidthl -text "Maximum graph width (lines)" \
3860 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3861 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3862 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3864 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3865 grid x $top.maxpctl $top.maxpct -sticky w
3866 checkbutton $top.findm -variable findmergefiles
3867 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3869 grid $top.findm $top.findml - -sticky w
3870 label $top.ddisp -text "Diff display options"
3871 grid $top.ddisp - -sticky w -pady 10
3872 label $top.diffoptl -text "Options for diff program" \
3874 entry $top.diffopt -width 20 -textvariable diffopts
3875 grid x $top.diffoptl $top.diffopt -sticky w
3877 button $top.buts.ok -text "OK" -command prefsok
3878 button $top.buts.can -text "Cancel" -command prefscan
3879 grid $top.buts.ok $top.buts.can
3880 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3881 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3882 grid $top.buts - - -pady 10 -sticky ew
3886 global maxwidth maxgraphpct diffopts findmergefiles
3887 global oldprefs prefstop
3889 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3890 set $v $oldprefs($v)
3892 catch {destroy $prefstop}
3897 global maxwidth maxgraphpct
3898 global oldprefs prefstop
3900 catch {destroy $prefstop}
3902 if {$maxwidth != $oldprefs(maxwidth)
3903 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3908 proc formatdate {d} {
3909 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3912 # This list of encoding names and aliases is distilled from
3913 # http://www.iana.org/assignments/character-sets.
3914 # Not all of them are supported by Tcl.
3915 set encoding_aliases {
3916 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3917 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3918 { ISO-10646-UTF-1 csISO10646UTF1 }
3919 { ISO_646.basic:1983 ref csISO646basic1983 }
3920 { INVARIANT csINVARIANT }
3921 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3922 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3923 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3924 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3925 { NATS-DANO iso-ir-9-1 csNATSDANO }
3926 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3927 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3928 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3929 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3930 { ISO-2022-KR csISO2022KR }
3932 { ISO-2022-JP csISO2022JP }
3933 { ISO-2022-JP-2 csISO2022JP2 }
3934 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3936 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3937 { IT iso-ir-15 ISO646-IT csISO15Italian }
3938 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3939 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3940 { greek7-old iso-ir-18 csISO18Greek7Old }
3941 { latin-greek iso-ir-19 csISO19LatinGreek }
3942 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3943 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3944 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3945 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3946 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3947 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3948 { INIS iso-ir-49 csISO49INIS }
3949 { INIS-8 iso-ir-50 csISO50INIS8 }
3950 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3951 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3952 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3953 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3954 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3955 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3957 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3958 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3959 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3960 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3961 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3962 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3963 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3964 { greek7 iso-ir-88 csISO88Greek7 }
3965 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3966 { iso-ir-90 csISO90 }
3967 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3968 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3969 csISO92JISC62991984b }
3970 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3971 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3972 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3973 csISO95JIS62291984handadd }
3974 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3975 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3976 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3977 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3979 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3980 { T.61-7bit iso-ir-102 csISO102T617bit }
3981 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3982 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3983 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3984 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3985 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3986 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3987 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3988 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3989 arabic csISOLatinArabic }
3990 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3991 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3992 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3993 greek greek8 csISOLatinGreek }
3994 { T.101-G2 iso-ir-128 csISO128T101G2 }
3995 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3997 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3998 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3999 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4000 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4001 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4002 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4003 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4004 csISOLatinCyrillic }
4005 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4006 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4007 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4008 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4009 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4010 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4011 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4012 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4013 { ISO_10367-box iso-ir-155 csISO10367Box }
4014 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4015 { latin-lap lap iso-ir-158 csISO158Lap }
4016 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4017 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4020 { JIS_X0201 X0201 csHalfWidthKatakana }
4021 { KSC5636 ISO646-KR csKSC5636 }
4022 { ISO-10646-UCS-2 csUnicode }
4023 { ISO-10646-UCS-4 csUCS4 }
4024 { DEC-MCS dec csDECMCS }
4025 { hp-roman8 roman8 r8 csHPRoman8 }
4026 { macintosh mac csMacintosh }
4027 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4029 { IBM038 EBCDIC-INT cp038 csIBM038 }
4030 { IBM273 CP273 csIBM273 }
4031 { IBM274 EBCDIC-BE CP274 csIBM274 }
4032 { IBM275 EBCDIC-BR cp275 csIBM275 }
4033 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4034 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4035 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4036 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4037 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4038 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4039 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4040 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4041 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4042 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4043 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4044 { IBM437 cp437 437 csPC8CodePage437 }
4045 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4046 { IBM775 cp775 csPC775Baltic }
4047 { IBM850 cp850 850 csPC850Multilingual }
4048 { IBM851 cp851 851 csIBM851 }
4049 { IBM852 cp852 852 csPCp852 }
4050 { IBM855 cp855 855 csIBM855 }
4051 { IBM857 cp857 857 csIBM857 }
4052 { IBM860 cp860 860 csIBM860 }
4053 { IBM861 cp861 861 cp-is csIBM861 }
4054 { IBM862 cp862 862 csPC862LatinHebrew }
4055 { IBM863 cp863 863 csIBM863 }
4056 { IBM864 cp864 csIBM864 }
4057 { IBM865 cp865 865 csIBM865 }
4058 { IBM866 cp866 866 csIBM866 }
4059 { IBM868 CP868 cp-ar csIBM868 }
4060 { IBM869 cp869 869 cp-gr csIBM869 }
4061 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4062 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4063 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4064 { IBM891 cp891 csIBM891 }
4065 { IBM903 cp903 csIBM903 }
4066 { IBM904 cp904 904 csIBBM904 }
4067 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4068 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4069 { IBM1026 CP1026 csIBM1026 }
4070 { EBCDIC-AT-DE csIBMEBCDICATDE }
4071 { EBCDIC-AT-DE-A csEBCDICATDEA }
4072 { EBCDIC-CA-FR csEBCDICCAFR }
4073 { EBCDIC-DK-NO csEBCDICDKNO }
4074 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4075 { EBCDIC-FI-SE csEBCDICFISE }
4076 { EBCDIC-FI-SE-A csEBCDICFISEA }
4077 { EBCDIC-FR csEBCDICFR }
4078 { EBCDIC-IT csEBCDICIT }
4079 { EBCDIC-PT csEBCDICPT }
4080 { EBCDIC-ES csEBCDICES }
4081 { EBCDIC-ES-A csEBCDICESA }
4082 { EBCDIC-ES-S csEBCDICESS }
4083 { EBCDIC-UK csEBCDICUK }
4084 { EBCDIC-US csEBCDICUS }
4085 { UNKNOWN-8BIT csUnknown8BiT }
4086 { MNEMONIC csMnemonic }
4091 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4092 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4093 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4094 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4095 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4096 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4097 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4098 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4099 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4100 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4101 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4102 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4103 { IBM1047 IBM-1047 }
4104 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4105 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4106 { UNICODE-1-1 csUnicode11 }
4109 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4110 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4112 { ISO-8859-15 ISO_8859-15 Latin-9 }
4113 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4114 { GBK CP936 MS936 windows-936 }
4115 { JIS_Encoding csJISEncoding }
4116 { Shift_JIS MS_Kanji csShiftJIS }
4117 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4119 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4120 { ISO-10646-UCS-Basic csUnicodeASCII }
4121 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4122 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4123 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4124 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4125 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4126 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4127 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4128 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4129 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4130 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4131 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4132 { Ventura-US csVenturaUS }
4133 { Ventura-International csVenturaInternational }
4134 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4135 { PC8-Turkish csPC8Turkish }
4136 { IBM-Symbols csIBMSymbols }
4137 { IBM-Thai csIBMThai }
4138 { HP-Legal csHPLegal }
4139 { HP-Pi-font csHPPiFont }
4140 { HP-Math8 csHPMath8 }
4141 { Adobe-Symbol-Encoding csHPPSMath }
4142 { HP-DeskTop csHPDesktop }
4143 { Ventura-Math csVenturaMath }
4144 { Microsoft-Publishing csMicrosoftPublishing }
4145 { Windows-31J csWindows31J }
4150 proc tcl_encoding {enc} {
4151 global encoding_aliases
4152 set names [encoding names]
4153 set lcnames [string tolower $names]
4154 set enc [string tolower $enc]
4155 set i [lsearch -exact $lcnames $enc]
4157 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4158 if {[regsub {^iso[-_]} $enc iso encx]} {
4159 set i [lsearch -exact $lcnames $encx]
4163 foreach l $encoding_aliases {
4164 set ll [string tolower $l]
4165 if {[lsearch -exact $ll $enc] < 0} continue
4166 # look through the aliases for one that tcl knows about
4168 set i [lsearch -exact $lcnames $e]
4170 if {[regsub {^iso[-_]} $e iso ex]} {
4171 set i [lsearch -exact $lcnames $ex]
4180 return [lindex $names $i]
4187 set diffopts "-U 5 -p"
4188 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4192 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4194 if {$gitencoding == ""} {
4195 set gitencoding "utf-8"
4197 set tclencoding [tcl_encoding $gitencoding]
4198 if {$tclencoding == {}} {
4199 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4202 set mainfont {Helvetica 9}
4203 set textfont {Courier 9}
4204 set uifont {Helvetica 9 bold}
4205 set findmergefiles 0
4214 set colors {green red blue magenta darkgrey brown orange}
4216 catch {source ~/.gitk}
4218 set namefont $mainfont
4220 font create optionfont -family sans-serif -size -12
4224 switch -regexp -- $arg {
4226 "^-d" { set datemode 1 }
4228 lappend revtreeargs $arg
4233 # check that we can find a .git directory somewhere...
4235 if {![file isdirectory $gitdir]} {
4236 error_popup "Cannot find the git directory \"$gitdir\"."
4255 parse_args $revtreeargs
4256 set args $parsed_args
4257 if {$cmdline_files ne {}} {
4258 # create a view for the files/dirs specified on the command line
4261 set viewname(1) "Command line"
4262 set viewfiles(1) $cmdline_files
4263 .bar.view add command -label $viewname(1) -command {showview 1}
4264 .bar.view entryconf 2 -state normal
4265 set args [concat $args "--" $cmdline_files]