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 getcommits
{rargs
} {
84 global phase canv mainfont
89 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
90 -font $mainfont -tags textitems
93 proc getcommitlines
{commfd
} {
94 global commitlisted nextupdate
96 global displayorder commitidx commitrow commitdata
97 global parentlist childlist children
99 set stuff
[read $commfd]
101 if {![eof
$commfd]} return
102 # set it blocking so we wait for the process to terminate
103 fconfigure
$commfd -blocking 1
104 if {![catch
{close
$commfd} err
]} {
105 after idle finishcommits
108 if {[string range
$err 0 4] == "usage"} {
110 "Gitk: error reading commits: bad arguments to git-rev-list.\
111 (Note: arguments to gitk are passed to git-rev-list\
112 to allow selection of commits to be displayed.)"
114 set err
"Error reading commits: $err"
122 set i
[string first
"\0" $stuff $start]
124 append leftover
[string range
$stuff $start end
]
129 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
132 set cmit
[string range
$stuff $start [expr {$i - 1}]]
134 set start
[expr {$i + 1}]
135 set j
[string first
"\n" $cmit]
139 set ids
[string range
$cmit 0 [expr {$j - 1}]]
140 if {[string range
$ids 0 0] == "-"} {
142 set ids
[string range
$ids 1 end
]
146 if {[string length
$id] != 40} {
154 if {[string length
$shortcmit] > 80} {
155 set shortcmit
"[string range $shortcmit 0 80]..."
157 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
160 set id
[lindex
$ids 0]
162 set olds
[lrange
$ids 1 end
]
165 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
166 lappend children
($p) $id
173 lappend parentlist
$olds
174 if {[info exists children
($id)]} {
175 lappend childlist
$children($id)
179 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
180 set commitrow
($id) $commitidx
182 lappend displayorder
$id
183 lappend commitlisted
$listed
189 if {[clock clicks
-milliseconds] >= $nextupdate} {
194 proc doupdate
{reading
} {
195 global commfd nextupdate numcommits ncmupdate
198 fileevent
$commfd readable
{}
201 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
202 if {$numcommits < 100} {
203 set ncmupdate
[expr {$numcommits + 1}]
204 } elseif
{$numcommits < 10000} {
205 set ncmupdate
[expr {$numcommits + 10}]
207 set ncmupdate
[expr {$numcommits + 100}]
210 fileevent
$commfd readable
[list getcommitlines
$commfd]
214 proc readcommit
{id
} {
215 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
216 parsecommit
$id $contents 0
219 proc updatecommits
{} {
220 global viewdata curview revtreeargs
224 catch
{unset viewdata
($n)}
225 parse_args
$revtreeargs
229 proc parsecommit
{id contents listed
} {
230 global commitinfo cdate
239 set hdrend
[string first
"\n\n" $contents]
241 # should never happen...
242 set hdrend
[string length
$contents]
244 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
245 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
246 foreach line
[split $header "\n"] {
247 set tag
[lindex
$line 0]
248 if {$tag == "author"} {
249 set audate
[lindex
$line end-1
]
250 set auname
[lrange
$line 1 end-2
]
251 } elseif
{$tag == "committer"} {
252 set comdate
[lindex
$line end-1
]
253 set comname
[lrange
$line 1 end-2
]
257 # take the first line of the comment as the headline
258 set i
[string first
"\n" $comment]
260 set headline
[string trim
[string range
$comment 0 $i]]
262 set headline
$comment
265 # git-rev-list indents the comment by 4 spaces;
266 # if we got this via git-cat-file, add the indentation
268 foreach line
[split $comment "\n"] {
269 append newcomment
" "
270 append newcomment
$line
271 append newcomment
"\n"
273 set comment
$newcomment
275 if {$comdate != {}} {
276 set cdate
($id) $comdate
278 set commitinfo
($id) [list
$headline $auname $audate \
279 $comname $comdate $comment]
282 proc getcommit
{id
} {
283 global commitdata commitinfo
285 if {[info exists commitdata
($id)]} {
286 parsecommit
$id $commitdata($id) 1
289 if {![info exists commitinfo
($id)]} {
290 set commitinfo
($id) {"No commit information available"}
297 global tagids idtags headids idheads tagcontents
298 global otherrefids idotherrefs
300 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
303 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
304 while {0 <= [set n
[gets
$refd line
]]} {
305 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
309 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
313 if {$type == "tags"} {
314 set tagids
($name) $id
315 lappend idtags
($id) $name
320 set commit
[exec git-rev-parse
"$id^0"]
321 if {"$commit" != "$id"} {
322 set tagids
($name) $commit
323 lappend idtags
($commit) $name
327 set tagcontents
($name) [exec git-cat-file tag
"$id"]
329 } elseif
{ $type == "heads" } {
330 set headids
($name) $id
331 lappend idheads
($id) $name
333 set otherrefids
($name) $id
334 lappend idotherrefs
($id) $name
340 proc error_popup msg
{
344 message
$w.m
-text $msg -justify center
-aspect 400
345 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
346 button
$w.ok
-text OK
-command "destroy $w"
347 pack
$w.ok
-side bottom
-fill x
348 bind $w <Visibility
> "grab $w; focus $w"
349 bind $w <Key-Return
> "destroy $w"
354 global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont
355 global findtype findtypemenu findloc findstring fstring geometry
356 global entries sha1entry sha1string sha1but
357 global maincursor textcursor curtextcursor
358 global rowctxmenu mergemax
361 .bar add cascade
-label "File" -menu .bar.
file
362 .bar configure
-font $uifont
364 .bar.
file add
command -label "Update" -command updatecommits
365 .bar.
file add
command -label "Reread references" -command rereadrefs
366 .bar.
file add
command -label "Quit" -command doquit
367 .bar.
file configure
-font $uifont
369 .bar add cascade
-label "Edit" -menu .bar.edit
370 .bar.edit add
command -label "Preferences" -command doprefs
371 .bar.edit configure
-font $uifont
373 .bar add cascade
-label "View" -menu .bar.view
374 .bar.view add
command -label "New view..." -command newview
375 .bar.view add
command -label "Delete view" -command delview
-state disabled
376 .bar.view add separator
377 .bar.view add
command -label "All files" -command {showview
0}
379 .bar add cascade
-label "Help" -menu .bar.
help
380 .bar.
help add
command -label "About gitk" -command about
381 .bar.
help add
command -label "Key bindings" -command keys
382 .bar.
help configure
-font $uifont
383 . configure
-menu .bar
385 if {![info exists geometry
(canv1
)]} {
386 set geometry
(canv1
) [expr {45 * $charspc}]
387 set geometry
(canv2
) [expr {30 * $charspc}]
388 set geometry
(canv3
) [expr {15 * $charspc}]
389 set geometry
(canvh
) [expr {25 * $linespc + 4}]
390 set geometry
(ctextw
) 80
391 set geometry
(ctexth
) 30
392 set geometry
(cflistw
) 30
394 panedwindow .ctop
-orient vertical
395 if {[info exists geometry
(width
)]} {
396 .ctop conf
-width $geometry(width
) -height $geometry(height
)
397 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
398 set geometry
(ctexth
) [expr {($texth - 8) /
399 [font metrics
$textfont -linespace]}]
403 pack .ctop.top.bar
-side bottom
-fill x
404 set cscroll .ctop.top.csb
405 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
406 pack
$cscroll -side right
-fill y
407 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
408 pack .ctop.top.clist
-side top
-fill both
-expand 1
410 set canv .ctop.top.clist.canv
411 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
413 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
414 .ctop.top.clist add
$canv
415 set canv2 .ctop.top.clist.canv2
416 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
417 -bg white
-bd 0 -yscrollincr $linespc
418 .ctop.top.clist add
$canv2
419 set canv3 .ctop.top.clist.canv3
420 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
421 -bg white
-bd 0 -yscrollincr $linespc
422 .ctop.top.clist add
$canv3
423 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
425 set sha1entry .ctop.top.bar.sha1
426 set entries
$sha1entry
427 set sha1but .ctop.top.bar.sha1label
428 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
429 -command gotocommit
-width 8 -font $uifont
430 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
431 pack .ctop.top.bar.sha1label
-side left
432 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
433 trace add variable sha1string
write sha1change
434 pack
$sha1entry -side left
-pady 2
436 image create bitmap bm-left
-data {
437 #define left_width 16
438 #define left_height 16
439 static unsigned char left_bits
[] = {
440 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
441 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
442 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
444 image create bitmap bm-right
-data {
445 #define right_width 16
446 #define right_height 16
447 static unsigned char right_bits
[] = {
448 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
449 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
450 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
452 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
453 -state disabled
-width 26
454 pack .ctop.top.bar.leftbut
-side left
-fill y
455 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
456 -state disabled
-width 26
457 pack .ctop.top.bar.rightbut
-side left
-fill y
459 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
460 pack .ctop.top.bar.findbut
-side left
462 set fstring .ctop.top.bar.findstring
463 lappend entries
$fstring
464 entry
$fstring -width 30 -font $textfont -textvariable findstring
-font $textfont
465 pack
$fstring -side left
-expand 1 -fill x
467 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
468 findtype Exact IgnCase Regexp
]
469 .ctop.top.bar.findtype configure
-font $uifont
470 .ctop.top.bar.findtype.menu configure
-font $uifont
471 set findloc
"All fields"
472 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
473 Comments Author Committer Files Pickaxe
474 .ctop.top.bar.findloc configure
-font $uifont
475 .ctop.top.bar.findloc.menu configure
-font $uifont
477 pack .ctop.top.bar.findloc
-side right
478 pack .ctop.top.bar.findtype
-side right
479 # for making sure type==Exact whenever loc==Pickaxe
480 trace add variable findloc
write findlocchange
482 panedwindow .ctop.cdet
-orient horizontal
484 frame .ctop.cdet.left
485 set ctext .ctop.cdet.left.ctext
486 text
$ctext -bg white
-state disabled
-font $textfont \
487 -width $geometry(ctextw
) -height $geometry(ctexth
) \
488 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
489 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
490 pack .ctop.cdet.left.sb
-side right
-fill y
491 pack
$ctext -side left
-fill both
-expand 1
492 .ctop.cdet add .ctop.cdet.left
494 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
495 $ctext tag conf hunksep
-fore blue
496 $ctext tag conf d0
-fore red
497 $ctext tag conf d1
-fore "#00a000"
498 $ctext tag conf m0
-fore red
499 $ctext tag conf m1
-fore blue
500 $ctext tag conf m2
-fore green
501 $ctext tag conf m3
-fore purple
502 $ctext tag conf
m4 -fore brown
503 $ctext tag conf m5
-fore "#009090"
504 $ctext tag conf m6
-fore magenta
505 $ctext tag conf m7
-fore "#808000"
506 $ctext tag conf m8
-fore "#009000"
507 $ctext tag conf m9
-fore "#ff0080"
508 $ctext tag conf m10
-fore cyan
509 $ctext tag conf m11
-fore "#b07070"
510 $ctext tag conf m12
-fore "#70b0f0"
511 $ctext tag conf m13
-fore "#70f0b0"
512 $ctext tag conf m14
-fore "#f0b070"
513 $ctext tag conf m15
-fore "#ff70b0"
514 $ctext tag conf mmax
-fore darkgrey
516 $ctext tag conf mresult
-font [concat
$textfont bold
]
517 $ctext tag conf msep
-font [concat
$textfont bold
]
518 $ctext tag conf found
-back yellow
520 frame .ctop.cdet.right
521 set cflist .ctop.cdet.right.cfiles
522 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
523 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
524 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
525 pack .ctop.cdet.right.sb
-side right
-fill y
526 pack
$cflist -side left
-fill both
-expand 1
527 .ctop.cdet add .ctop.cdet.right
528 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
530 pack .ctop
-side top
-fill both
-expand 1
532 bindall
<1> {selcanvline
%W
%x
%y
}
533 #bindall <B1-Motion> {selcanvline %W %x %y}
534 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
535 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
536 bindall
<2> "canvscan mark %W %x %y"
537 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
538 bindkey
<Home
> selfirstline
539 bindkey
<End
> sellastline
540 bind .
<Key-Up
> "selnextline -1"
541 bind .
<Key-Down
> "selnextline 1"
542 bindkey
<Key-Right
> "goforw"
543 bindkey
<Key-Left
> "goback"
544 bind .
<Key-Prior
> "selnextpage -1"
545 bind .
<Key-Next
> "selnextpage 1"
546 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
547 bind .
<Control-End
> "allcanvs yview moveto 1.0"
548 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
549 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
550 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
551 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
552 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
553 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
554 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
555 bindkey p
"selnextline -1"
556 bindkey n
"selnextline 1"
559 bindkey i
"selnextline -1"
560 bindkey k
"selnextline 1"
563 bindkey b
"$ctext yview scroll -1 pages"
564 bindkey d
"$ctext yview scroll 18 units"
565 bindkey u
"$ctext yview scroll -18 units"
566 bindkey
/ {findnext
1}
567 bindkey
<Key-Return
> {findnext
0}
570 bind .
<Control-q
> doquit
571 bind .
<Control-f
> dofind
572 bind .
<Control-g
> {findnext
0}
573 bind .
<Control-r
> findprev
574 bind .
<Control-equal
> {incrfont
1}
575 bind .
<Control-KP_Add
> {incrfont
1}
576 bind .
<Control-minus
> {incrfont
-1}
577 bind .
<Control-KP_Subtract
> {incrfont
-1}
578 bind $cflist <<ListboxSelect>> listboxsel
579 bind . <Destroy> {savestuff %W}
580 bind . <Button-1> "click %W"
581 bind $fstring <Key-Return> dofind
582 bind $sha1entry <Key-Return> gotocommit
583 bind $sha1entry <<PasteSelection>> clearsha1
585 set maincursor [. cget -cursor]
586 set textcursor [$ctext cget -cursor]
587 set curtextcursor $textcursor
589 set rowctxmenu .rowctxmenu
590 menu $rowctxmenu -tearoff 0
591 $rowctxmenu add command -label "Diff this -> selected" \
592 -command {diffvssel 0}
593 $rowctxmenu add command -label "Diff selected -> this" \
594 -command {diffvssel 1}
595 $rowctxmenu add command -label "Make patch" -command mkpatch
596 $rowctxmenu add command -label "Create tag" -command mktag
597 $rowctxmenu add command -label "Write commit to file" -command writecommit
600 # mouse-2 makes all windows scan vertically, but only the one
601 # the cursor is in scans horizontally
602 proc canvscan {op w x y} {
603 global canv canv2 canv3
604 foreach c [list $canv $canv2 $canv3] {
613 proc scrollcanv {cscroll f0 f1} {
618 # when we make a key binding for the toplevel, make sure
619 # it doesn't get triggered when that key is pressed in the
620 # find string entry widget.
621 proc bindkey {ev script} {
624 set escript [bind Entry $ev]
625 if {$escript == {}} {
626 set escript [bind Entry <Key>]
629 bind $e $ev "$escript; break"
633 # set the focus back to the toplevel for any click outside
644 global canv canv2 canv3 ctext cflist mainfont textfont uifont
645 global stuffsaved findmergefiles maxgraphpct
648 if {$stuffsaved} return
649 if {![winfo viewable .]} return
651 set f [open "~/.gitk-new" w]
652 puts $f [list set mainfont $mainfont]
653 puts $f [list set textfont $textfont]
654 puts $f [list set uifont $uifont]
655 puts $f [list set findmergefiles $findmergefiles]
656 puts $f [list set maxgraphpct $maxgraphpct]
657 puts $f [list set maxwidth $maxwidth]
658 puts $f "set geometry(width) [winfo width .ctop]"
659 puts $f "set geometry(height) [winfo height .ctop]"
660 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
661 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
662 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
663 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
664 set wid [expr {([winfo width $ctext] - 8) \
665 / [font measure $textfont "0"]}]
666 puts $f "set geometry(ctextw) $wid"
667 set wid [expr {([winfo width $cflist] - 11) \
668 / [font measure [$cflist cget -font] "0"]}]
669 puts $f "set geometry(cflistw) $wid"
671 file rename -force "~/.gitk-new" "~/.gitk"
676 proc resizeclistpanes {win w} {
678 if {[info exists oldwidth($win)]} {
679 set s0 [$win sash coord 0]
680 set s1 [$win sash coord 1]
682 set sash0 [expr {int($w/2 - 2)}]
683 set sash1 [expr {int($w*5/6 - 2)}]
685 set factor [expr {1.0 * $w / $oldwidth($win)}]
686 set sash0 [expr {int($factor * [lindex $s0 0])}]
687 set sash1 [expr {int($factor * [lindex $s1 0])}]
691 if {$sash1 < $sash0 + 20} {
692 set sash1 [expr {$sash0 + 20}]
694 if {$sash1 > $w - 10} {
695 set sash1 [expr {$w - 10}]
696 if {$sash0 > $sash1 - 20} {
697 set sash0 [expr {$sash1 - 20}]
701 $win sash place 0 $sash0 [lindex $s0 1]
702 $win sash place 1 $sash1 [lindex $s1 1]
704 set oldwidth($win) $w
707 proc resizecdetpanes {win w} {
709 if {[info exists oldwidth($win)]} {
710 set s0 [$win sash coord 0]
712 set sash0 [expr {int($w*3/4 - 2)}]
714 set factor [expr {1.0 * $w / $oldwidth($win)}]
715 set sash0 [expr {int($factor * [lindex $s0 0])}]
719 if {$sash0 > $w - 15} {
720 set sash0 [expr {$w - 15}]
723 $win sash place 0 $sash0 [lindex $s0 1]
725 set oldwidth($win) $w
729 global canv canv2 canv3
735 proc bindall {event action} {
736 global canv canv2 canv3
737 bind $canv $event $action
738 bind $canv2 $event $action
739 bind $canv3 $event $action
744 if {[winfo exists $w]} {
749 wm title $w "About gitk"
751 Gitk - a commit viewer for git
753 Copyright © 2005-2006 Paul Mackerras
755 Use and redistribute under the terms of the GNU General Public License} \
756 -justify center -aspect 400
757 pack $w.m -side top -fill x -padx 20 -pady 20
758 button $w.ok -text Close -command "destroy $w"
759 pack $w.ok -side bottom
764 if {[winfo exists $w]} {
769 wm title $w "Gitk key bindings"
774 <Home> Move to first commit
775 <End> Move to last commit
776 <Up>, p, i Move up one commit
777 <Down>, n, k Move down one commit
778 <Left>, z, j Go back in history list
779 <Right>, x, l Go forward in history list
780 <PageUp> Move up one page in commit list
781 <PageDown> Move down one page in commit list
782 <Ctrl-Home> Scroll to top of commit list
783 <Ctrl-End> Scroll to bottom of commit list
784 <Ctrl-Up> Scroll commit list up one line
785 <Ctrl-Down> Scroll commit list down one line
786 <Ctrl-PageUp> Scroll commit list up one page
787 <Ctrl-PageDown> Scroll commit list down one page
788 <Delete>, b Scroll diff view up one page
789 <Backspace> Scroll diff view up one page
790 <Space> Scroll diff view down one page
791 u Scroll diff view up 18 lines
792 d Scroll diff view down 18 lines
794 <Ctrl-G> Move to next find hit
795 <Ctrl-R> Move to previous find hit
796 <Return> Move to next find hit
797 / Move to next find hit, or redo find
798 ? Move to previous find hit
799 f Scroll diff view to next file
800 <Ctrl-KP+> Increase font size
801 <Ctrl-plus> Increase font size
802 <Ctrl-KP-> Decrease font size
803 <Ctrl-minus> Decrease font size
805 -justify left -bg white -border 2 -relief sunken
806 pack $w.m -side top -fill both
807 button $w.ok -text Close -command "destroy $w"
808 pack $w.ok -side bottom
812 global newviewname nextviewnum newviewtop
815 if {[winfo exists $top]} {
821 wm title $top "Gitk view definition"
822 label $top.nl -text "Name"
823 entry $top.name -width 20 -textvariable newviewname
824 set newviewname "View $nextviewnum"
825 grid $top.nl $top.name -sticky w
826 label $top.l -text "Files and directories to include:"
827 grid $top.l - -sticky w -pady 10
828 text $top.t -width 30 -height 10
829 grid $top.t - -sticky w
831 button $top.buts.ok -text "OK" -command newviewok
832 button $top.buts.can -text "Cancel" -command newviewcan
833 grid $top.buts.ok $top.buts.can
834 grid columnconfigure $top.buts 0 -weight 1 -uniform a
835 grid columnconfigure $top.buts 1 -weight 1 -uniform a
836 grid $top.buts - -pady 10 -sticky ew
841 global newviewtop nextviewnum
842 global viewname viewfiles
846 set viewname($n) [$newviewtop.name get]
848 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
849 set ft [string trim $f]
854 set viewfiles($n) $files
855 catch {destroy $newviewtop}
857 .bar.view add command -label $viewname($n) -command [list showview $n]
858 after idle showview $n
864 catch {destroy $newviewtop}
869 global curview viewdata
871 if {$curview == 0} return
872 set nmenu [.bar.view index end]
873 set targetcmd [list showview $curview]
874 for {set i 5} {$i <= $nmenu} {incr i} {
875 if {[.bar.view entrycget $i -command] eq $targetcmd} {
880 set viewdata($curview) {}
885 global curview viewdata viewfiles
886 global displayorder parentlist childlist rowidlist rowoffsets
887 global colormap rowtextx commitrow
888 global numcommits rowrangelist commitlisted idrowranges
889 global selectedline currentid canv canvy0
890 global matchinglines treediffs
892 global pending_select phase
894 if {$n == $curview} return
896 if {[info exists selectedline]} {
898 set y [yc $selectedline]
899 set ymax [lindex [$canv cget -scrollregion] 3]
900 set span [$canv yview]
901 set ytop [expr {[lindex $span 0] * $ymax}]
902 set ybot [expr {[lindex $span 1] * $ymax}]
903 if {$ytop < $y && $y < $ybot} {
904 set yscreen [expr {$y - $ytop}]
906 set yscreen [expr {($ybot - $ytop) / 2}]
911 if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
912 set viewdata($curview) \
913 [list $displayorder $parentlist $childlist $rowidlist \
914 $rowoffsets $rowrangelist $commitlisted]
916 catch {unset matchinglines}
917 catch {unset treediffs}
922 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
924 if {![info exists viewdata($n)]} {
925 set args $parsed_args
926 if {$viewfiles($n) ne {}} {
927 set args [concat $args "--" $viewfiles($n)]
929 set pending_select $selid
934 set displayorder [lindex $viewdata($n) 0]
935 set parentlist [lindex $viewdata($n) 1]
936 set childlist [lindex $viewdata($n) 2]
937 set rowidlist [lindex $viewdata($n) 3]
938 set rowoffsets [lindex $viewdata($n) 4]
939 set rowrangelist [lindex $viewdata($n) 5]
940 set commitlisted [lindex $viewdata($n) 6]
941 set numcommits [llength $displayorder]
942 catch {unset colormap}
943 catch {unset rowtextx}
944 catch {unset commitrow}
945 catch {unset idrowranges}
948 foreach id $displayorder {
949 set commitrow($id) $row
955 if {$selid ne {} && [info exists commitrow($selid)]} {
956 set row $commitrow($selid)
957 # try to get the selected row in the same position on the screen
958 set ymax [lindex [$canv cget -scrollregion] 3]
959 set ytop [expr {[yc $row] - $yscreen}]
963 set yf [expr {$ytop * 1.0 / $ymax}]
965 allcanvs yview moveto $yf
970 proc shortids {ids} {
973 if {[llength $id] > 1} {
974 lappend res [shortids $id]
975 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
976 lappend res [string range $id 0 7]
984 proc incrange {l x o} {
989 lset l $x [expr {$e + $o}]
998 for {} {$n > 0} {incr n -1} {
1004 proc usedinrange {id l1 l2} {
1005 global children commitrow
1007 if {[info exists commitrow($id)]} {
1008 set r $commitrow($id)
1009 if {$l1 <= $r && $r <= $l2} {
1010 return [expr {$r - $l1 + 1}]
1013 foreach c $children($id) {
1014 if {[info exists commitrow($c)]} {
1015 set r $commitrow($c)
1016 if {$l1 <= $r && $r <= $l2} {
1017 return [expr {$r - $l1 + 1}]
1024 proc sanity {row {full 0}} {
1025 global rowidlist rowoffsets
1028 set ids [lindex $rowidlist $row]
1031 if {$id eq {}} continue
1032 if {$col < [llength $ids] - 1 &&
1033 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1034 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1036 set o [lindex $rowoffsets $row $col]
1042 if {[lindex $rowidlist $y $x] != $id} {
1043 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1044 puts " id=[shortids $id] check started at row $row"
1045 for {set i $row} {$i >= $y} {incr i -1} {
1046 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1051 set o [lindex $rowoffsets $y $x]
1056 proc makeuparrow {oid x y z} {
1057 global rowidlist rowoffsets uparrowlen idrowranges
1059 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1062 set off0 [lindex $rowoffsets $y]
1063 for {set x0 $x} {1} {incr x0} {
1064 if {$x0 >= [llength $off0]} {
1065 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1068 set z [lindex $off0 $x0]
1074 set z [expr {$x0 - $x}]
1075 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1076 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1078 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1079 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1080 lappend idrowranges($oid) $y
1083 proc initlayout {} {
1084 global rowidlist rowoffsets displayorder commitlisted
1085 global rowlaidout rowoptim
1086 global idinlist rowchk rowrangelist idrowranges
1087 global commitidx numcommits canvxmax canv
1089 global parentlist childlist children
1090 global colormap rowtextx commitrow
1100 catch {unset children}
1104 catch {unset idinlist}
1105 catch {unset rowchk}
1108 set canvxmax [$canv cget -width]
1109 catch {unset colormap}
1110 catch {unset rowtextx}
1111 catch {unset commitrow}
1112 catch {unset idrowranges}
1113 catch {unset linesegends}
1116 proc setcanvscroll {} {
1117 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1119 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1120 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1121 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1122 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1125 proc visiblerows {} {
1126 global canv numcommits linespc
1128 set ymax [lindex [$canv cget -scrollregion] 3]
1129 if {$ymax eq {} || $ymax == 0} return
1131 set y0 [expr {int([lindex $f 0] * $ymax)}]
1132 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1136 set y1 [expr {int([lindex $f 1] * $ymax)}]
1137 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1138 if {$r1 >= $numcommits} {
1139 set r1 [expr {$numcommits - 1}]
1141 return [list $r0 $r1]
1144 proc layoutmore {} {
1145 global rowlaidout rowoptim commitidx numcommits optim_delay
1149 set rowlaidout [layoutrows $row $commitidx 0]
1150 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1151 if {$orow > $rowoptim} {
1152 optimize_rows $rowoptim 0 $orow
1155 set canshow [expr {$rowoptim - $optim_delay}]
1156 if {$canshow > $numcommits} {
1161 proc showstuff {canshow} {
1162 global numcommits commitrow pending_select
1163 global linesegends idrowranges idrangedrawn
1165 if {$numcommits == 0} {
1167 set phase "incrdraw"
1171 set numcommits $canshow
1173 set rows [visiblerows]
1174 set r0 [lindex $rows 0]
1175 set r1 [lindex $rows 1]
1177 for {set r $row} {$r < $canshow} {incr r} {
1178 if {[info exists linesegends($r)]} {
1179 foreach id $linesegends($r) {
1181 foreach {s e} $idrowranges($id) {
1183 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1184 && ![info exists idrangedrawn($id,$i)]} {
1186 set idrangedrawn($id,$i) 1
1192 if {$canshow > $r1} {
1195 while {$row < $canshow} {
1199 if {[info exists pending_select] &&
1200 [info exists commitrow($pending_select)] &&
1201 $commitrow($pending_select) < $numcommits} {
1202 selectline $commitrow($pending_select) 1
1206 proc layoutrows {row endrow last} {
1207 global rowidlist rowoffsets displayorder
1208 global uparrowlen downarrowlen maxwidth mingaplen
1209 global childlist parentlist
1210 global idrowranges linesegends
1212 global idinlist rowchk rowrangelist
1214 set idlist [lindex $rowidlist $row]
1215 set offs [lindex $rowoffsets $row]
1216 while {$row < $endrow} {
1217 set id [lindex $displayorder $row]
1220 foreach p [lindex $parentlist $row] {
1221 if {![info exists idinlist($p)]} {
1223 } elseif {!$idinlist($p)} {
1227 set nev [expr {[llength $idlist] + [llength $newolds]
1228 + [llength $oldolds] - $maxwidth + 1}]
1230 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1231 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1232 set i [lindex $idlist $x]
1233 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1234 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1235 [expr {$row + $uparrowlen + $mingaplen}]]
1237 set idlist [lreplace $idlist $x $x]
1238 set offs [lreplace $offs $x $x]
1239 set offs [incrange $offs $x 1]
1241 set rm1 [expr {$row - 1}]
1242 lappend linesegends($rm1) $i
1243 lappend idrowranges($i) $rm1
1244 if {[incr nev -1] <= 0} break
1247 set rowchk($id) [expr {$row + $r}]
1250 lset rowidlist $row $idlist
1251 lset rowoffsets $row $offs
1253 set col [lsearch -exact $idlist $id]
1255 set col [llength $idlist]
1257 lset rowidlist $row $idlist
1259 if {[lindex $childlist $row] ne {}} {
1260 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1264 lset rowoffsets $row $offs
1266 makeuparrow $id $col $row $z
1272 if {[info exists idrowranges($id)]} {
1273 lappend idrowranges($id) $row
1274 set ranges $idrowranges($id)
1276 lappend rowrangelist $ranges
1278 set offs [ntimes [llength $idlist] 0]
1279 set l [llength $newolds]
1280 set idlist [eval lreplace \$idlist $col $col $newolds]
1283 set offs [lrange $offs 0 [expr {$col - 1}]]
1284 foreach x $newolds {
1289 set tmp [expr {[llength $idlist] - [llength $offs]}]
1291 set offs [concat $offs [ntimes $tmp $o]]
1296 foreach i $newolds {
1298 set idrowranges($i) $row
1301 foreach oid $oldolds {
1302 set idinlist($oid) 1
1303 set idlist [linsert $idlist $col $oid]
1304 set offs [linsert $offs $col $o]
1305 makeuparrow $oid $col $row $o
1308 lappend rowidlist $idlist
1309 lappend rowoffsets $offs
1314 proc addextraid {id row} {
1315 global displayorder commitrow commitinfo
1317 global parentlist childlist children
1320 lappend displayorder $id
1321 lappend parentlist {}
1322 set commitrow($id) $row
1324 if {![info exists commitinfo($id)]} {
1325 set commitinfo($id) {"No commit information available"}
1327 if {[info exists children($id)]} {
1328 lappend childlist $children($id)
1330 lappend childlist {}
1334 proc layouttail {} {
1335 global rowidlist rowoffsets idinlist commitidx
1336 global idrowranges rowrangelist
1339 set idlist [lindex $rowidlist $row]
1340 while {$idlist ne {}} {
1341 set col [expr {[llength $idlist] - 1}]
1342 set id [lindex $idlist $col]
1345 lappend idrowranges($id) $row
1346 lappend rowrangelist $idrowranges($id)
1348 set offs [ntimes $col 0]
1349 set idlist [lreplace $idlist $col $col]
1350 lappend rowidlist $idlist
1351 lappend rowoffsets $offs
1354 foreach id [array names idinlist] {
1356 lset rowidlist $row [list $id]
1357 lset rowoffsets $row 0
1358 makeuparrow $id 0 $row 0
1359 lappend idrowranges($id) $row
1360 lappend rowrangelist $idrowranges($id)
1362 lappend rowidlist {}
1363 lappend rowoffsets {}
1367 proc insert_pad {row col npad} {
1368 global rowidlist rowoffsets
1370 set pad [ntimes $npad {}]
1371 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1372 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1373 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1376 proc optimize_rows {row col endrow} {
1377 global rowidlist rowoffsets idrowranges displayorder
1379 for {} {$row < $endrow} {incr row} {
1380 set idlist [lindex $rowidlist $row]
1381 set offs [lindex $rowoffsets $row]
1383 for {} {$col < [llength $offs]} {incr col} {
1384 if {[lindex $idlist $col] eq {}} {
1388 set z [lindex $offs $col]
1389 if {$z eq {}} continue
1391 set x0 [expr {$col + $z}]
1392 set y0 [expr {$row - 1}]
1393 set z0 [lindex $rowoffsets $y0 $x0]
1395 set id [lindex $idlist $col]
1396 if {[info exists idrowranges($id)] &&
1397 $y0 > [lindex $idrowranges($id) 0]} {
1401 if {$z < -1 || ($z < 0 && $isarrow)} {
1402 set npad [expr {-1 - $z + $isarrow}]
1403 set offs [incrange $offs $col $npad]
1404 insert_pad $y0 $x0 $npad
1406 optimize_rows $y0 $x0 $row
1408 set z [lindex $offs $col]
1409 set x0 [expr {$col + $z}]
1410 set z0 [lindex $rowoffsets $y0 $x0]
1411 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1412 set npad [expr {$z - 1 + $isarrow}]
1413 set y1 [expr {$row + 1}]
1414 set offs2 [lindex $rowoffsets $y1]
1418 if {$z eq {} || $x1 + $z < $col} continue
1419 if {$x1 + $z > $col} {
1422 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1425 set pad [ntimes $npad {}]
1426 set idlist [eval linsert \$idlist $col $pad]
1427 set tmp [eval linsert \$offs $col $pad]
1429 set offs [incrange $tmp $col [expr {-$npad}]]
1430 set z [lindex $offs $col]
1433 if {$z0 eq {} && !$isarrow} {
1434 # this line links to its first child on row $row-2
1435 set rm2 [expr {$row - 2}]
1436 set id [lindex $displayorder $rm2]
1437 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1439 set z0 [expr {$xc - $x0}]
1442 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1443 insert_pad $y0 $x0 1
1444 set offs [incrange $offs $col 1]
1445 optimize_rows $y0 [expr {$x0 + 1}] $row
1450 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1451 set o [lindex $offs $col]
1453 # check if this is the link to the first child
1454 set id [lindex $idlist $col]
1455 if {[info exists idrowranges($id)] &&
1456 $row == [lindex $idrowranges($id) 0]} {
1457 # it is, work out offset to child
1458 set y0 [expr {$row - 1}]
1459 set id [lindex $displayorder $y0]
1460 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1462 set o [expr {$x0 - $col}]
1466 if {$o eq {} || $o <= 0} break
1468 if {$o ne {} && [incr col] < [llength $idlist]} {
1469 set y1 [expr {$row + 1}]
1470 set offs2 [lindex $rowoffsets $y1]
1474 if {$z eq {} || $x1 + $z < $col} continue
1475 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1478 set idlist [linsert $idlist $col {}]
1479 set tmp [linsert $offs $col {}]
1481 set offs [incrange $tmp $col -1]
1484 lset rowidlist $row $idlist
1485 lset rowoffsets $row $offs
1491 global canvx0 linespc
1492 return [expr {$canvx0 + $col * $linespc}]
1496 global canvy0 linespc
1497 return [expr {$canvy0 + $row * $linespc}]
1500 proc linewidth {id} {
1501 global thickerline lthickness
1504 if {[info exists thickerline] && $id eq $thickerline} {
1505 set wid [expr {2 * $lthickness}]
1510 proc rowranges {id} {
1511 global idrowranges commitrow numcommits rowrangelist
1514 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1515 set ranges [lindex $rowrangelist $commitrow($id)]
1516 } elseif {[info exists idrowranges($id)]} {
1517 set ranges $idrowranges($id)
1522 proc drawlineseg {id i} {
1523 global rowoffsets rowidlist
1525 global canv colormap linespc
1526 global numcommits commitrow
1528 set ranges [rowranges $id]
1530 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1531 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1535 set startrow [lindex $ranges [expr {2 * $i}]]
1536 set row [lindex $ranges [expr {2 * $i + 1}]]
1537 if {$startrow == $row} return
1540 set col [lsearch -exact [lindex $rowidlist $row] $id]
1542 puts "oops: drawline: id $id not on row $row"
1548 set o [lindex $rowoffsets $row $col]
1551 # changing direction
1552 set x [xc $row $col]
1554 lappend coords $x $y
1560 set x [xc $row $col]
1562 lappend coords $x $y
1564 # draw the link to the first child as part of this line
1566 set child [lindex $displayorder $row]
1567 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1569 set x [xc $row $ccol]
1571 if {$ccol < $col - 1} {
1572 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1573 } elseif {$ccol > $col + 1} {
1574 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1576 lappend coords $x $y
1579 if {[llength $coords] < 4} return
1581 # This line has an arrow at the lower end: check if the arrow is
1582 # on a diagonal segment, and if so, work around the Tk 8.4
1583 # refusal to draw arrows on diagonal lines.
1584 set x0 [lindex $coords 0]
1585 set x1 [lindex $coords 2]
1587 set y0 [lindex $coords 1]
1588 set y1 [lindex $coords 3]
1589 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1590 # we have a nearby vertical segment, just trim off the diag bit
1591 set coords [lrange $coords 2 end]
1593 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1594 set xi [expr {$x0 - $slope * $linespc / 2}]
1595 set yi [expr {$y0 - $linespc / 2}]
1596 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1600 set arrow [expr {2 * ($i > 0) + $downarrow}]
1601 set arrow [lindex {none first last both} $arrow]
1602 set t [$canv create line $coords -width [linewidth $id] \
1603 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1608 proc drawparentlinks {id row col olds} {
1609 global rowidlist canv colormap
1611 set row2 [expr {$row + 1}]
1612 set x [xc $row $col]
1615 set ids [lindex $rowidlist $row2]
1616 # rmx = right-most X coord used
1619 set i [lsearch -exact $ids $p]
1621 puts "oops, parent $p of $id not in list"
1624 set x2 [xc $row2 $i]
1628 set ranges [rowranges $p]
1629 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1630 && $row2 < [lindex $ranges 1]} {
1631 # drawlineseg will do this one for us
1635 # should handle duplicated parents here...
1636 set coords [list $x $y]
1637 if {$i < $col - 1} {
1638 lappend coords [xc $row [expr {$i + 1}]] $y
1639 } elseif {$i > $col + 1} {
1640 lappend coords [xc $row [expr {$i - 1}]] $y
1642 lappend coords $x2 $y2
1643 set t [$canv create line $coords -width [linewidth $p] \
1644 -fill $colormap($p) -tags lines.$p]
1651 proc drawlines {id} {
1652 global colormap canv
1654 global childlist iddrawn commitrow rowidlist
1656 $canv delete lines.$id
1657 set nr [expr {[llength [rowranges $id]] / 2}]
1658 for {set i 0} {$i < $nr} {incr i} {
1659 if {[info exists idrangedrawn($id,$i)]} {
1663 foreach child [lindex $childlist $commitrow($id)] {
1664 if {[info exists iddrawn($child)]} {
1665 set row $commitrow($child)
1666 set col [lsearch -exact [lindex $rowidlist $row] $child]
1668 drawparentlinks $child $row $col [list $id]
1674 proc drawcmittext {id row col rmx} {
1675 global linespc canv canv2 canv3 canvy0
1676 global commitlisted commitinfo rowidlist
1677 global rowtextx idpos idtags idheads idotherrefs
1678 global linehtag linentag linedtag
1679 global mainfont namefont canvxmax
1681 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1682 set x [xc $row $col]
1684 set orad [expr {$linespc / 3}]
1685 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1686 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1687 -fill $ofill -outline black -width 1]
1689 $canv bind $t <1> {selcanvline {} %x %y}
1690 set xt [xc $row [llength [lindex $rowidlist $row]]]
1694 set rowtextx($row) $xt
1695 set idpos($id) [list $x $xt $y]
1696 if {[info exists idtags($id)] || [info exists idheads($id)]
1697 || [info exists idotherrefs($id)]} {
1698 set xt [drawtags $id $x $xt $y]
1700 set headline [lindex $commitinfo($id) 0]
1701 set name [lindex $commitinfo($id) 1]
1702 set date [lindex $commitinfo($id) 2]
1703 set date [formatdate $date]
1704 set linehtag($row) [$canv create text $xt $y -anchor w \
1705 -text $headline -font $mainfont ]
1706 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1707 set linentag($row) [$canv2 create text 3 $y -anchor w \
1708 -text $name -font $namefont]
1709 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1710 -text $date -font $mainfont]
1711 set xr [expr {$xt + [font measure $mainfont $headline]}]
1712 if {$xr > $canvxmax} {
1718 proc drawcmitrow {row} {
1719 global displayorder rowidlist
1720 global idrangedrawn iddrawn
1721 global commitinfo commitlisted parentlist numcommits
1723 if {$row >= $numcommits} return
1724 foreach id [lindex $rowidlist $row] {
1726 foreach {s e} [rowranges $id] {
1728 if {$row < $s} continue
1731 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1733 set idrangedrawn($id,$i) 1
1740 set id [lindex $displayorder $row]
1741 if {[info exists iddrawn($id)]} return
1742 set col [lsearch -exact [lindex $rowidlist $row] $id]
1744 puts "oops, row $row id $id not in list"
1747 if {![info exists commitinfo($id)]} {
1751 set olds [lindex $parentlist $row]
1753 set rmx [drawparentlinks $id $row $col $olds]
1757 drawcmittext $id $row $col $rmx
1761 proc drawfrac {f0 f1} {
1762 global numcommits canv
1765 set ymax [lindex [$canv cget -scrollregion] 3]
1766 if {$ymax eq {} || $ymax == 0} return
1767 set y0 [expr {int($f0 * $ymax)}]
1768 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1772 set y1 [expr {int($f1 * $ymax)}]
1773 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1774 if {$endrow >= $numcommits} {
1775 set endrow [expr {$numcommits - 1}]
1777 for {} {$row <= $endrow} {incr row} {
1782 proc drawvisible {} {
1784 eval drawfrac [$canv yview]
1787 proc clear_display {} {
1788 global iddrawn idrangedrawn
1791 catch {unset iddrawn}
1792 catch {unset idrangedrawn}
1795 proc findcrossings {id} {
1796 global rowidlist parentlist numcommits rowoffsets displayorder
1800 foreach {s e} [rowranges $id] {
1801 if {$e >= $numcommits} {
1802 set e [expr {$numcommits - 1}]
1804 if {$e <= $s} continue
1805 set x [lsearch -exact [lindex $rowidlist $e] $id]
1807 puts "findcrossings: oops, no [shortids $id] in row $e"
1810 for {set row $e} {[incr row -1] >= $s} {} {
1811 set olds [lindex $parentlist $row]
1812 set kid [lindex $displayorder $row]
1813 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1814 if {$kidx < 0} continue
1815 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1817 set px [lsearch -exact $nextrow $p]
1818 if {$px < 0} continue
1819 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1820 if {[lsearch -exact $ccross $p] >= 0} continue
1821 if {$x == $px + ($kidx < $px? -1: 1)} {
1823 } elseif {[lsearch -exact $cross $p] < 0} {
1828 set inc [lindex $rowoffsets $row $x]
1829 if {$inc eq {}} break
1833 return [concat $ccross {{}} $cross]
1836 proc assigncolor {id} {
1837 global colormap colors nextcolor
1838 global commitrow parentlist children childlist
1840 if {[info exists colormap($id)]} return
1841 set ncolors [llength $colors]
1842 if {[info exists commitrow($id)]} {
1843 set kids [lindex $childlist $commitrow($id)]
1844 } elseif {[info exists children($id)]} {
1845 set kids $children($id)
1849 if {[llength $kids] == 1} {
1850 set child [lindex $kids 0]
1851 if {[info exists colormap($child)]
1852 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1853 set colormap($id) $colormap($child)
1859 foreach x [findcrossings $id] {
1861 # delimiter between corner crossings and other crossings
1862 if {[llength $badcolors] >= $ncolors - 1} break
1863 set origbad $badcolors
1865 if {[info exists colormap($x)]
1866 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1867 lappend badcolors $colormap($x)
1870 if {[llength $badcolors] >= $ncolors} {
1871 set badcolors $origbad
1873 set origbad $badcolors
1874 if {[llength $badcolors] < $ncolors - 1} {
1875 foreach child $kids {
1876 if {[info exists colormap($child)]
1877 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1878 lappend badcolors $colormap($child)
1880 foreach p [lindex $parentlist $commitrow($child)] {
1881 if {[info exists colormap($p)]
1882 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1883 lappend badcolors $colormap($p)
1887 if {[llength $badcolors] >= $ncolors} {
1888 set badcolors $origbad
1891 for {set i 0} {$i <= $ncolors} {incr i} {
1892 set c [lindex $colors $nextcolor]
1893 if {[incr nextcolor] >= $ncolors} {
1896 if {[lsearch -exact $badcolors $c]} break
1898 set colormap($id) $c
1901 proc bindline {t id} {
1904 $canv bind $t <Enter> "lineenter %x %y $id"
1905 $canv bind $t <Motion> "linemotion %x %y $id"
1906 $canv bind $t <Leave> "lineleave $id"
1907 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1910 proc drawtags {id x xt y1} {
1911 global idtags idheads idotherrefs
1912 global linespc lthickness
1913 global canv mainfont commitrow rowtextx
1918 if {[info exists idtags($id)]} {
1919 set marks $idtags($id)
1920 set ntags [llength $marks]
1922 if {[info exists idheads($id)]} {
1923 set marks [concat $marks $idheads($id)]
1924 set nheads [llength $idheads($id)]
1926 if {[info exists idotherrefs($id)]} {
1927 set marks [concat $marks $idotherrefs($id)]
1933 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1934 set yt [expr {$y1 - 0.5 * $linespc}]
1935 set yb [expr {$yt + $linespc - 1}]
1938 foreach tag $marks {
1939 set wid [font measure $mainfont $tag]
1942 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1944 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1945 -width $lthickness -fill black -tags tag.$id]
1947 foreach tag $marks x $xvals wid $wvals {
1948 set xl [expr {$x + $delta}]
1949 set xr [expr {$x + $delta + $wid + $lthickness}]
1950 if {[incr ntags -1] >= 0} {
1952 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1953 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1954 -width 1 -outline black -fill yellow -tags tag.$id]
1955 $canv bind $t <1> [list showtag $tag 1]
1956 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1958 # draw a head or other ref
1959 if {[incr nheads -1] >= 0} {
1964 set xl [expr {$xl - $delta/2}]
1965 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1966 -width 1 -outline black -fill $col -tags tag.$id
1968 set t [$canv create text $xl $y1 -anchor w -text $tag \
1969 -font $mainfont -tags tag.$id]
1971 $canv bind $t <1> [list showtag $tag 1]
1977 proc xcoord {i level ln} {
1978 global canvx0 xspc1 xspc2
1980 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1981 if {$i > 0 && $i == $level} {
1982 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1983 } elseif {$i > $level} {
1984 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1989 proc finishcommits {} {
1990 global commitidx phase
1991 global canv mainfont ctext maincursor textcursor
1992 global findinprogress
1994 if {$commitidx > 0} {
1998 $canv create text 3 3 -anchor nw -text "No commits selected" \
1999 -font $mainfont -tags textitems
2001 if {![info exists findinprogress]} {
2002 . config -cursor $maincursor
2003 settextcursor $textcursor
2008 # Don't change the text pane cursor if it is currently the hand cursor,
2009 # showing that we are over a sha1 ID link.
2010 proc settextcursor {c} {
2011 global ctext curtextcursor
2013 if {[$ctext cget -cursor] == $curtextcursor} {
2014 $ctext config -cursor $c
2016 set curtextcursor $c
2022 global canvy0 numcommits linespc
2023 global rowlaidout commitidx
2026 layoutrows $rowlaidout $commitidx 1
2028 optimize_rows $row 0 $commitidx
2029 showstuff $commitidx
2031 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2032 #puts "overall $drawmsecs ms for $numcommits commits"
2035 proc findmatches {f} {
2036 global findtype foundstring foundstrlen
2037 if {$findtype == "Regexp"} {
2038 set matches [regexp -indices -all -inline $foundstring $f]
2040 if {$findtype == "IgnCase"} {
2041 set str [string tolower $f]
2047 while {[set j [string first $foundstring $str $i]] >= 0} {
2048 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2049 set i [expr {$j + $foundstrlen}]
2056 global findtype findloc findstring markedmatches commitinfo
2057 global numcommits displayorder linehtag linentag linedtag
2058 global mainfont namefont canv canv2 canv3 selectedline
2059 global matchinglines foundstring foundstrlen matchstring
2065 set matchinglines {}
2066 if {$findloc == "Pickaxe"} {
2070 if {$findtype == "IgnCase"} {
2071 set foundstring [string tolower $findstring]
2073 set foundstring $findstring
2075 set foundstrlen [string length $findstring]
2076 if {$foundstrlen == 0} return
2077 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2078 set matchstring "*$matchstring*"
2079 if {$findloc == "Files"} {
2083 if {![info exists selectedline]} {
2086 set oldsel $selectedline
2089 set fldtypes {Headline Author Date Committer CDate Comment}
2091 foreach id $displayorder {
2092 set d $commitdata($id)
2094 if {$findtype == "Regexp"} {
2095 set doesmatch [regexp $foundstring $d]
2096 } elseif {$findtype == "IgnCase"} {
2097 set doesmatch [string match -nocase $matchstring $d]
2099 set doesmatch [string match $matchstring $d]
2101 if {!$doesmatch} continue
2102 if {![info exists commitinfo($id)]} {
2105 set info $commitinfo($id)
2107 foreach f $info ty $fldtypes {
2108 if {$findloc != "All fields" && $findloc != $ty} {
2111 set matches [findmatches $f]
2112 if {$matches == {}} continue
2114 if {$ty == "Headline"} {
2116 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2117 } elseif {$ty == "Author"} {
2119 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2120 } elseif {$ty == "Date"} {
2122 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2126 lappend matchinglines $l
2127 if {!$didsel && $l > $oldsel} {
2133 if {$matchinglines == {}} {
2135 } elseif {!$didsel} {
2136 findselectline [lindex $matchinglines 0]
2140 proc findselectline {l} {
2141 global findloc commentend ctext
2143 if {$findloc == "All fields" || $findloc == "Comments"} {
2144 # highlight the matches in the comments
2145 set f [$ctext get 1.0 $commentend]
2146 set matches [findmatches $f]
2147 foreach match $matches {
2148 set start [lindex $match 0]
2149 set end [expr {[lindex $match 1] + 1}]
2150 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2155 proc findnext {restart} {
2156 global matchinglines selectedline
2157 if {![info exists matchinglines]} {
2163 if {![info exists selectedline]} return
2164 foreach l $matchinglines {
2165 if {$l > $selectedline} {
2174 global matchinglines selectedline
2175 if {![info exists matchinglines]} {
2179 if {![info exists selectedline]} return
2181 foreach l $matchinglines {
2182 if {$l >= $selectedline} break
2186 findselectline $prev
2192 proc findlocchange {name ix op} {
2193 global findloc findtype findtypemenu
2194 if {$findloc == "Pickaxe"} {
2200 $findtypemenu entryconf 1 -state $state
2201 $findtypemenu entryconf 2 -state $state
2204 proc stopfindproc {{done 0}} {
2205 global findprocpid findprocfile findids
2206 global ctext findoldcursor phase maincursor textcursor
2207 global findinprogress
2209 catch {unset findids}
2210 if {[info exists findprocpid]} {
2212 catch {exec kill $findprocpid}
2214 catch {close $findprocfile}
2217 if {[info exists findinprogress]} {
2218 unset findinprogress
2219 if {$phase != "incrdraw"} {
2220 . config -cursor $maincursor
2221 settextcursor $textcursor
2226 proc findpatches {} {
2227 global findstring selectedline numcommits
2228 global findprocpid findprocfile
2229 global finddidsel ctext displayorder findinprogress
2230 global findinsertpos
2232 if {$numcommits == 0} return
2234 # make a list of all the ids to search, starting at the one
2235 # after the selected line (if any)
2236 if {[info exists selectedline]} {
2242 for {set i 0} {$i < $numcommits} {incr i} {
2243 if {[incr l] >= $numcommits} {
2246 append inputids [lindex $displayorder $l] "\n"
2250 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2253 error_popup "Error starting search process: $err"
2257 set findinsertpos end
2259 set findprocpid [pid $f]
2260 fconfigure $f -blocking 0
2261 fileevent $f readable readfindproc
2263 . config -cursor watch
2265 set findinprogress 1
2268 proc readfindproc {} {
2269 global findprocfile finddidsel
2270 global commitrow matchinglines findinsertpos
2272 set n [gets $findprocfile line]
2274 if {[eof $findprocfile]} {
2282 if {![regexp {^[0-9a-f]{40}} $line id]} {
2283 error_popup "Can't parse git-diff-tree output: $line"
2287 if {![info exists commitrow($id)]} {
2288 puts stderr "spurious id: $id"
2291 set l $commitrow($id)
2295 proc insertmatch {l id} {
2296 global matchinglines findinsertpos finddidsel
2298 if {$findinsertpos == "end"} {
2299 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2300 set matchinglines [linsert $matchinglines 0 $l]
2303 lappend matchinglines $l
2306 set matchinglines [linsert $matchinglines $findinsertpos $l]
2317 global selectedline numcommits displayorder ctext
2318 global ffileline finddidsel parentlist
2319 global findinprogress findstartline findinsertpos
2320 global treediffs fdiffid fdiffsneeded fdiffpos
2321 global findmergefiles
2323 if {$numcommits == 0} return
2325 if {[info exists selectedline]} {
2326 set l [expr {$selectedline + 1}]
2331 set findstartline $l
2335 set id [lindex $displayorder $l]
2336 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2337 if {![info exists treediffs($id)]} {
2338 append diffsneeded "$id\n"
2339 lappend fdiffsneeded $id
2342 if {[incr l] >= $numcommits} {
2345 if {$l == $findstartline} break
2348 # start off a git-diff-tree process if needed
2349 if {$diffsneeded ne {}} {
2351 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2353 error_popup "Error starting search process: $err"
2356 catch {unset fdiffid}
2358 fconfigure $df -blocking 0
2359 fileevent $df readable [list readfilediffs $df]
2363 set findinsertpos end
2364 set id [lindex $displayorder $l]
2365 . config -cursor watch
2367 set findinprogress 1
2372 proc readfilediffs {df} {
2373 global findid fdiffid fdiffs
2375 set n [gets $df line]
2379 if {[catch {close $df} err]} {
2382 error_popup "Error in git-diff-tree: $err"
2383 } elseif {[info exists findid]} {
2387 error_popup "Couldn't find diffs for $id"
2392 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2393 # start of a new string of diffs
2397 } elseif {[string match ":*" $line]} {
2398 lappend fdiffs [lindex $line 5]
2402 proc donefilediff {} {
2403 global fdiffid fdiffs treediffs findid
2404 global fdiffsneeded fdiffpos
2406 if {[info exists fdiffid]} {
2407 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2408 && $fdiffpos < [llength $fdiffsneeded]} {
2409 # git-diff-tree doesn't output anything for a commit
2410 # which doesn't change anything
2411 set nullid [lindex $fdiffsneeded $fdiffpos]
2412 set treediffs($nullid) {}
2413 if {[info exists findid] && $nullid eq $findid} {
2421 if {![info exists treediffs($fdiffid)]} {
2422 set treediffs($fdiffid) $fdiffs
2424 if {[info exists findid] && $fdiffid eq $findid} {
2432 global findid treediffs parentlist
2433 global ffileline findstartline finddidsel
2434 global displayorder numcommits matchinglines findinprogress
2435 global findmergefiles
2439 set id [lindex $displayorder $l]
2440 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2441 if {![info exists treediffs($id)]} {
2447 foreach f $treediffs($id) {
2448 set x [findmatches $f]
2458 if {[incr l] >= $numcommits} {
2461 if {$l == $findstartline} break
2469 # mark a commit as matching by putting a yellow background
2470 # behind the headline
2471 proc markheadline {l id} {
2472 global canv mainfont linehtag
2475 set bbox [$canv bbox $linehtag($l)]
2476 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2480 # mark the bits of a headline, author or date that match a find string
2481 proc markmatches {canv l str tag matches font} {
2482 set bbox [$canv bbox $tag]
2483 set x0 [lindex $bbox 0]
2484 set y0 [lindex $bbox 1]
2485 set y1 [lindex $bbox 3]
2486 foreach match $matches {
2487 set start [lindex $match 0]
2488 set end [lindex $match 1]
2489 if {$start > $end} continue
2490 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2491 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2492 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2493 [expr {$x0+$xlen+2}] $y1 \
2494 -outline {} -tags matches -fill yellow]
2499 proc unmarkmatches {} {
2500 global matchinglines findids
2501 allcanvs delete matches
2502 catch {unset matchinglines}
2503 catch {unset findids}
2506 proc selcanvline {w x y} {
2507 global canv canvy0 ctext linespc
2509 set ymax [lindex [$canv cget -scrollregion] 3]
2510 if {$ymax == {}} return
2511 set yfrac [lindex [$canv yview] 0]
2512 set y [expr {$y + $yfrac * $ymax}]
2513 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2518 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2524 proc commit_descriptor {p} {
2527 if {[info exists commitinfo($p)]} {
2528 set l [lindex $commitinfo($p) 0]
2533 # append some text to the ctext widget, and make any SHA1 ID
2534 # that we know about be a clickable link.
2535 proc appendwithlinks {text} {
2536 global ctext commitrow linknum
2538 set start [$ctext index "end - 1c"]
2539 $ctext insert end $text
2540 $ctext insert end "\n"
2541 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2545 set linkid [string range $text $s $e]
2546 if {![info exists commitrow($linkid)]} continue
2548 $ctext tag add link "$start + $s c" "$start + $e c"
2549 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2550 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2553 $ctext tag conf link -foreground blue -underline 1
2554 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2555 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2558 proc viewnextline {dir} {
2562 set ymax [lindex [$canv cget -scrollregion] 3]
2563 set wnow [$canv yview]
2564 set wtop [expr {[lindex $wnow 0] * $ymax}]
2565 set newtop [expr {$wtop + $dir * $linespc}]
2568 } elseif {$newtop > $ymax} {
2571 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2574 proc selectline {l isnew} {
2575 global canv canv2 canv3 ctext commitinfo selectedline
2576 global displayorder linehtag linentag linedtag
2577 global canvy0 linespc parentlist childlist
2578 global cflist currentid sha1entry
2579 global commentend idtags linknum
2580 global mergemax numcommits pending_select
2582 catch {unset pending_select}
2585 if {$l < 0 || $l >= $numcommits} return
2586 set y [expr {$canvy0 + $l * $linespc}]
2587 set ymax [lindex [$canv cget -scrollregion] 3]
2588 set ytop [expr {$y - $linespc - 1}]
2589 set ybot [expr {$y + $linespc + 1}]
2590 set wnow [$canv yview]
2591 set wtop [expr {[lindex $wnow 0] * $ymax}]
2592 set wbot [expr {[lindex $wnow 1] * $ymax}]
2593 set wh [expr {$wbot - $wtop}]
2595 if {$ytop < $wtop} {
2596 if {$ybot < $wtop} {
2597 set newtop [expr {$y - $wh / 2.0}]
2600 if {$newtop > $wtop - $linespc} {
2601 set newtop [expr {$wtop - $linespc}]
2604 } elseif {$ybot > $wbot} {
2605 if {$ytop > $wbot} {
2606 set newtop [expr {$y - $wh / 2.0}]
2608 set newtop [expr {$ybot - $wh}]
2609 if {$newtop < $wtop + $linespc} {
2610 set newtop [expr {$wtop + $linespc}]
2614 if {$newtop != $wtop} {
2618 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2622 if {![info exists linehtag($l)]} return
2624 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2625 -tags secsel -fill [$canv cget -selectbackground]]
2627 $canv2 delete secsel
2628 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2629 -tags secsel -fill [$canv2 cget -selectbackground]]
2631 $canv3 delete secsel
2632 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2633 -tags secsel -fill [$canv3 cget -selectbackground]]
2637 addtohistory [list selectline $l 0]
2642 set id [lindex $displayorder $l]
2644 $sha1entry delete 0 end
2645 $sha1entry insert 0 $id
2646 $sha1entry selection from 0
2647 $sha1entry selection to end
2649 $ctext conf -state normal
2650 $ctext delete 0.0 end
2652 $ctext mark set fmark.0 0.0
2653 $ctext mark gravity fmark.0 left
2654 set info $commitinfo($id)
2655 set date [formatdate [lindex $info 2]]
2656 $ctext insert end "Author: [lindex $info 1] $date\n"
2657 set date [formatdate [lindex $info 4]]
2658 $ctext insert end "Committer: [lindex $info 3] $date\n"
2659 if {[info exists idtags($id)]} {
2660 $ctext insert end "Tags:"
2661 foreach tag $idtags($id) {
2662 $ctext insert end " $tag"
2664 $ctext insert end "\n"
2668 set olds [lindex $parentlist $l]
2669 if {[llength $olds] > 1} {
2672 if {$np >= $mergemax} {
2677 $ctext insert end "Parent: " $tag
2678 appendwithlinks [commit_descriptor $p]
2683 append comment "Parent: [commit_descriptor $p]\n"
2687 foreach c [lindex $childlist $l] {
2688 append comment "Child: [commit_descriptor $c]\n"
2691 append comment [lindex $info 5]
2693 # make anything that looks like a SHA1 ID be a clickable link
2694 appendwithlinks $comment
2696 $ctext tag delete Comments
2697 $ctext tag remove found 1.0 end
2698 $ctext conf -state disabled
2699 set commentend [$ctext index "end - 1c"]
2701 $cflist delete 0 end
2702 $cflist insert end "Comments"
2703 if {[llength $olds] <= 1} {
2710 proc selfirstline {} {
2715 proc sellastline {} {
2718 set l [expr {$numcommits - 1}]
2722 proc selnextline {dir} {
2724 if {![info exists selectedline]} return
2725 set l [expr {$selectedline + $dir}]
2730 proc selnextpage {dir} {
2731 global canv linespc selectedline numcommits
2733 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2737 allcanvs yview scroll [expr {$dir * $lpp}] units
2738 if {![info exists selectedline]} return
2739 set l [expr {$selectedline + $dir * $lpp}]
2742 } elseif {$l >= $numcommits} {
2743 set l [expr $numcommits - 1]
2749 proc unselectline {} {
2750 global selectedline currentid
2752 catch {unset selectedline}
2753 catch {unset currentid}
2754 allcanvs delete secsel
2757 proc addtohistory {cmd} {
2758 global history historyindex
2760 if {$historyindex > 0
2761 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2765 if {$historyindex < [llength $history]} {
2766 set history [lreplace $history $historyindex end $cmd]
2768 lappend history $cmd
2771 if {$historyindex > 1} {
2772 .ctop.top.bar.leftbut conf -state normal
2774 .ctop.top.bar.leftbut conf -state disabled
2776 .ctop.top.bar.rightbut conf -state disabled
2780 global history historyindex
2782 if {$historyindex > 1} {
2783 incr historyindex -1
2784 set cmd [lindex $history [expr {$historyindex - 1}]]
2786 .ctop.top.bar.rightbut conf -state normal
2788 if {$historyindex <= 1} {
2789 .ctop.top.bar.leftbut conf -state disabled
2794 global history historyindex
2796 if {$historyindex < [llength $history]} {
2797 set cmd [lindex $history $historyindex]
2800 .ctop.top.bar.leftbut conf -state normal
2802 if {$historyindex >= [llength $history]} {
2803 .ctop.top.bar.rightbut conf -state disabled
2807 proc mergediff {id l} {
2808 global diffmergeid diffopts mdifffd
2809 global difffilestart diffids
2814 catch {unset difffilestart}
2815 # this doesn't seem to actually affect anything...
2816 set env(GIT_DIFF_OPTS) $diffopts
2817 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2818 if {[catch {set mdf [open $cmd r]} err]} {
2819 error_popup "Error getting merge diffs: $err"
2822 fconfigure $mdf -blocking 0
2823 set mdifffd($id) $mdf
2824 set np [llength [lindex $parentlist $l]]
2825 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2826 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2829 proc getmergediffline {mdf id np} {
2830 global diffmergeid ctext cflist nextupdate mergemax
2831 global difffilestart mdifffd
2833 set n [gets $mdf line]
2840 if {![info exists diffmergeid] || $id != $diffmergeid
2841 || $mdf != $mdifffd($id)} {
2844 $ctext conf -state normal
2845 if {[regexp {^diff --cc (.*)} $line match fname]} {
2846 # start of a new file
2847 $ctext insert end "\n"
2848 set here [$ctext index "end - 1c"]
2849 set i [$cflist index end]
2850 $ctext mark set fmark.$i $here
2851 $ctext mark gravity fmark.$i left
2852 set difffilestart([expr {$i-1}]) $here
2853 $cflist insert end $fname
2854 set l [expr {(78 - [string length $fname]) / 2}]
2855 set pad [string range "----------------------------------------" 1 $l]
2856 $ctext insert end "$pad $fname $pad\n" filesep
2857 } elseif {[regexp {^@@} $line]} {
2858 $ctext insert end "$line\n" hunksep
2859 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2862 # parse the prefix - one ' ', '-' or '+' for each parent
2867 for {set j 0} {$j < $np} {incr j} {
2868 set c [string range $line $j $j]
2871 } elseif {$c == "-"} {
2873 } elseif {$c == "+"} {
2882 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2883 # line doesn't appear in result, parents in $minuses have the line
2884 set num [lindex $minuses 0]
2885 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2886 # line appears in result, parents in $pluses don't have the line
2887 lappend tags mresult
2888 set num [lindex $spaces 0]
2891 if {$num >= $mergemax} {
2896 $ctext insert end "$line\n" $tags
2898 $ctext conf -state disabled
2899 if {[clock clicks -milliseconds] >= $nextupdate} {
2901 fileevent $mdf readable {}
2903 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2907 proc startdiff {ids} {
2908 global treediffs diffids treepending diffmergeid
2911 catch {unset diffmergeid}
2912 if {![info exists treediffs($ids)]} {
2913 if {![info exists treepending]} {
2921 proc addtocflist {ids} {
2922 global treediffs cflist
2923 foreach f $treediffs($ids) {
2924 $cflist insert end $f
2929 proc gettreediffs {ids} {
2930 global treediff treepending
2931 set treepending $ids
2934 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2936 fconfigure $gdtf -blocking 0
2937 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2940 proc gettreediffline {gdtf ids} {
2941 global treediff treediffs treepending diffids diffmergeid
2943 set n [gets $gdtf line]
2945 if {![eof $gdtf]} return
2947 set treediffs($ids) $treediff
2949 if {$ids != $diffids} {
2950 if {![info exists diffmergeid]} {
2951 gettreediffs $diffids
2958 set file [lindex $line 5]
2959 lappend treediff $file
2962 proc getblobdiffs {ids} {
2963 global diffopts blobdifffd diffids env curdifftag curtagstart
2964 global difffilestart nextupdate diffinhdr treediffs
2966 set env(GIT_DIFF_OPTS) $diffopts
2967 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2968 if {[catch {set bdf [open $cmd r]} err]} {
2969 puts "error getting diffs: $err"
2973 fconfigure $bdf -blocking 0
2974 set blobdifffd($ids) $bdf
2975 set curdifftag Comments
2977 catch {unset difffilestart}
2978 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2979 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2982 proc getblobdiffline {bdf ids} {
2983 global diffids blobdifffd ctext curdifftag curtagstart
2984 global diffnexthead diffnextnote difffilestart
2985 global nextupdate diffinhdr treediffs
2987 set n [gets $bdf line]
2991 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2992 $ctext tag add $curdifftag $curtagstart end
2997 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3000 $ctext conf -state normal
3001 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3002 # start of a new file
3003 $ctext insert end "\n"
3004 $ctext tag add $curdifftag $curtagstart end
3005 set curtagstart [$ctext index "end - 1c"]
3007 set here [$ctext index "end - 1c"]
3008 set i [lsearch -exact $treediffs($diffids) $fname]
3010 set difffilestart($i) $here
3012 $ctext mark set fmark.$i $here
3013 $ctext mark gravity fmark.$i left
3015 if {$newname != $fname} {
3016 set i [lsearch -exact $treediffs($diffids) $newname]
3018 set difffilestart($i) $here
3020 $ctext mark set fmark.$i $here
3021 $ctext mark gravity fmark.$i left
3024 set curdifftag "f:$fname"
3025 $ctext tag delete $curdifftag
3026 set l [expr {(78 - [string length $header]) / 2}]
3027 set pad [string range "----------------------------------------" 1 $l]
3028 $ctext insert end "$pad $header $pad\n" filesep
3030 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3032 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3034 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3035 $line match f1l f1c f2l f2c rest]} {
3036 $ctext insert end "$line\n" hunksep
3039 set x [string range $line 0 0]
3040 if {$x == "-" || $x == "+"} {
3041 set tag [expr {$x == "+"}]
3042 $ctext insert end "$line\n" d$tag
3043 } elseif {$x == " "} {
3044 $ctext insert end "$line\n"
3045 } elseif {$diffinhdr || $x == "\\"} {
3046 # e.g. "\ No newline at end of file"
3047 $ctext insert end "$line\n" filesep
3049 # Something else we don't recognize
3050 if {$curdifftag != "Comments"} {
3051 $ctext insert end "\n"
3052 $ctext tag add $curdifftag $curtagstart end
3053 set curtagstart [$ctext index "end - 1c"]
3054 set curdifftag Comments
3056 $ctext insert end "$line\n" filesep
3059 $ctext conf -state disabled
3060 if {[clock clicks -milliseconds] >= $nextupdate} {
3062 fileevent $bdf readable {}
3064 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3069 global difffilestart ctext
3070 set here [$ctext index @0,0]
3071 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3072 if {[$ctext compare $difffilestart($i) > $here]} {
3073 if {![info exists pos]
3074 || [$ctext compare $difffilestart($i) < $pos]} {
3075 set pos $difffilestart($i)
3079 if {[info exists pos]} {
3084 proc listboxsel {} {
3085 global ctext cflist currentid
3086 if {![info exists currentid]} return
3087 set sel [lsort [$cflist curselection]]
3088 if {$sel eq {}} return
3089 set first [lindex $sel 0]
3090 catch {$ctext yview fmark.$first}
3094 global linespc charspc canvx0 canvy0 mainfont
3095 global xspc1 xspc2 lthickness
3097 set linespc [font metrics $mainfont -linespace]
3098 set charspc [font measure $mainfont "m"]
3099 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3100 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3101 set lthickness [expr {int($linespc / 9) + 1}]
3102 set xspc1(0) $linespc
3110 set ymax [lindex [$canv cget -scrollregion] 3]
3111 if {$ymax eq {} || $ymax == 0} return
3112 set span [$canv yview]
3115 allcanvs yview moveto [lindex $span 0]
3117 if {[info exists selectedline]} {
3118 selectline $selectedline 0
3122 proc incrfont {inc} {
3123 global mainfont namefont textfont ctext canv phase
3124 global stopped entries
3126 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3127 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3128 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3130 $ctext conf -font $textfont
3131 $ctext tag conf filesep -font [concat $textfont bold]
3132 foreach e $entries {
3133 $e conf -font $mainfont
3135 if {$phase == "getcommits"} {
3136 $canv itemconf textitems -font $mainfont
3142 global sha1entry sha1string
3143 if {[string length $sha1string] == 40} {
3144 $sha1entry delete 0 end
3148 proc sha1change {n1 n2 op} {
3149 global sha1string currentid sha1but
3150 if {$sha1string == {}
3151 || ([info exists currentid] && $sha1string == $currentid)} {
3156 if {[$sha1but cget -state] == $state} return
3157 if {$state == "normal"} {
3158 $sha1but conf -state normal -relief raised -text "Goto: "
3160 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3164 proc gotocommit {} {
3165 global sha1string currentid commitrow tagids headids
3166 global displayorder numcommits
3168 if {$sha1string == {}
3169 || ([info exists currentid] && $sha1string == $currentid)} return
3170 if {[info exists tagids($sha1string)]} {
3171 set id $tagids($sha1string)
3172 } elseif {[info exists headids($sha1string)]} {
3173 set id $headids($sha1string)
3175 set id [string tolower $sha1string]
3176 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3178 foreach i $displayorder {
3179 if {[string match $id* $i]} {
3183 if {$matches ne {}} {
3184 if {[llength $matches] > 1} {
3185 error_popup "Short SHA1 id $id is ambiguous"
3188 set id [lindex $matches 0]
3192 if {[info exists commitrow($id)]} {
3193 selectline $commitrow($id) 1
3196 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3201 error_popup "$type $sha1string is not known"
3204 proc lineenter {x y id} {
3205 global hoverx hovery hoverid hovertimer
3206 global commitinfo canv
3208 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3212 if {[info exists hovertimer]} {
3213 after cancel $hovertimer
3215 set hovertimer [after 500 linehover]
3219 proc linemotion {x y id} {
3220 global hoverx hovery hoverid hovertimer
3222 if {[info exists hoverid] && $id == $hoverid} {
3225 if {[info exists hovertimer]} {
3226 after cancel $hovertimer
3228 set hovertimer [after 500 linehover]
3232 proc lineleave {id} {
3233 global hoverid hovertimer canv
3235 if {[info exists hoverid] && $id == $hoverid} {
3237 if {[info exists hovertimer]} {
3238 after cancel $hovertimer
3246 global hoverx hovery hoverid hovertimer
3247 global canv linespc lthickness
3248 global commitinfo mainfont
3250 set text [lindex $commitinfo($hoverid) 0]
3251 set ymax [lindex [$canv cget -scrollregion] 3]
3252 if {$ymax == {}} return
3253 set yfrac [lindex [$canv yview] 0]
3254 set x [expr {$hoverx + 2 * $linespc}]
3255 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3256 set x0 [expr {$x - 2 * $lthickness}]
3257 set y0 [expr {$y - 2 * $lthickness}]
3258 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3259 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3260 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3261 -fill \#ffff80 -outline black -width 1 -tags hover]
3263 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3267 proc clickisonarrow {id y} {
3270 set ranges [rowranges $id]
3271 set thresh [expr {2 * $lthickness + 6}]
3272 set n [expr {[llength $ranges] - 1}]
3273 for {set i 1} {$i < $n} {incr i} {
3274 set row [lindex $ranges $i]
3275 if {abs([yc $row] - $y) < $thresh} {
3282 proc arrowjump {id n y} {
3285 # 1 <-> 2, 3 <-> 4, etc...
3286 set n [expr {(($n - 1) ^ 1) + 1}]
3287 set row [lindex [rowranges $id] $n]
3289 set ymax [lindex [$canv cget -scrollregion] 3]
3290 if {$ymax eq {} || $ymax <= 0} return
3291 set view [$canv yview]
3292 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3293 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3297 allcanvs yview moveto $yfrac
3300 proc lineclick {x y id isnew} {
3301 global ctext commitinfo childlist commitrow cflist canv thickerline
3303 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3308 # draw this line thicker than normal
3312 set ymax [lindex [$canv cget -scrollregion] 3]
3313 if {$ymax eq {}} return
3314 set yfrac [lindex [$canv yview] 0]
3315 set y [expr {$y + $yfrac * $ymax}]
3317 set dirn [clickisonarrow $id $y]
3319 arrowjump $id $dirn $y
3324 addtohistory [list lineclick $x $y $id 0]
3326 # fill the details pane with info about this line
3327 $ctext conf -state normal
3328 $ctext delete 0.0 end
3329 $ctext tag conf link -foreground blue -underline 1
3330 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3331 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3332 $ctext insert end "Parent:\t"
3333 $ctext insert end $id [list link link0]
3334 $ctext tag bind link0 <1> [list selbyid $id]
3335 set info $commitinfo($id)
3336 $ctext insert end "\n\t[lindex $info 0]\n"
3337 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3338 set date [formatdate [lindex $info 2]]
3339 $ctext insert end "\tDate:\t$date\n"
3340 set kids [lindex $childlist $commitrow($id)]
3342 $ctext insert end "\nChildren:"
3344 foreach child $kids {
3346 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3347 set info $commitinfo($child)
3348 $ctext insert end "\n\t"
3349 $ctext insert end $child [list link link$i]
3350 $ctext tag bind link$i <1> [list selbyid $child]
3351 $ctext insert end "\n\t[lindex $info 0]"
3352 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3353 set date [formatdate [lindex $info 2]]
3354 $ctext insert end "\n\tDate:\t$date\n"
3357 $ctext conf -state disabled
3359 $cflist delete 0 end
3362 proc normalline {} {
3364 if {[info exists thickerline]} {
3373 if {[info exists commitrow($id)]} {
3374 selectline $commitrow($id) 1
3380 if {![info exists startmstime]} {
3381 set startmstime [clock clicks -milliseconds]
3383 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3386 proc rowmenu {x y id} {
3387 global rowctxmenu commitrow selectedline rowmenuid
3389 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3394 $rowctxmenu entryconfigure 0 -state $state
3395 $rowctxmenu entryconfigure 1 -state $state
3396 $rowctxmenu entryconfigure 2 -state $state
3398 tk_popup $rowctxmenu $x $y
3401 proc diffvssel {dirn} {
3402 global rowmenuid selectedline displayorder
3404 if {![info exists selectedline]} return
3406 set oldid [lindex $displayorder $selectedline]
3407 set newid $rowmenuid
3409 set oldid $rowmenuid
3410 set newid [lindex $displayorder $selectedline]
3412 addtohistory [list doseldiff $oldid $newid]
3413 doseldiff $oldid $newid
3416 proc doseldiff {oldid newid} {
3420 $ctext conf -state normal
3421 $ctext delete 0.0 end
3422 $ctext mark set fmark.0 0.0
3423 $ctext mark gravity fmark.0 left
3424 $cflist delete 0 end
3425 $cflist insert end "Top"
3426 $ctext insert end "From "
3427 $ctext tag conf link -foreground blue -underline 1
3428 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3429 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3430 $ctext tag bind link0 <1> [list selbyid $oldid]
3431 $ctext insert end $oldid [list link link0]
3432 $ctext insert end "\n "
3433 $ctext insert end [lindex $commitinfo($oldid) 0]
3434 $ctext insert end "\n\nTo "
3435 $ctext tag bind link1 <1> [list selbyid $newid]
3436 $ctext insert end $newid [list link link1]
3437 $ctext insert end "\n "
3438 $ctext insert end [lindex $commitinfo($newid) 0]
3439 $ctext insert end "\n"
3440 $ctext conf -state disabled
3441 $ctext tag delete Comments
3442 $ctext tag remove found 1.0 end
3443 startdiff [list $oldid $newid]
3447 global rowmenuid currentid commitinfo patchtop patchnum
3449 if {![info exists currentid]} return
3450 set oldid $currentid
3451 set oldhead [lindex $commitinfo($oldid) 0]
3452 set newid $rowmenuid
3453 set newhead [lindex $commitinfo($newid) 0]
3456 catch {destroy $top}
3458 label $top.title -text "Generate patch"
3459 grid $top.title - -pady 10
3460 label $top.from -text "From:"
3461 entry $top.fromsha1 -width 40 -relief flat
3462 $top.fromsha1 insert 0 $oldid
3463 $top.fromsha1 conf -state readonly
3464 grid $top.from $top.fromsha1 -sticky w
3465 entry $top.fromhead -width 60 -relief flat
3466 $top.fromhead insert 0 $oldhead
3467 $top.fromhead conf -state readonly
3468 grid x $top.fromhead -sticky w
3469 label $top.to -text "To:"
3470 entry $top.tosha1 -width 40 -relief flat
3471 $top.tosha1 insert 0 $newid
3472 $top.tosha1 conf -state readonly
3473 grid $top.to $top.tosha1 -sticky w
3474 entry $top.tohead -width 60 -relief flat
3475 $top.tohead insert 0 $newhead
3476 $top.tohead conf -state readonly
3477 grid x $top.tohead -sticky w
3478 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3479 grid $top.rev x -pady 10
3480 label $top.flab -text "Output file:"
3481 entry $top.fname -width 60
3482 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3484 grid $top.flab $top.fname -sticky w
3486 button $top.buts.gen -text "Generate" -command mkpatchgo
3487 button $top.buts.can -text "Cancel" -command mkpatchcan
3488 grid $top.buts.gen $top.buts.can
3489 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3490 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3491 grid $top.buts - -pady 10 -sticky ew
3495 proc mkpatchrev {} {
3498 set oldid [$patchtop.fromsha1 get]
3499 set oldhead [$patchtop.fromhead get]
3500 set newid [$patchtop.tosha1 get]
3501 set newhead [$patchtop.tohead get]
3502 foreach e [list fromsha1 fromhead tosha1 tohead] \
3503 v [list $newid $newhead $oldid $oldhead] {
3504 $patchtop.$e conf -state normal
3505 $patchtop.$e delete 0 end
3506 $patchtop.$e insert 0 $v
3507 $patchtop.$e conf -state readonly
3514 set oldid [$patchtop.fromsha1 get]
3515 set newid [$patchtop.tosha1 get]
3516 set fname [$patchtop.fname get]
3517 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3518 error_popup "Error creating patch: $err"
3520 catch {destroy $patchtop}
3524 proc mkpatchcan {} {
3527 catch {destroy $patchtop}
3532 global rowmenuid mktagtop commitinfo
3536 catch {destroy $top}
3538 label $top.title -text "Create tag"
3539 grid $top.title - -pady 10
3540 label $top.id -text "ID:"
3541 entry $top.sha1 -width 40 -relief flat
3542 $top.sha1 insert 0 $rowmenuid
3543 $top.sha1 conf -state readonly
3544 grid $top.id $top.sha1 -sticky w
3545 entry $top.head -width 60 -relief flat
3546 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3547 $top.head conf -state readonly
3548 grid x $top.head -sticky w
3549 label $top.tlab -text "Tag name:"
3550 entry $top.tag -width 60
3551 grid $top.tlab $top.tag -sticky w
3553 button $top.buts.gen -text "Create" -command mktaggo
3554 button $top.buts.can -text "Cancel" -command mktagcan
3555 grid $top.buts.gen $top.buts.can
3556 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3557 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3558 grid $top.buts - -pady 10 -sticky ew
3563 global mktagtop env tagids idtags
3565 set id [$mktagtop.sha1 get]
3566 set tag [$mktagtop.tag get]
3568 error_popup "No tag name specified"
3571 if {[info exists tagids($tag)]} {
3572 error_popup "Tag \"$tag\" already exists"
3577 set fname [file join $dir "refs/tags" $tag]
3578 set f [open $fname w]
3582 error_popup "Error creating tag: $err"
3586 set tagids($tag) $id
3587 lappend idtags($id) $tag
3591 proc redrawtags {id} {
3592 global canv linehtag commitrow idpos selectedline
3594 if {![info exists commitrow($id)]} return
3595 drawcmitrow $commitrow($id)
3596 $canv delete tag.$id
3597 set xt [eval drawtags $id $idpos($id)]
3598 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3599 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3600 selectline $selectedline 0
3607 catch {destroy $mktagtop}
3616 proc writecommit {} {
3617 global rowmenuid wrcomtop commitinfo wrcomcmd
3619 set top .writecommit
3621 catch {destroy $top}
3623 label $top.title -text "Write commit to file"
3624 grid $top.title - -pady 10
3625 label $top.id -text "ID:"
3626 entry $top.sha1 -width 40 -relief flat
3627 $top.sha1 insert 0 $rowmenuid
3628 $top.sha1 conf -state readonly
3629 grid $top.id $top.sha1 -sticky w
3630 entry $top.head -width 60 -relief flat
3631 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3632 $top.head conf -state readonly
3633 grid x $top.head -sticky w
3634 label $top.clab -text "Command:"
3635 entry $top.cmd -width 60 -textvariable wrcomcmd
3636 grid $top.clab $top.cmd -sticky w -pady 10
3637 label $top.flab -text "Output file:"
3638 entry $top.fname -width 60
3639 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3640 grid $top.flab $top.fname -sticky w
3642 button $top.buts.gen -text "Write" -command wrcomgo
3643 button $top.buts.can -text "Cancel" -command wrcomcan
3644 grid $top.buts.gen $top.buts.can
3645 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3646 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3647 grid $top.buts - -pady 10 -sticky ew
3654 set id [$wrcomtop.sha1 get]
3655 set cmd "echo $id | [$wrcomtop.cmd get]"
3656 set fname [$wrcomtop.fname get]
3657 if {[catch {exec sh -c $cmd >$fname &} err]} {
3658 error_popup "Error writing commit: $err"
3660 catch {destroy $wrcomtop}
3667 catch {destroy $wrcomtop}
3671 proc listrefs {id} {
3672 global idtags idheads idotherrefs
3675 if {[info exists idtags($id)]} {
3679 if {[info exists idheads($id)]} {
3683 if {[info exists idotherrefs($id)]} {
3684 set z $idotherrefs($id)
3686 return [list $x $y $z]
3689 proc rereadrefs {} {
3690 global idtags idheads idotherrefs
3692 set refids [concat [array names idtags] \
3693 [array names idheads] [array names idotherrefs]]
3694 foreach id $refids {
3695 if {![info exists ref($id)]} {
3696 set ref($id) [listrefs $id]
3700 set refids [lsort -unique [concat $refids [array names idtags] \
3701 [array names idheads] [array names idotherrefs]]]
3702 foreach id $refids {
3703 set v [listrefs $id]
3704 if {![info exists ref($id)] || $ref($id) != $v} {
3710 proc showtag {tag isnew} {
3711 global ctext cflist tagcontents tagids linknum
3714 addtohistory [list showtag $tag 0]
3716 $ctext conf -state normal
3717 $ctext delete 0.0 end
3719 if {[info exists tagcontents($tag)]} {
3720 set text $tagcontents($tag)
3722 set text "Tag: $tag\nId: $tagids($tag)"
3724 appendwithlinks $text
3725 $ctext conf -state disabled
3726 $cflist delete 0 end
3736 global maxwidth maxgraphpct diffopts findmergefiles
3737 global oldprefs prefstop
3741 if {[winfo exists $top]} {
3745 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3746 set oldprefs($v) [set $v]
3749 wm title $top "Gitk preferences"
3750 label $top.ldisp -text "Commit list display options"
3751 grid $top.ldisp - -sticky w -pady 10
3752 label $top.spacer -text " "
3753 label $top.maxwidthl -text "Maximum graph width (lines)" \
3755 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3756 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3757 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3759 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3760 grid x $top.maxpctl $top.maxpct -sticky w
3761 checkbutton $top.findm -variable findmergefiles
3762 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3764 grid $top.findm $top.findml - -sticky w
3765 label $top.ddisp -text "Diff display options"
3766 grid $top.ddisp - -sticky w -pady 10
3767 label $top.diffoptl -text "Options for diff program" \
3769 entry $top.diffopt -width 20 -textvariable diffopts
3770 grid x $top.diffoptl $top.diffopt -sticky w
3772 button $top.buts.ok -text "OK" -command prefsok
3773 button $top.buts.can -text "Cancel" -command prefscan
3774 grid $top.buts.ok $top.buts.can
3775 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3776 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3777 grid $top.buts - - -pady 10 -sticky ew
3781 global maxwidth maxgraphpct diffopts findmergefiles
3782 global oldprefs prefstop
3784 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3785 set $v $oldprefs($v)
3787 catch {destroy $prefstop}
3792 global maxwidth maxgraphpct
3793 global oldprefs prefstop
3795 catch {destroy $prefstop}
3797 if {$maxwidth != $oldprefs(maxwidth)
3798 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3803 proc formatdate {d} {
3804 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3807 # This list of encoding names and aliases is distilled from
3808 # http://www.iana.org/assignments/character-sets.
3809 # Not all of them are supported by Tcl.
3810 set encoding_aliases {
3811 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3812 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3813 { ISO-10646-UTF-1 csISO10646UTF1 }
3814 { ISO_646.basic:1983 ref csISO646basic1983 }
3815 { INVARIANT csINVARIANT }
3816 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3817 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3818 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3819 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3820 { NATS-DANO iso-ir-9-1 csNATSDANO }
3821 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3822 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3823 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3824 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3825 { ISO-2022-KR csISO2022KR }
3827 { ISO-2022-JP csISO2022JP }
3828 { ISO-2022-JP-2 csISO2022JP2 }
3829 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3831 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3832 { IT iso-ir-15 ISO646-IT csISO15Italian }
3833 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3834 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3835 { greek7-old iso-ir-18 csISO18Greek7Old }
3836 { latin-greek iso-ir-19 csISO19LatinGreek }
3837 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3838 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3839 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3840 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3841 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3842 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3843 { INIS iso-ir-49 csISO49INIS }
3844 { INIS-8 iso-ir-50 csISO50INIS8 }
3845 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3846 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3847 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3848 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3849 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3850 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3852 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3853 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3854 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3855 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3856 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3857 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3858 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3859 { greek7 iso-ir-88 csISO88Greek7 }
3860 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3861 { iso-ir-90 csISO90 }
3862 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3863 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3864 csISO92JISC62991984b }
3865 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3866 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3867 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3868 csISO95JIS62291984handadd }
3869 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3870 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3871 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3872 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3874 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3875 { T.61-7bit iso-ir-102 csISO102T617bit }
3876 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3877 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3878 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3879 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3880 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3881 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3882 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3883 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3884 arabic csISOLatinArabic }
3885 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3886 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3887 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3888 greek greek8 csISOLatinGreek }
3889 { T.101-G2 iso-ir-128 csISO128T101G2 }
3890 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3892 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3893 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3894 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3895 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3896 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3897 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3898 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3899 csISOLatinCyrillic }
3900 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3901 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3902 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3903 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3904 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3905 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3906 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3907 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3908 { ISO_10367-box iso-ir-155 csISO10367Box }
3909 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3910 { latin-lap lap iso-ir-158 csISO158Lap }
3911 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3912 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3915 { JIS_X0201 X0201 csHalfWidthKatakana }
3916 { KSC5636 ISO646-KR csKSC5636 }
3917 { ISO-10646-UCS-2 csUnicode }
3918 { ISO-10646-UCS-4 csUCS4 }
3919 { DEC-MCS dec csDECMCS }
3920 { hp-roman8 roman8 r8 csHPRoman8 }
3921 { macintosh mac csMacintosh }
3922 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3924 { IBM038 EBCDIC-INT cp038 csIBM038 }
3925 { IBM273 CP273 csIBM273 }
3926 { IBM274 EBCDIC-BE CP274 csIBM274 }
3927 { IBM275 EBCDIC-BR cp275 csIBM275 }
3928 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3929 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3930 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3931 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3932 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3933 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3934 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3935 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3936 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3937 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3938 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3939 { IBM437 cp437 437 csPC8CodePage437 }
3940 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3941 { IBM775 cp775 csPC775Baltic }
3942 { IBM850 cp850 850 csPC850Multilingual }
3943 { IBM851 cp851 851 csIBM851 }
3944 { IBM852 cp852 852 csPCp852 }
3945 { IBM855 cp855 855 csIBM855 }
3946 { IBM857 cp857 857 csIBM857 }
3947 { IBM860 cp860 860 csIBM860 }
3948 { IBM861 cp861 861 cp-is csIBM861 }
3949 { IBM862 cp862 862 csPC862LatinHebrew }
3950 { IBM863 cp863 863 csIBM863 }
3951 { IBM864 cp864 csIBM864 }
3952 { IBM865 cp865 865 csIBM865 }
3953 { IBM866 cp866 866 csIBM866 }
3954 { IBM868 CP868 cp-ar csIBM868 }
3955 { IBM869 cp869 869 cp-gr csIBM869 }
3956 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3957 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3958 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3959 { IBM891 cp891 csIBM891 }
3960 { IBM903 cp903 csIBM903 }
3961 { IBM904 cp904 904 csIBBM904 }
3962 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3963 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3964 { IBM1026 CP1026 csIBM1026 }
3965 { EBCDIC-AT-DE csIBMEBCDICATDE }
3966 { EBCDIC-AT-DE-A csEBCDICATDEA }
3967 { EBCDIC-CA-FR csEBCDICCAFR }
3968 { EBCDIC-DK-NO csEBCDICDKNO }
3969 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3970 { EBCDIC-FI-SE csEBCDICFISE }
3971 { EBCDIC-FI-SE-A csEBCDICFISEA }
3972 { EBCDIC-FR csEBCDICFR }
3973 { EBCDIC-IT csEBCDICIT }
3974 { EBCDIC-PT csEBCDICPT }
3975 { EBCDIC-ES csEBCDICES }
3976 { EBCDIC-ES-A csEBCDICESA }
3977 { EBCDIC-ES-S csEBCDICESS }
3978 { EBCDIC-UK csEBCDICUK }
3979 { EBCDIC-US csEBCDICUS }
3980 { UNKNOWN-8BIT csUnknown8BiT }
3981 { MNEMONIC csMnemonic }
3986 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3987 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3988 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3989 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3990 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3991 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3992 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3993 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3994 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3995 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3996 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3997 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3998 { IBM1047 IBM-1047 }
3999 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4000 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4001 { UNICODE-1-1 csUnicode11 }
4004 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4005 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4007 { ISO-8859-15 ISO_8859-15 Latin-9 }
4008 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4009 { GBK CP936 MS936 windows-936 }
4010 { JIS_Encoding csJISEncoding }
4011 { Shift_JIS MS_Kanji csShiftJIS }
4012 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4014 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4015 { ISO-10646-UCS-Basic csUnicodeASCII }
4016 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4017 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4018 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4019 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4020 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4021 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4022 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4023 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4024 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4025 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4026 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4027 { Ventura-US csVenturaUS }
4028 { Ventura-International csVenturaInternational }
4029 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4030 { PC8-Turkish csPC8Turkish }
4031 { IBM-Symbols csIBMSymbols }
4032 { IBM-Thai csIBMThai }
4033 { HP-Legal csHPLegal }
4034 { HP-Pi-font csHPPiFont }
4035 { HP-Math8 csHPMath8 }
4036 { Adobe-Symbol-Encoding csHPPSMath }
4037 { HP-DeskTop csHPDesktop }
4038 { Ventura-Math csVenturaMath }
4039 { Microsoft-Publishing csMicrosoftPublishing }
4040 { Windows-31J csWindows31J }
4045 proc tcl_encoding {enc} {
4046 global encoding_aliases
4047 set names [encoding names]
4048 set lcnames [string tolower $names]
4049 set enc [string tolower $enc]
4050 set i [lsearch -exact $lcnames $enc]
4052 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4053 if {[regsub {^iso[-_]} $enc iso encx]} {
4054 set i [lsearch -exact $lcnames $encx]
4058 foreach l $encoding_aliases {
4059 set ll [string tolower $l]
4060 if {[lsearch -exact $ll $enc] < 0} continue
4061 # look through the aliases for one that tcl knows about
4063 set i [lsearch -exact $lcnames $e]
4065 if {[regsub {^iso[-_]} $e iso ex]} {
4066 set i [lsearch -exact $lcnames $ex]
4075 return [lindex $names $i]
4082 set diffopts "-U 5 -p"
4083 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4087 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4089 if {$gitencoding == ""} {
4090 set gitencoding "utf-8"
4092 set tclencoding [tcl_encoding $gitencoding]
4093 if {$tclencoding == {}} {
4094 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4097 set mainfont {Helvetica 9}
4098 set textfont {Courier 9}
4099 set uifont {Helvetica 9 bold}
4100 set findmergefiles 0
4109 set colors {green red blue magenta darkgrey brown orange}
4111 catch {source ~/.gitk}
4113 set namefont $mainfont
4115 font create optionfont -family sans-serif -size -12
4119 switch -regexp -- $arg {
4121 "^-d" { set datemode 1 }
4123 lappend revtreeargs $arg
4128 # check that we can find a .git directory somewhere...
4130 if {![file isdirectory $gitdir]} {
4131 error_popup "Cannot find the git directory \"$gitdir\"."
4150 parse_args $revtreeargs
4151 set args $parsed_args
4152 if {$cmdline_files ne {}} {
4153 # create a view for the files/dirs specified on the command line
4156 set viewname(1) "Command line"
4157 set viewfiles(1) $cmdline_files
4158 .bar.view add command -label $viewname(1) -command {showview 1}
4159 .bar.view entryconf 2 -state normal
4160 set args [concat $args "--" $cmdline_files]