2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc parse_args
{rargs
} {
23 set parse_args
[concat
--default HEAD
$rargs]
24 set parsed_args
[split [eval exec git-rev-parse
$parse_args] "\n"]
26 # if git-rev-parse failed for some reason...
30 set parsed_args
$rargs
35 proc start_rev_list
{rlargs
} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding
39 set startmsecs
[clock clicks
-milliseconds]
40 set nextupdate
[expr {$startmsecs + 100}]
43 set commfd
[open
[concat | git-rev-list
--header --topo-order \
46 puts stderr
"Error executing git-rev-list: $err"
50 fconfigure
$commfd -blocking 0 -translation lf
51 if {$tclencoding != {}} {
52 fconfigure
$commfd -encoding $tclencoding
54 fileevent
$commfd readable
[list getcommitlines
$commfd]
55 . config
-cursor watch
59 proc getcommits
{rargs
} {
60 global oldcommits commits phase canv mainfont env
62 # check that we can find a .git directory somewhere...
64 if {![file isdirectory
$gitdir]} {
65 error_popup
"Cannot find the git directory \"$gitdir\"."
71 start_rev_list
[parse_args
$rargs]
73 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
74 -font $mainfont -tags textitems
77 proc getcommitlines
{commfd
} {
78 global oldcommits commits parents cdate children nchildren
79 global commitlisted phase nextupdate
80 global stopped redisplaying leftover
83 set stuff
[read $commfd]
85 if {![eof
$commfd]} return
86 # set it blocking so we wait for the process to terminate
87 fconfigure
$commfd -blocking 1
88 if {![catch
{close
$commfd} err
]} {
89 after idle finishcommits
92 if {[string range
$err 0 4] == "usage"} {
94 "Gitk: error reading commits: bad arguments to git-rev-list.\
95 (Note: arguments to gitk are passed to git-rev-list\
96 to allow selection of commits to be displayed.)"
98 set err
"Error reading commits: $err"
105 set i
[string first
"\0" $stuff $start]
107 append leftover
[string range
$stuff $start end
]
110 set cmit
[string range
$stuff $start [expr {$i - 1}]]
112 set cmit
"$leftover$cmit"
115 set start
[expr {$i + 1}]
116 set j
[string first
"\n" $cmit]
119 set ids
[string range
$cmit 0 [expr {$j - 1}]]
122 if {![regexp
{^
[0-9a-f]{40}$
} $id]} {
130 if {[string length
$shortcmit] > 80} {
131 set shortcmit
"[string range $shortcmit 0 80]..."
133 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
136 set id
[lindex
$ids 0]
137 set olds
[lrange
$ids 1 end
]
138 set cmit
[string range
$cmit [expr {$j + 1}] end
]
140 set commitlisted
($id) 1
141 parsecommit
$id $cmit 1 [lrange
$ids 1 end
]
143 if {[clock clicks
-milliseconds] >= $nextupdate} {
146 while {$redisplaying} {
150 set phase
"getcommits"
151 foreach id
$commits {
154 if {[clock clicks
-milliseconds] >= $nextupdate} {
163 proc doupdate
{reading
} {
164 global commfd nextupdate numcommits ncmupdate
167 fileevent
$commfd readable
{}
170 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
171 if {$numcommits < 100} {
172 set ncmupdate
[expr {$numcommits + 1}]
173 } elseif
{$numcommits < 10000} {
174 set ncmupdate
[expr {$numcommits + 10}]
176 set ncmupdate
[expr {$numcommits + 100}]
179 fileevent
$commfd readable
[list getcommitlines
$commfd]
183 proc readcommit
{id
} {
184 if [catch
{set contents
[exec git-cat-file commit
$id]}] return
185 parsecommit
$id $contents 0 {}
188 proc updatecommits
{rargs
} {
189 global commitlisted commfd phase
190 global startmsecs nextupdate ncmupdate
191 global idtags idheads idotherrefs
195 global oldcommits commits
196 global parents nchildren children ncleft
198 set old_args
$parsed_args
201 if {$phase == "getcommits" ||
$phase == "incrdraw"} {
202 # havent read all the old commits, just start again from scratch
206 foreach v
{children nchildren parents commitlisted commitinfo
207 selectedline matchinglines treediffs
208 mergefilelist currentid rowtextx
} {
213 if {$phase == "incrdraw"} {
215 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
216 -font $mainfont -tags textitems
219 start_rev_list
$parsed_args
223 foreach id
$old_args {
224 if {![regexp
{^
[0-9a-f]{40}$
} $id]} continue
225 if {[info exists oldref
($id)]} continue
227 lappend ignoreold
"^$id"
229 foreach id
$parsed_args {
230 if {![regexp
{^
[0-9a-f]{40}$
} $id]} continue
231 if {[info exists ref
($id)]} continue
233 lappend ignorenew
"^$id"
236 foreach a
$old_args {
237 if {![info exists ref
($a)]} {
242 set phase updatecommits
243 set oldcommits
$commits
245 set removed_commits
[split [eval exec git-rev-list
$ignorenew] "\n" ]
246 if {[llength
$removed_commits] > 0} {
248 foreach c
$removed_commits {
249 set i
[lsearch
-exact $oldcommits $c]
251 set oldcommits
[lreplace
$oldcommits $i $i]
252 unset commitlisted
($c)
253 foreach p
$parents($c) {
254 if {[info exists nchildren
($p)]} {
255 set j
[lsearch
-exact $children($p) $c]
257 set children
($p) [lreplace
$children($p) $j $j]
258 incr nchildren
($p) -1
264 set phase removecommits
268 foreach a
$parsed_args {
269 if {![info exists oldref
($a)]} {
275 start_rev_list
[concat
$ignoreold $args]
278 proc updatechildren
{id olds
} {
279 global children nchildren parents nparents ncleft
281 if {![info exists nchildren
($id)]} {
286 set parents
($id) $olds
287 set nparents
($id) [llength
$olds]
289 if {![info exists nchildren
($p)]} {
290 set children
($p) [list
$id]
293 } elseif
{[lsearch
-exact $children($p) $id] < 0} {
294 lappend children
($p) $id
301 proc parsecommit
{id contents listed olds
} {
302 global commitinfo cdate
311 updatechildren
$id $olds
312 set hdrend
[string first
"\n\n" $contents]
314 # should never happen...
315 set hdrend
[string length
$contents]
317 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
318 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
319 foreach line
[split $header "\n"] {
320 set tag
[lindex
$line 0]
321 if {$tag == "author"} {
322 set audate
[lindex
$line end-1
]
323 set auname
[lrange
$line 1 end-2
]
324 } elseif
{$tag == "committer"} {
325 set comdate
[lindex
$line end-1
]
326 set comname
[lrange
$line 1 end-2
]
330 # take the first line of the comment as the headline
331 set i
[string first
"\n" $comment]
333 set headline
[string trim
[string range
$comment 0 $i]]
335 set headline
$comment
338 # git-rev-list indents the comment by 4 spaces;
339 # if we got this via git-cat-file, add the indentation
341 foreach line
[split $comment "\n"] {
342 append newcomment
" "
343 append newcomment
$line
344 append newcomment
"\n"
346 set comment
$newcomment
348 if {$comdate != {}} {
349 set cdate
($id) $comdate
351 set commitinfo
($id) [list
$headline $auname $audate \
352 $comname $comdate $comment]
356 global tagids idtags headids idheads tagcontents
357 global otherrefids idotherrefs
359 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
362 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
363 while {0 <= [set n
[gets
$refd line
]]} {
364 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
368 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
372 if {$type == "tags"} {
373 set tagids
($name) $id
374 lappend idtags
($id) $name
379 set commit
[exec git-rev-parse
"$id^0"]
380 if {"$commit" != "$id"} {
381 set tagids
($name) $commit
382 lappend idtags
($commit) $name
386 set tagcontents
($name) [exec git-cat-file tag
"$id"]
388 } elseif
{ $type == "heads" } {
389 set headids
($name) $id
390 lappend idheads
($id) $name
392 set otherrefids
($name) $id
393 lappend idotherrefs
($id) $name
399 proc error_popup msg
{
403 message
$w.m
-text $msg -justify center
-aspect 400
404 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
405 button
$w.ok
-text OK
-command "destroy $w"
406 pack
$w.ok
-side bottom
-fill x
407 bind $w <Visibility
> "grab $w; focus $w"
411 proc makewindow
{rargs
} {
412 global canv canv2 canv3 linespc charspc ctext cflist textfont
413 global findtype findtypemenu findloc findstring fstring geometry
414 global entries sha1entry sha1string sha1but
415 global maincursor textcursor curtextcursor
416 global rowctxmenu mergemax
419 .bar add cascade
-label "File" -menu .bar.
file
421 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
422 .bar.
file add
command -label "Reread references" -command rereadrefs
423 .bar.
file add
command -label "Quit" -command doquit
425 .bar add cascade
-label "Edit" -menu .bar.edit
426 .bar.edit add
command -label "Preferences" -command doprefs
428 .bar add cascade
-label "Help" -menu .bar.
help
429 .bar.
help add
command -label "About gitk" -command about
430 . configure
-menu .bar
432 if {![info exists geometry
(canv1
)]} {
433 set geometry
(canv1
) [expr {45 * $charspc}]
434 set geometry
(canv2
) [expr {30 * $charspc}]
435 set geometry
(canv3
) [expr {15 * $charspc}]
436 set geometry
(canvh
) [expr {25 * $linespc + 4}]
437 set geometry
(ctextw
) 80
438 set geometry
(ctexth
) 30
439 set geometry
(cflistw
) 30
441 panedwindow .ctop
-orient vertical
442 if {[info exists geometry
(width
)]} {
443 .ctop conf
-width $geometry(width
) -height $geometry(height
)
444 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
445 set geometry
(ctexth
) [expr {($texth - 8) /
446 [font metrics
$textfont -linespace]}]
450 pack .ctop.top.bar
-side bottom
-fill x
451 set cscroll .ctop.top.csb
452 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
453 pack
$cscroll -side right
-fill y
454 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
455 pack .ctop.top.clist
-side top
-fill both
-expand 1
457 set canv .ctop.top.clist.canv
458 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
460 -yscrollincr $linespc -yscrollcommand "$cscroll set"
461 .ctop.top.clist add
$canv
462 set canv2 .ctop.top.clist.canv2
463 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
464 -bg white
-bd 0 -yscrollincr $linespc
465 .ctop.top.clist add
$canv2
466 set canv3 .ctop.top.clist.canv3
467 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
468 -bg white
-bd 0 -yscrollincr $linespc
469 .ctop.top.clist add
$canv3
470 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
472 set sha1entry .ctop.top.bar.sha1
473 set entries
$sha1entry
474 set sha1but .ctop.top.bar.sha1label
475 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
476 -command gotocommit
-width 8
477 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
478 pack .ctop.top.bar.sha1label
-side left
479 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
480 trace add variable sha1string
write sha1change
481 pack
$sha1entry -side left
-pady 2
483 image create bitmap bm-left
-data {
484 #define left_width 16
485 #define left_height 16
486 static unsigned char left_bits
[] = {
487 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
488 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
489 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
491 image create bitmap bm-right
-data {
492 #define right_width 16
493 #define right_height 16
494 static unsigned char right_bits
[] = {
495 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
496 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
497 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
499 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
500 -state disabled
-width 26
501 pack .ctop.top.bar.leftbut
-side left
-fill y
502 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
503 -state disabled
-width 26
504 pack .ctop.top.bar.rightbut
-side left
-fill y
506 button .ctop.top.bar.findbut
-text "Find" -command dofind
507 pack .ctop.top.bar.findbut
-side left
509 set fstring .ctop.top.bar.findstring
510 lappend entries
$fstring
511 entry
$fstring -width 30 -font $textfont -textvariable findstring
512 pack
$fstring -side left
-expand 1 -fill x
514 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp
]
516 set findloc
"All fields"
517 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
518 Comments Author Committer Files Pickaxe
519 pack .ctop.top.bar.findloc
-side right
520 pack .ctop.top.bar.findtype
-side right
521 # for making sure type==Exact whenever loc==Pickaxe
522 trace add variable findloc
write findlocchange
524 panedwindow .ctop.cdet
-orient horizontal
526 frame .ctop.cdet.left
527 set ctext .ctop.cdet.left.ctext
528 text
$ctext -bg white
-state disabled
-font $textfont \
529 -width $geometry(ctextw
) -height $geometry(ctexth
) \
530 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
531 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
532 pack .ctop.cdet.left.sb
-side right
-fill y
533 pack
$ctext -side left
-fill both
-expand 1
534 .ctop.cdet add .ctop.cdet.left
536 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
537 $ctext tag conf hunksep
-fore blue
538 $ctext tag conf d0
-fore red
539 $ctext tag conf d1
-fore "#00a000"
540 $ctext tag conf m0
-fore red
541 $ctext tag conf m1
-fore blue
542 $ctext tag conf m2
-fore green
543 $ctext tag conf m3
-fore purple
544 $ctext tag conf
m4 -fore brown
545 $ctext tag conf mmax
-fore darkgrey
547 $ctext tag conf mresult
-font [concat
$textfont bold
]
548 $ctext tag conf msep
-font [concat
$textfont bold
]
549 $ctext tag conf found
-back yellow
551 frame .ctop.cdet.right
552 set cflist .ctop.cdet.right.cfiles
553 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
554 -yscrollcommand ".ctop.cdet.right.sb set"
555 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
556 pack .ctop.cdet.right.sb
-side right
-fill y
557 pack
$cflist -side left
-fill both
-expand 1
558 .ctop.cdet add .ctop.cdet.right
559 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
561 pack .ctop
-side top
-fill both
-expand 1
563 bindall
<1> {selcanvline
%W
%x
%y
}
564 #bindall <B1-Motion> {selcanvline %W %x %y}
565 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
566 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
567 bindall
<2> "allcanvs scan mark 0 %y"
568 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
569 bind .
<Key-Up
> "selnextline -1"
570 bind .
<Key-Down
> "selnextline 1"
571 bind .
<Key-Right
> "goforw"
572 bind .
<Key-Left
> "goback"
573 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
574 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
575 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
576 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
577 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
578 bindkey p
"selnextline -1"
579 bindkey n
"selnextline 1"
582 bindkey i
"selnextline -1"
583 bindkey k
"selnextline 1"
586 bindkey b
"$ctext yview scroll -1 pages"
587 bindkey d
"$ctext yview scroll 18 units"
588 bindkey u
"$ctext yview scroll -18 units"
589 bindkey
/ {findnext
1}
590 bindkey
<Key-Return
> {findnext
0}
593 bind .
<Control-q
> doquit
594 bind .
<Control-f
> dofind
595 bind .
<Control-g
> {findnext
0}
596 bind .
<Control-r
> findprev
597 bind .
<Control-equal
> {incrfont
1}
598 bind .
<Control-KP_Add
> {incrfont
1}
599 bind .
<Control-minus
> {incrfont
-1}
600 bind .
<Control-KP_Subtract
> {incrfont
-1}
601 bind $cflist <<ListboxSelect>> listboxsel
602 bind . <Destroy> {savestuff %W}
603 bind . <Button-1> "click %W"
604 bind $fstring <Key-Return> dofind
605 bind $sha1entry <Key-Return> gotocommit
606 bind $sha1entry <<PasteSelection>> clearsha1
608 set maincursor [. cget -cursor]
609 set textcursor [$ctext cget -cursor]
610 set curtextcursor $textcursor
612 set rowctxmenu .rowctxmenu
613 menu $rowctxmenu -tearoff 0
614 $rowctxmenu add command -label "Diff this -> selected" \
615 -command {diffvssel 0}
616 $rowctxmenu add command -label "Diff selected -> this" \
617 -command {diffvssel 1}
618 $rowctxmenu add command -label "Make patch" -command mkpatch
619 $rowctxmenu add command -label "Create tag" -command mktag
620 $rowctxmenu add command -label "Write commit to file" -command writecommit
623 # when we make a key binding for the toplevel, make sure
624 # it doesn't get triggered when that key is pressed in the
625 # find string entry widget.
626 proc bindkey {ev script} {
629 set escript [bind Entry $ev]
630 if {$escript == {}} {
631 set escript [bind Entry <Key>]
634 bind $e $ev "$escript; break"
638 # set the focus back to the toplevel for any click outside
649 global canv canv2 canv3 ctext cflist mainfont textfont
650 global stuffsaved findmergefiles maxgraphpct
653 if {$stuffsaved} return
654 if {![winfo viewable .]} return
656 set f [open "~/.gitk-new" w]
657 puts $f [list set mainfont $mainfont]
658 puts $f [list set textfont $textfont]
659 puts $f [list set findmergefiles $findmergefiles]
660 puts $f [list set maxgraphpct $maxgraphpct]
661 puts $f [list set maxwidth $maxwidth]
662 puts $f "set geometry(width) [winfo width .ctop]"
663 puts $f "set geometry(height) [winfo height .ctop]"
664 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
665 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
666 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
667 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
668 set wid [expr {([winfo width $ctext] - 8) \
669 / [font measure $textfont "0"]}]
670 puts $f "set geometry(ctextw) $wid"
671 set wid [expr {([winfo width $cflist] - 11) \
672 / [font measure [$cflist cget -font] "0"]}]
673 puts $f "set geometry(cflistw) $wid"
675 file rename -force "~/.gitk-new" "~/.gitk"
680 proc resizeclistpanes {win w} {
682 if [info exists oldwidth($win)] {
683 set s0 [$win sash coord 0]
684 set s1 [$win sash coord 1]
686 set sash0 [expr {int($w/2 - 2)}]
687 set sash1 [expr {int($w*5/6 - 2)}]
689 set factor [expr {1.0 * $w / $oldwidth($win)}]
690 set sash0 [expr {int($factor * [lindex $s0 0])}]
691 set sash1 [expr {int($factor * [lindex $s1 0])}]
695 if {$sash1 < $sash0 + 20} {
696 set sash1 [expr {$sash0 + 20}]
698 if {$sash1 > $w - 10} {
699 set sash1 [expr {$w - 10}]
700 if {$sash0 > $sash1 - 20} {
701 set sash0 [expr {$sash1 - 20}]
705 $win sash place 0 $sash0 [lindex $s0 1]
706 $win sash place 1 $sash1 [lindex $s1 1]
708 set oldwidth($win) $w
711 proc resizecdetpanes {win w} {
713 if [info exists oldwidth($win)] {
714 set s0 [$win sash coord 0]
716 set sash0 [expr {int($w*3/4 - 2)}]
718 set factor [expr {1.0 * $w / $oldwidth($win)}]
719 set sash0 [expr {int($factor * [lindex $s0 0])}]
723 if {$sash0 > $w - 15} {
724 set sash0 [expr {$w - 15}]
727 $win sash place 0 $sash0 [lindex $s0 1]
729 set oldwidth($win) $w
733 global canv canv2 canv3
739 proc bindall {event action} {
740 global canv canv2 canv3
741 bind $canv $event $action
742 bind $canv2 $event $action
743 bind $canv3 $event $action
748 if {[winfo exists $w]} {
753 wm title $w "About gitk"
757 Copyright © 2005 Paul Mackerras
759 Use and redistribute under the terms of the GNU General Public License} \
760 -justify center -aspect 400
761 pack $w.m -side top -fill x -padx 20 -pady 20
762 button $w.ok -text Close -command "destroy $w"
763 pack $w.ok -side bottom
766 proc assigncolor {id} {
767 global colormap commcolors colors nextcolor
768 global parents nparents children nchildren
769 global cornercrossings crossings
771 if [info exists colormap($id)] return
772 set ncolors [llength $colors]
773 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
774 set child [lindex $children($id) 0]
775 if {[info exists colormap($child)]
776 && $nparents($child) == 1} {
777 set colormap($id) $colormap($child)
782 if {[info exists cornercrossings($id)]} {
783 foreach x $cornercrossings($id) {
784 if {[info exists colormap($x)]
785 && [lsearch -exact $badcolors $colormap($x)] < 0} {
786 lappend badcolors $colormap($x)
789 if {[llength $badcolors] >= $ncolors} {
793 set origbad $badcolors
794 if {[llength $badcolors] < $ncolors - 1} {
795 if {[info exists crossings($id)]} {
796 foreach x $crossings($id) {
797 if {[info exists colormap($x)]
798 && [lsearch -exact $badcolors $colormap($x)] < 0} {
799 lappend badcolors $colormap($x)
802 if {[llength $badcolors] >= $ncolors} {
803 set badcolors $origbad
806 set origbad $badcolors
808 if {[llength $badcolors] < $ncolors - 1} {
809 foreach child $children($id) {
810 if {[info exists colormap($child)]
811 && [lsearch -exact $badcolors $colormap($child)] < 0} {
812 lappend badcolors $colormap($child)
814 if {[info exists parents($child)]} {
815 foreach p $parents($child) {
816 if {[info exists colormap($p)]
817 && [lsearch -exact $badcolors $colormap($p)] < 0} {
818 lappend badcolors $colormap($p)
823 if {[llength $badcolors] >= $ncolors} {
824 set badcolors $origbad
827 for {set i 0} {$i <= $ncolors} {incr i} {
828 set c [lindex $colors $nextcolor]
829 if {[incr nextcolor] >= $ncolors} {
832 if {[lsearch -exact $badcolors $c]} break
838 global canvy canvy0 lineno numcommits nextcolor linespc
839 global nchildren ncleft
840 global displist nhyperspace
847 foreach v {mainline mainlinearrow sidelines colormap cornercrossings
848 crossings idline lineid} {
852 foreach id [array names nchildren] {
853 set ncleft($id) $nchildren($id)
859 proc bindline {t id} {
862 $canv bind $t <Enter> "lineenter %x %y $id"
863 $canv bind $t <Motion> "linemotion %x %y $id"
864 $canv bind $t <Leave> "lineleave $id"
865 $canv bind $t <Button-1> "lineclick %x %y $id 1"
868 proc drawlines {id xtra delold} {
869 global mainline mainlinearrow sidelines lthickness colormap canv
872 $canv delete lines.$id
874 if {[info exists mainline($id)]} {
875 set t [$canv create line $mainline($id) \
876 -width [expr {($xtra + 1) * $lthickness}] \
877 -fill $colormap($id) -tags lines.$id \
878 -arrow $mainlinearrow($id)]
882 if {[info exists sidelines($id)]} {
883 foreach ls $sidelines($id) {
884 set coords [lindex $ls 0]
885 set thick [lindex $ls 1]
886 set arrow [lindex $ls 2]
887 set t [$canv create line $coords -fill $colormap($id) \
888 -width [expr {($thick + $xtra) * $lthickness}] \
889 -arrow $arrow -tags lines.$id]
896 # level here is an index in displist
897 proc drawcommitline {level} {
898 global parents children nparents displist
899 global canv canv2 canv3 mainfont namefont canvy linespc
900 global lineid linehtag linentag linedtag commitinfo
901 global colormap numcommits currentparents dupparents
902 global idtags idline idheads idotherrefs
903 global lineno lthickness mainline mainlinearrow sidelines
904 global commitlisted rowtextx idpos lastuse displist
905 global oldnlines olddlevel olddisplist
909 set id [lindex $displist $level]
910 set lastuse($id) $lineno
911 set lineid($lineno) $id
912 set idline($id) $lineno
913 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
914 if {![info exists commitinfo($id)]} {
916 if {![info exists commitinfo($id)]} {
917 set commitinfo($id) {"No commit information available"}
922 set currentparents {}
924 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
925 foreach p $parents($id) {
926 if {[lsearch -exact $currentparents $p] < 0} {
927 lappend currentparents $p
929 # remember that this parent was listed twice
930 lappend dupparents $p
934 set x [xcoord $level $level $lineno]
936 set canvy [expr {$canvy + $linespc}]
937 allcanvs conf -scrollregion \
938 [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]]
939 if {[info exists mainline($id)]} {
940 lappend mainline($id) $x $y1
941 if {$mainlinearrow($id) ne "none"} {
942 set mainline($id) [trimdiagstart $mainline($id)]
946 set orad [expr {$linespc / 3}]
947 set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \
948 [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \
949 -fill $ofill -outline black -width 1]
951 $canv bind $t <1> {selcanvline {} %x %y}
952 set xt [xcoord [llength $displist] $level $lineno]
953 if {[llength $currentparents] > 2} {
954 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
956 set rowtextx($lineno) $xt
957 set idpos($id) [list $x $xt $y1]
958 if {[info exists idtags($id)] || [info exists idheads($id)]
959 || [info exists idotherrefs($id)]} {
960 set xt [drawtags $id $x $xt $y1]
962 set headline [lindex $commitinfo($id) 0]
963 set name [lindex $commitinfo($id) 1]
964 set date [lindex $commitinfo($id) 2]
965 set date [formatdate $date]
966 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
967 -text $headline -font $mainfont ]
968 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
969 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
970 -text $name -font $namefont]
971 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
972 -text $date -font $mainfont]
975 set olddisplist $displist
976 set oldnlines [llength $displist]
979 proc drawtags {id x xt y1} {
980 global idtags idheads idotherrefs
981 global linespc lthickness
982 global canv mainfont idline rowtextx
987 if {[info exists idtags($id)]} {
988 set marks $idtags($id)
989 set ntags [llength $marks]
991 if {[info exists idheads($id)]} {
992 set marks [concat $marks $idheads($id)]
993 set nheads [llength $idheads($id)]
995 if {[info exists idotherrefs($id)]} {
996 set marks [concat $marks $idotherrefs($id)]
1002 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1003 set yt [expr {$y1 - 0.5 * $linespc}]
1004 set yb [expr {$yt + $linespc - 1}]
1007 foreach tag $marks {
1008 set wid [font measure $mainfont $tag]
1011 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1013 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1014 -width $lthickness -fill black -tags tag.$id]
1016 foreach tag $marks x $xvals wid $wvals {
1017 set xl [expr {$x + $delta}]
1018 set xr [expr {$x + $delta + $wid + $lthickness}]
1019 if {[incr ntags -1] >= 0} {
1021 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1022 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1023 -width 1 -outline black -fill yellow -tags tag.$id]
1024 $canv bind $t <1> [list showtag $tag 1]
1025 set rowtextx($idline($id)) [expr {$xr + $linespc}]
1027 # draw a head or other ref
1028 if {[incr nheads -1] >= 0} {
1033 set xl [expr {$xl - $delta/2}]
1034 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1035 -width 1 -outline black -fill $col -tags tag.$id
1037 set t [$canv create text $xl $y1 -anchor w -text $tag \
1038 -font $mainfont -tags tag.$id]
1040 $canv bind $t <1> [list showtag $tag 1]
1046 proc notecrossings {id lo hi corner} {
1047 global olddisplist crossings cornercrossings
1049 for {set i $lo} {[incr i] < $hi} {} {
1050 set p [lindex $olddisplist $i]
1051 if {$p == {}} continue
1052 if {$i == $corner} {
1053 if {![info exists cornercrossings($id)]
1054 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1055 lappend cornercrossings($id) $p
1057 if {![info exists cornercrossings($p)]
1058 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1059 lappend cornercrossings($p) $id
1062 if {![info exists crossings($id)]
1063 || [lsearch -exact $crossings($id) $p] < 0} {
1064 lappend crossings($id) $p
1066 if {![info exists crossings($p)]
1067 || [lsearch -exact $crossings($p) $id] < 0} {
1068 lappend crossings($p) $id
1074 proc xcoord {i level ln} {
1075 global canvx0 xspc1 xspc2
1077 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1078 if {$i > 0 && $i == $level} {
1079 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1080 } elseif {$i > $level} {
1081 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1086 # it seems Tk can't draw arrows on the end of diagonal line segments...
1087 proc trimdiagend {line} {
1088 while {[llength $line] > 4} {
1089 set x1 [lindex $line end-3]
1090 set y1 [lindex $line end-2]
1091 set x2 [lindex $line end-1]
1092 set y2 [lindex $line end]
1093 if {($x1 == $x2) != ($y1 == $y2)} break
1094 set line [lreplace $line end-1 end]
1099 proc trimdiagstart {line} {
1100 while {[llength $line] > 4} {
1101 set x1 [lindex $line 0]
1102 set y1 [lindex $line 1]
1103 set x2 [lindex $line 2]
1104 set y2 [lindex $line 3]
1105 if {($x1 == $x2) != ($y1 == $y2)} break
1106 set line [lreplace $line 0 1]
1111 proc drawslants {id needonscreen nohs} {
1112 global canv mainline mainlinearrow sidelines
1113 global canvx0 canvy xspc1 xspc2 lthickness
1114 global currentparents dupparents
1115 global lthickness linespc canvy colormap lineno geometry
1116 global maxgraphpct maxwidth
1117 global displist onscreen lastuse
1118 global parents commitlisted
1119 global oldnlines olddlevel olddisplist
1120 global nhyperspace numcommits nnewparents
1123 lappend displist $id
1128 set y1 [expr {$canvy - $linespc}]
1131 # work out what we need to get back on screen
1133 if {$onscreen($id) < 0} {
1134 # next to do isn't displayed, better get it on screen...
1135 lappend reins [list $id 0]
1137 # make sure all the previous commits's parents are on the screen
1138 foreach p $currentparents {
1139 if {$onscreen($p) < 0} {
1140 lappend reins [list $p 0]
1143 # bring back anything requested by caller
1144 if {$needonscreen ne {}} {
1145 lappend reins $needonscreen
1149 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1150 set dlevel $olddlevel
1151 set x [xcoord $dlevel $dlevel $lineno]
1152 set mainline($id) [list $x $y1]
1153 set mainlinearrow($id) none
1154 set lastuse($id) $lineno
1155 set displist [lreplace $displist $dlevel $dlevel $id]
1157 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1162 set displist [lreplace $displist $olddlevel $olddlevel]
1164 foreach p $currentparents {
1165 set lastuse($p) $lineno
1166 if {$onscreen($p) == 0} {
1167 set displist [linsert $displist $j $p]
1172 if {$onscreen($id) == 0} {
1173 lappend displist $id
1177 # remove the null entry if present
1178 set nullentry [lsearch -exact $displist {}]
1179 if {$nullentry >= 0} {
1180 set displist [lreplace $displist $nullentry $nullentry]
1183 # bring back the ones we need now (if we did it earlier
1184 # it would change displist and invalidate olddlevel)
1186 # test again in case of duplicates in reins
1187 set p [lindex $pi 0]
1188 if {$onscreen($p) < 0} {
1190 set lastuse($p) $lineno
1191 set displist [linsert $displist [lindex $pi 1] $p]
1196 set lastuse($id) $lineno
1198 # see if we need to make any lines jump off into hyperspace
1199 set displ [llength $displist]
1200 if {$displ > $maxwidth} {
1202 foreach x $displist {
1203 lappend ages [list $lastuse($x) $x]
1205 set ages [lsort -integer -index 0 $ages]
1207 while {$displ > $maxwidth} {
1208 set use [lindex $ages $k 0]
1209 set victim [lindex $ages $k 1]
1210 if {$use >= $lineno - 5} break
1212 if {[lsearch -exact $nohs $victim] >= 0} continue
1213 set i [lsearch -exact $displist $victim]
1214 set displist [lreplace $displist $i $i]
1215 set onscreen($victim) -1
1218 if {$i < $nullentry} {
1221 set x [lindex $mainline($victim) end-1]
1222 lappend mainline($victim) $x $y1
1223 set line [trimdiagend $mainline($victim)]
1225 if {$mainlinearrow($victim) ne "none"} {
1226 set line [trimdiagstart $line]
1229 lappend sidelines($victim) [list $line 1 $arrow]
1230 unset mainline($victim)
1234 set dlevel [lsearch -exact $displist $id]
1236 # If we are reducing, put in a null entry
1237 if {$displ < $oldnlines} {
1238 # does the next line look like a merge?
1239 # i.e. does it have > 1 new parent?
1240 if {$nnewparents($id) > 1} {
1241 set i [expr {$dlevel + 1}]
1242 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1244 if {$nullentry >= 0 && $nullentry < $i} {
1247 } elseif {$nullentry >= 0} {
1250 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1255 if {$dlevel >= $i} {
1260 set displist [linsert $displist $i {}]
1262 if {$dlevel >= $i} {
1268 # decide on the line spacing for the next line
1269 set lj [expr {$lineno + 1}]
1270 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1271 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1272 set xspc1($lj) $xspc2
1274 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1275 if {$xspc1($lj) < $lthickness} {
1276 set xspc1($lj) $lthickness
1280 foreach idi $reins {
1281 set id [lindex $idi 0]
1282 set j [lsearch -exact $displist $id]
1283 set xj [xcoord $j $dlevel $lj]
1284 set mainline($id) [list $xj $y2]
1285 set mainlinearrow($id) first
1289 foreach id $olddisplist {
1291 if {$id == {}} continue
1292 if {$onscreen($id) <= 0} continue
1293 set xi [xcoord $i $olddlevel $lineno]
1294 if {$i == $olddlevel} {
1295 foreach p $currentparents {
1296 set j [lsearch -exact $displist $p]
1297 set coords [list $xi $y1]
1298 set xj [xcoord $j $dlevel $lj]
1299 if {$xj < $xi - $linespc} {
1300 lappend coords [expr {$xj + $linespc}] $y1
1301 notecrossings $p $j $i [expr {$j + 1}]
1302 } elseif {$xj > $xi + $linespc} {
1303 lappend coords [expr {$xj - $linespc}] $y1
1304 notecrossings $p $i $j [expr {$j - 1}]
1306 if {[lsearch -exact $dupparents $p] >= 0} {
1307 # draw a double-width line to indicate the doubled parent
1308 lappend coords $xj $y2
1309 lappend sidelines($p) [list $coords 2 none]
1310 if {![info exists mainline($p)]} {
1311 set mainline($p) [list $xj $y2]
1312 set mainlinearrow($p) none
1315 # normal case, no parent duplicated
1317 set dx [expr {abs($xi - $xj)}]
1318 if {0 && $dx < $linespc} {
1319 set yb [expr {$y1 + $dx}]
1321 if {![info exists mainline($p)]} {
1323 lappend coords $xj $yb
1325 set mainline($p) $coords
1326 set mainlinearrow($p) none
1328 lappend coords $xj $yb
1330 lappend coords $xj $y2
1332 lappend sidelines($p) [list $coords 1 none]
1338 if {[lindex $displist $i] != $id} {
1339 set j [lsearch -exact $displist $id]
1341 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1342 || ($olddlevel < $i && $i < $dlevel)
1343 || ($dlevel < $i && $i < $olddlevel)} {
1344 set xj [xcoord $j $dlevel $lj]
1345 lappend mainline($id) $xi $y1 $xj $y2
1352 # search for x in a list of lists
1353 proc llsearch {llist x} {
1356 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1364 proc drawmore {reading} {
1365 global displayorder numcommits ncmupdate nextupdate
1366 global stopped nhyperspace parents commitlisted
1367 global maxwidth onscreen displist currentparents olddlevel
1369 set n [llength $displayorder]
1370 while {$numcommits < $n} {
1371 set id [lindex $displayorder $numcommits]
1372 set ctxend [expr {$numcommits + 10}]
1373 if {!$reading && $ctxend > $n} {
1377 if {$numcommits > 0} {
1378 set dlist [lreplace $displist $olddlevel $olddlevel]
1380 foreach p $currentparents {
1381 if {$onscreen($p) == 0} {
1382 set dlist [linsert $dlist $i $p]
1389 set isfat [expr {[llength $dlist] > $maxwidth}]
1390 if {$nhyperspace > 0 || $isfat} {
1391 if {$ctxend > $n} break
1392 # work out what to bring back and
1393 # what we want to don't want to send into hyperspace
1395 for {set k $numcommits} {$k < $ctxend} {incr k} {
1396 set x [lindex $displayorder $k]
1397 set i [llsearch $dlist $x]
1399 set i [llength $dlist]
1402 if {[lsearch -exact $nohs $x] < 0} {
1405 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1406 set reins [list $x $i]
1409 if {[info exists commitlisted($x)]} {
1411 foreach p $parents($x) {
1412 if {[llsearch $dlist $p] < 0} {
1414 if {[lsearch -exact $nohs $p] < 0} {
1417 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1418 set reins [list $p [expr {$i + $right}]]
1424 set l [lindex $dlist $i]
1425 if {[llength $l] == 1} {
1428 set j [lsearch -exact $l $x]
1429 set l [concat [lreplace $l $j $j] $newp]
1431 set dlist [lreplace $dlist $i $i $l]
1432 if {$room && $isfat && [llength $newp] <= 1} {
1438 set dlevel [drawslants $id $reins $nohs]
1439 drawcommitline $dlevel
1440 if {[clock clicks -milliseconds] >= $nextupdate
1441 && $numcommits >= $ncmupdate} {
1448 # level here is an index in todo
1449 proc updatetodo {level noshortcut} {
1450 global ncleft todo nnewparents
1451 global commitlisted parents onscreen
1453 set id [lindex $todo $level]
1455 if {[info exists commitlisted($id)]} {
1456 foreach p $parents($id) {
1457 if {[lsearch -exact $olds $p] < 0} {
1462 if {!$noshortcut && [llength $olds] == 1} {
1463 set p [lindex $olds 0]
1464 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1466 set todo [lreplace $todo $level $level $p]
1468 set nnewparents($id) 1
1473 set todo [lreplace $todo $level $level]
1478 set k [lsearch -exact $todo $p]
1480 set todo [linsert $todo $i $p]
1486 set nnewparents($id) $n
1491 proc decidenext {{noread 0}} {
1493 global datemode cdate
1496 # choose which one to do next time around
1497 set todol [llength $todo]
1500 for {set k $todol} {[incr k -1] >= 0} {} {
1501 set p [lindex $todo $k]
1502 if {$ncleft($p) == 0} {
1504 if {![info exists commitinfo($p)]} {
1510 if {$latest == {} || $cdate($p) > $latest} {
1512 set latest $cdate($p)
1524 proc drawcommit {id reading} {
1525 global phase todo nchildren datemode nextupdate revlistorder ncleft
1526 global numcommits ncmupdate displayorder todo onscreen parents
1527 global commitlisted commitordered
1529 if {$phase != "incrdraw"} {
1534 catch {unset commitordered}
1536 set commitordered($id) 1
1537 if {$nchildren($id) == 0} {
1541 if {$revlistorder} {
1542 set level [lsearch -exact $todo $id]
1544 error_popup "oops, $id isn't in todo"
1547 lappend displayorder $id
1550 set level [decidenext 1]
1551 if {$level == {} || $level < 0} return
1553 set id [lindex $todo $level]
1554 if {![info exists commitordered($id)]} {
1557 lappend displayorder [lindex $todo $level]
1558 if {[updatetodo $level $datemode]} {
1559 set level [decidenext 1]
1560 if {$level == {} || $level < 0} break
1567 proc finishcommits {} {
1568 global phase oldcommits commits
1569 global canv mainfont ctext maincursor textcursor
1570 global parents displayorder todo
1572 if {$phase == "incrdraw" || $phase == "removecommits"} {
1573 foreach id $oldcommits {
1579 } elseif {$phase == "updatecommits"} {
1580 # there were no new commits, in fact
1581 set commits $oldcommits
1586 $canv create text 3 3 -anchor nw -text "No commits selected" \
1587 -font $mainfont -tags textitems
1590 . config -cursor $maincursor
1591 settextcursor $textcursor
1594 # Don't change the text pane cursor if it is currently the hand cursor,
1595 # showing that we are over a sha1 ID link.
1596 proc settextcursor {c} {
1597 global ctext curtextcursor
1599 if {[$ctext cget -cursor] == $curtextcursor} {
1600 $ctext config -cursor $c
1602 set curtextcursor $c
1606 global nextupdate startmsecs ncmupdate
1607 global displayorder onscreen
1609 if {$displayorder == {}} return
1610 set startmsecs [clock clicks -milliseconds]
1611 set nextupdate [expr {$startmsecs + 100}]
1614 foreach id $displayorder {
1621 global phase stopped redisplaying selectedline
1622 global datemode todo displayorder ncleft
1623 global numcommits ncmupdate
1624 global nextupdate startmsecs revlistorder
1626 set level [decidenext]
1630 lappend displayorder [lindex $todo $level]
1631 set hard [updatetodo $level $datemode]
1633 set level [decidenext]
1634 if {$level < 0} break
1639 puts "ERROR: none of the pending commits can be done yet:"
1641 puts " $p ($ncleft($p))"
1647 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1648 #puts "overall $drawmsecs ms for $numcommits commits"
1649 if {$redisplaying} {
1650 if {$stopped == 0 && [info exists selectedline]} {
1651 selectline $selectedline 0
1653 if {$stopped == 1} {
1655 after idle drawgraph
1662 proc findmatches {f} {
1663 global findtype foundstring foundstrlen
1664 if {$findtype == "Regexp"} {
1665 set matches [regexp -indices -all -inline $foundstring $f]
1667 if {$findtype == "IgnCase"} {
1668 set str [string tolower $f]
1674 while {[set j [string first $foundstring $str $i]] >= 0} {
1675 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1676 set i [expr {$j + $foundstrlen}]
1683 global findtype findloc findstring markedmatches commitinfo
1684 global numcommits lineid linehtag linentag linedtag
1685 global mainfont namefont canv canv2 canv3 selectedline
1686 global matchinglines foundstring foundstrlen
1691 set matchinglines {}
1692 if {$findloc == "Pickaxe"} {
1696 if {$findtype == "IgnCase"} {
1697 set foundstring [string tolower $findstring]
1699 set foundstring $findstring
1701 set foundstrlen [string length $findstring]
1702 if {$foundstrlen == 0} return
1703 if {$findloc == "Files"} {
1707 if {![info exists selectedline]} {
1710 set oldsel $selectedline
1713 set fldtypes {Headline Author Date Committer CDate Comment}
1714 for {set l 0} {$l < $numcommits} {incr l} {
1716 set info $commitinfo($id)
1718 foreach f $info ty $fldtypes {
1719 if {$findloc != "All fields" && $findloc != $ty} {
1722 set matches [findmatches $f]
1723 if {$matches == {}} continue
1725 if {$ty == "Headline"} {
1726 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1727 } elseif {$ty == "Author"} {
1728 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1729 } elseif {$ty == "Date"} {
1730 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1734 lappend matchinglines $l
1735 if {!$didsel && $l > $oldsel} {
1741 if {$matchinglines == {}} {
1743 } elseif {!$didsel} {
1744 findselectline [lindex $matchinglines 0]
1748 proc findselectline {l} {
1749 global findloc commentend ctext
1751 if {$findloc == "All fields" || $findloc == "Comments"} {
1752 # highlight the matches in the comments
1753 set f [$ctext get 1.0 $commentend]
1754 set matches [findmatches $f]
1755 foreach match $matches {
1756 set start [lindex $match 0]
1757 set end [expr {[lindex $match 1] + 1}]
1758 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1763 proc findnext {restart} {
1764 global matchinglines selectedline
1765 if {![info exists matchinglines]} {
1771 if {![info exists selectedline]} return
1772 foreach l $matchinglines {
1773 if {$l > $selectedline} {
1782 global matchinglines selectedline
1783 if {![info exists matchinglines]} {
1787 if {![info exists selectedline]} return
1789 foreach l $matchinglines {
1790 if {$l >= $selectedline} break
1794 findselectline $prev
1800 proc findlocchange {name ix op} {
1801 global findloc findtype findtypemenu
1802 if {$findloc == "Pickaxe"} {
1808 $findtypemenu entryconf 1 -state $state
1809 $findtypemenu entryconf 2 -state $state
1812 proc stopfindproc {{done 0}} {
1813 global findprocpid findprocfile findids
1814 global ctext findoldcursor phase maincursor textcursor
1815 global findinprogress
1817 catch {unset findids}
1818 if {[info exists findprocpid]} {
1820 catch {exec kill $findprocpid}
1822 catch {close $findprocfile}
1825 if {[info exists findinprogress]} {
1826 unset findinprogress
1827 if {$phase != "incrdraw"} {
1828 . config -cursor $maincursor
1829 settextcursor $textcursor
1834 proc findpatches {} {
1835 global findstring selectedline numcommits
1836 global findprocpid findprocfile
1837 global finddidsel ctext lineid findinprogress
1838 global findinsertpos
1840 if {$numcommits == 0} return
1842 # make a list of all the ids to search, starting at the one
1843 # after the selected line (if any)
1844 if {[info exists selectedline]} {
1850 for {set i 0} {$i < $numcommits} {incr i} {
1851 if {[incr l] >= $numcommits} {
1854 append inputids $lineid($l) "\n"
1858 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1861 error_popup "Error starting search process: $err"
1865 set findinsertpos end
1867 set findprocpid [pid $f]
1868 fconfigure $f -blocking 0
1869 fileevent $f readable readfindproc
1871 . config -cursor watch
1873 set findinprogress 1
1876 proc readfindproc {} {
1877 global findprocfile finddidsel
1878 global idline matchinglines findinsertpos
1880 set n [gets $findprocfile line]
1882 if {[eof $findprocfile]} {
1890 if {![regexp {^[0-9a-f]{40}} $line id]} {
1891 error_popup "Can't parse git-diff-tree output: $line"
1895 if {![info exists idline($id)]} {
1896 puts stderr "spurious id: $id"
1903 proc insertmatch {l id} {
1904 global matchinglines findinsertpos finddidsel
1906 if {$findinsertpos == "end"} {
1907 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1908 set matchinglines [linsert $matchinglines 0 $l]
1911 lappend matchinglines $l
1914 set matchinglines [linsert $matchinglines $findinsertpos $l]
1925 global selectedline numcommits lineid ctext
1926 global ffileline finddidsel parents nparents
1927 global findinprogress findstartline findinsertpos
1928 global treediffs fdiffids fdiffsneeded fdiffpos
1929 global findmergefiles
1931 if {$numcommits == 0} return
1933 if {[info exists selectedline]} {
1934 set l [expr {$selectedline + 1}]
1939 set findstartline $l
1944 if {$findmergefiles || $nparents($id) == 1} {
1945 foreach p $parents($id) {
1946 if {![info exists treediffs([list $id $p])]} {
1947 append diffsneeded "$id $p\n"
1948 lappend fdiffsneeded [list $id $p]
1952 if {[incr l] >= $numcommits} {
1955 if {$l == $findstartline} break
1958 # start off a git-diff-tree process if needed
1959 if {$diffsneeded ne {}} {
1961 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1963 error_popup "Error starting search process: $err"
1966 catch {unset fdiffids}
1968 fconfigure $df -blocking 0
1969 fileevent $df readable [list readfilediffs $df]
1973 set findinsertpos end
1975 set p [lindex $parents($id) 0]
1976 . config -cursor watch
1978 set findinprogress 1
1979 findcont [list $id $p]
1983 proc readfilediffs {df} {
1984 global findids fdiffids fdiffs
1986 set n [gets $df line]
1990 if {[catch {close $df} err]} {
1993 error_popup "Error in git-diff-tree: $err"
1994 } elseif {[info exists findids]} {
1998 error_popup "Couldn't find diffs for {$ids}"
2003 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
2004 # start of a new string of diffs
2006 set fdiffids [list $id $p]
2008 } elseif {[string match ":*" $line]} {
2009 lappend fdiffs [lindex $line 5]
2013 proc donefilediff {} {
2014 global fdiffids fdiffs treediffs findids
2015 global fdiffsneeded fdiffpos
2017 if {[info exists fdiffids]} {
2018 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
2019 && $fdiffpos < [llength $fdiffsneeded]} {
2020 # git-diff-tree doesn't output anything for a commit
2021 # which doesn't change anything
2022 set nullids [lindex $fdiffsneeded $fdiffpos]
2023 set treediffs($nullids) {}
2024 if {[info exists findids] && $nullids eq $findids} {
2032 if {![info exists treediffs($fdiffids)]} {
2033 set treediffs($fdiffids) $fdiffs
2035 if {[info exists findids] && $fdiffids eq $findids} {
2042 proc findcont {ids} {
2043 global findids treediffs parents nparents
2044 global ffileline findstartline finddidsel
2045 global lineid numcommits matchinglines findinprogress
2046 global findmergefiles
2048 set id [lindex $ids 0]
2049 set p [lindex $ids 1]
2050 set pi [lsearch -exact $parents($id) $p]
2053 if {$findmergefiles || $nparents($id) == 1} {
2054 if {![info exists treediffs($ids)]} {
2060 foreach f $treediffs($ids) {
2061 set x [findmatches $f]
2069 set pi $nparents($id)
2072 set pi $nparents($id)
2074 if {[incr pi] >= $nparents($id)} {
2076 if {[incr l] >= $numcommits} {
2079 if {$l == $findstartline} break
2082 set p [lindex $parents($id) $pi]
2083 set ids [list $id $p]
2091 # mark a commit as matching by putting a yellow background
2092 # behind the headline
2093 proc markheadline {l id} {
2094 global canv mainfont linehtag commitinfo
2096 set bbox [$canv bbox $linehtag($l)]
2097 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2101 # mark the bits of a headline, author or date that match a find string
2102 proc markmatches {canv l str tag matches font} {
2103 set bbox [$canv bbox $tag]
2104 set x0 [lindex $bbox 0]
2105 set y0 [lindex $bbox 1]
2106 set y1 [lindex $bbox 3]
2107 foreach match $matches {
2108 set start [lindex $match 0]
2109 set end [lindex $match 1]
2110 if {$start > $end} continue
2111 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2112 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2113 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2114 [expr {$x0+$xlen+2}] $y1 \
2115 -outline {} -tags matches -fill yellow]
2120 proc unmarkmatches {} {
2121 global matchinglines findids
2122 allcanvs delete matches
2123 catch {unset matchinglines}
2124 catch {unset findids}
2127 proc selcanvline {w x y} {
2128 global canv canvy0 ctext linespc
2129 global lineid linehtag linentag linedtag rowtextx
2130 set ymax [lindex [$canv cget -scrollregion] 3]
2131 if {$ymax == {}} return
2132 set yfrac [lindex [$canv yview] 0]
2133 set y [expr {$y + $yfrac * $ymax}]
2134 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2139 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2145 proc commit_descriptor {p} {
2148 if {[info exists commitinfo($p)]} {
2149 set l [lindex $commitinfo($p) 0]
2154 # append some text to the ctext widget, and make any SHA1 ID
2155 # that we know about be a clickable link.
2156 proc appendwithlinks {text} {
2157 global ctext idline linknum
2159 set start [$ctext index "end - 1c"]
2160 $ctext insert end $text
2161 $ctext insert end "\n"
2162 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2166 set linkid [string range $text $s $e]
2167 if {![info exists idline($linkid)]} continue
2169 $ctext tag add link "$start + $s c" "$start + $e c"
2170 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2171 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2174 $ctext tag conf link -foreground blue -underline 1
2175 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2176 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2179 proc selectline {l isnew} {
2180 global canv canv2 canv3 ctext commitinfo selectedline
2181 global lineid linehtag linentag linedtag
2182 global canvy0 linespc parents nparents children
2183 global cflist currentid sha1entry
2184 global commentend idtags idline linknum
2188 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2190 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2191 -tags secsel -fill [$canv cget -selectbackground]]
2193 $canv2 delete secsel
2194 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2195 -tags secsel -fill [$canv2 cget -selectbackground]]
2197 $canv3 delete secsel
2198 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2199 -tags secsel -fill [$canv3 cget -selectbackground]]
2201 set y [expr {$canvy0 + $l * $linespc}]
2202 set ymax [lindex [$canv cget -scrollregion] 3]
2203 set ytop [expr {$y - $linespc - 1}]
2204 set ybot [expr {$y + $linespc + 1}]
2205 set wnow [$canv yview]
2206 set wtop [expr {[lindex $wnow 0] * $ymax}]
2207 set wbot [expr {[lindex $wnow 1] * $ymax}]
2208 set wh [expr {$wbot - $wtop}]
2210 if {$ytop < $wtop} {
2211 if {$ybot < $wtop} {
2212 set newtop [expr {$y - $wh / 2.0}]
2215 if {$newtop > $wtop - $linespc} {
2216 set newtop [expr {$wtop - $linespc}]
2219 } elseif {$ybot > $wbot} {
2220 if {$ytop > $wbot} {
2221 set newtop [expr {$y - $wh / 2.0}]
2223 set newtop [expr {$ybot - $wh}]
2224 if {$newtop < $wtop + $linespc} {
2225 set newtop [expr {$wtop + $linespc}]
2229 if {$newtop != $wtop} {
2233 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2237 addtohistory [list selectline $l 0]
2244 $sha1entry delete 0 end
2245 $sha1entry insert 0 $id
2246 $sha1entry selection from 0
2247 $sha1entry selection to end
2249 $ctext conf -state normal
2250 $ctext delete 0.0 end
2252 $ctext mark set fmark.0 0.0
2253 $ctext mark gravity fmark.0 left
2254 set info $commitinfo($id)
2255 set date [formatdate [lindex $info 2]]
2256 $ctext insert end "Author: [lindex $info 1] $date\n"
2257 set date [formatdate [lindex $info 4]]
2258 $ctext insert end "Committer: [lindex $info 3] $date\n"
2259 if {[info exists idtags($id)]} {
2260 $ctext insert end "Tags:"
2261 foreach tag $idtags($id) {
2262 $ctext insert end " $tag"
2264 $ctext insert end "\n"
2268 if {[info exists parents($id)]} {
2269 foreach p $parents($id) {
2270 append comment "Parent: [commit_descriptor $p]\n"
2273 if {[info exists children($id)]} {
2274 foreach c $children($id) {
2275 append comment "Child: [commit_descriptor $c]\n"
2279 append comment [lindex $info 5]
2281 # make anything that looks like a SHA1 ID be a clickable link
2282 appendwithlinks $comment
2284 $ctext tag delete Comments
2285 $ctext tag remove found 1.0 end
2286 $ctext conf -state disabled
2287 set commentend [$ctext index "end - 1c"]
2289 $cflist delete 0 end
2290 $cflist insert end "Comments"
2291 if {$nparents($id) == 1} {
2293 } elseif {$nparents($id) > 1} {
2298 proc selnextline {dir} {
2300 if {![info exists selectedline]} return
2301 set l [expr {$selectedline + $dir}]
2306 proc unselectline {} {
2309 catch {unset selectedline}
2310 allcanvs delete secsel
2313 proc addtohistory {cmd} {
2314 global history historyindex
2316 if {$historyindex > 0
2317 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2321 if {$historyindex < [llength $history]} {
2322 set history [lreplace $history $historyindex end $cmd]
2324 lappend history $cmd
2327 if {$historyindex > 1} {
2328 .ctop.top.bar.leftbut conf -state normal
2330 .ctop.top.bar.leftbut conf -state disabled
2332 .ctop.top.bar.rightbut conf -state disabled
2336 global history historyindex
2338 if {$historyindex > 1} {
2339 incr historyindex -1
2340 set cmd [lindex $history [expr {$historyindex - 1}]]
2342 .ctop.top.bar.rightbut conf -state normal
2344 if {$historyindex <= 1} {
2345 .ctop.top.bar.leftbut conf -state disabled
2350 global history historyindex
2352 if {$historyindex < [llength $history]} {
2353 set cmd [lindex $history $historyindex]
2356 .ctop.top.bar.leftbut conf -state normal
2358 if {$historyindex >= [llength $history]} {
2359 .ctop.top.bar.rightbut conf -state disabled
2363 proc mergediff {id} {
2364 global parents diffmergeid diffmergegca mergefilelist diffpindex
2368 set diffmergegca [findgca $parents($id)]
2369 if {[info exists mergefilelist($id)]} {
2370 if {$mergefilelist($id) ne {}} {
2378 proc findgca {ids} {
2385 set gca [exec git-merge-base $gca $id]
2394 proc contmergediff {ids} {
2395 global diffmergeid diffpindex parents nparents diffmergegca
2396 global treediffs mergefilelist diffids treepending
2398 # diff the child against each of the parents, and diff
2399 # each of the parents against the GCA.
2401 if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} {
2402 set ids [list $diffmergegca [lindex $ids 0]]
2404 if {[incr diffpindex] >= $nparents($diffmergeid)} break
2405 set p [lindex $parents($diffmergeid) $diffpindex]
2406 set ids [list $p $diffmergeid]
2408 if {![info exists treediffs($ids)]} {
2410 if {![info exists treepending]} {
2417 # If a file in some parent is different from the child and also
2418 # different from the GCA, then it's interesting.
2419 # If we don't have a GCA, then a file is interesting if it is
2420 # different from the child in all the parents.
2421 if {$diffmergegca ne {}} {
2423 foreach p $parents($diffmergeid) {
2424 set gcadiffs $treediffs([list $diffmergegca $p])
2425 foreach f $treediffs([list $p $diffmergeid]) {
2426 if {[lsearch -exact $files $f] < 0
2427 && [lsearch -exact $gcadiffs $f] >= 0} {
2432 set files [lsort $files]
2434 set p [lindex $parents($diffmergeid) 0]
2435 set files $treediffs([list $diffmergeid $p])
2436 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2437 set p [lindex $parents($diffmergeid) $i]
2438 set df $treediffs([list $p $diffmergeid])
2441 if {[lsearch -exact $df $f] >= 0} {
2449 set mergefilelist($diffmergeid) $files
2455 proc showmergediff {} {
2456 global cflist diffmergeid mergefilelist parents
2457 global diffopts diffinhunk currentfile currenthunk filelines
2458 global diffblocked groupfilelast mergefds groupfilenum grouphunks
2460 set files $mergefilelist($diffmergeid)
2462 $cflist insert end $f
2464 set env(GIT_DIFF_OPTS) $diffopts
2466 catch {unset currentfile}
2467 catch {unset currenthunk}
2468 catch {unset filelines}
2469 catch {unset groupfilenum}
2470 catch {unset grouphunks}
2471 set groupfilelast -1
2472 foreach p $parents($diffmergeid) {
2473 set cmd [list | git-diff-tree -p $p $diffmergeid]
2474 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2475 if {[catch {set f [open $cmd r]} err]} {
2476 error_popup "Error getting diffs: $err"
2483 set ids [list $diffmergeid $p]
2484 set mergefds($ids) $f
2485 set diffinhunk($ids) 0
2486 set diffblocked($ids) 0
2487 fconfigure $f -blocking 0
2488 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2492 proc getmergediffline {f ids id} {
2493 global diffmergeid diffinhunk diffoldlines diffnewlines
2494 global currentfile currenthunk
2495 global diffoldstart diffnewstart diffoldlno diffnewlno
2496 global diffblocked mergefilelist
2497 global noldlines nnewlines difflcounts filelines
2499 set n [gets $f line]
2501 if {![eof $f]} return
2504 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2511 if {$diffinhunk($ids) != 0} {
2512 set fi $currentfile($ids)
2513 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2514 # continuing an existing hunk
2515 set line [string range $line 1 end]
2516 set p [lindex $ids 1]
2517 if {$match eq "-" || $match eq " "} {
2518 set filelines($p,$fi,$diffoldlno($ids)) $line
2519 incr diffoldlno($ids)
2521 if {$match eq "+" || $match eq " "} {
2522 set filelines($id,$fi,$diffnewlno($ids)) $line
2523 incr diffnewlno($ids)
2525 if {$match eq " "} {
2526 if {$diffinhunk($ids) == 2} {
2527 lappend difflcounts($ids) \
2528 [list $noldlines($ids) $nnewlines($ids)]
2529 set noldlines($ids) 0
2530 set diffinhunk($ids) 1
2532 incr noldlines($ids)
2533 } elseif {$match eq "-" || $match eq "+"} {
2534 if {$diffinhunk($ids) == 1} {
2535 lappend difflcounts($ids) [list $noldlines($ids)]
2536 set noldlines($ids) 0
2537 set nnewlines($ids) 0
2538 set diffinhunk($ids) 2
2540 if {$match eq "-"} {
2541 incr noldlines($ids)
2543 incr nnewlines($ids)
2546 # and if it's \ No newline at end of line, then what?
2550 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2551 lappend difflcounts($ids) [list $noldlines($ids)]
2552 } elseif {$diffinhunk($ids) == 2
2553 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2554 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2556 set currenthunk($ids) [list $currentfile($ids) \
2557 $diffoldstart($ids) $diffnewstart($ids) \
2558 $diffoldlno($ids) $diffnewlno($ids) \
2560 set diffinhunk($ids) 0
2561 # -1 = need to block, 0 = unblocked, 1 = is blocked
2562 set diffblocked($ids) -1
2564 if {$diffblocked($ids) == -1} {
2565 fileevent $f readable {}
2566 set diffblocked($ids) 1
2572 if {!$diffblocked($ids)} {
2574 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2575 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2578 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2579 # start of a new file
2580 set currentfile($ids) \
2581 [lsearch -exact $mergefilelist($diffmergeid) $fname]
2582 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2583 $line match f1l f1c f2l f2c rest]} {
2584 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2585 # start of a new hunk
2586 if {$f1l == 0 && $f1c == 0} {
2589 if {$f2l == 0 && $f2c == 0} {
2592 set diffinhunk($ids) 1
2593 set diffoldstart($ids) $f1l
2594 set diffnewstart($ids) $f2l
2595 set diffoldlno($ids) $f1l
2596 set diffnewlno($ids) $f2l
2597 set difflcounts($ids) {}
2598 set noldlines($ids) 0
2599 set nnewlines($ids) 0
2604 proc processhunks {} {
2605 global diffmergeid parents nparents currenthunk
2606 global mergefilelist diffblocked mergefds
2607 global grouphunks grouplinestart grouplineend groupfilenum
2609 set nfiles [llength $mergefilelist($diffmergeid)]
2613 # look for the earliest hunk
2614 foreach p $parents($diffmergeid) {
2615 set ids [list $diffmergeid $p]
2616 if {![info exists currenthunk($ids)]} return
2617 set i [lindex $currenthunk($ids) 0]
2618 set l [lindex $currenthunk($ids) 2]
2619 if {$i < $fi || ($i == $fi && $l < $lno)} {
2626 if {$fi < $nfiles} {
2627 set ids [list $diffmergeid $pi]
2628 set hunk $currenthunk($ids)
2629 unset currenthunk($ids)
2630 if {$diffblocked($ids) > 0} {
2631 fileevent $mergefds($ids) readable \
2632 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2634 set diffblocked($ids) 0
2636 if {[info exists groupfilenum] && $groupfilenum == $fi
2637 && $lno <= $grouplineend} {
2638 # add this hunk to the pending group
2639 lappend grouphunks($pi) $hunk
2640 set endln [lindex $hunk 4]
2641 if {$endln > $grouplineend} {
2642 set grouplineend $endln
2648 # succeeding stuff doesn't belong in this group, so
2649 # process the group now
2650 if {[info exists groupfilenum]} {
2656 if {$fi >= $nfiles} break
2659 set groupfilenum $fi
2660 set grouphunks($pi) [list $hunk]
2661 set grouplinestart $lno
2662 set grouplineend [lindex $hunk 4]
2666 proc processgroup {} {
2667 global groupfilelast groupfilenum difffilestart
2668 global mergefilelist diffmergeid ctext filelines
2669 global parents diffmergeid diffoffset
2670 global grouphunks grouplinestart grouplineend nparents
2673 $ctext conf -state normal
2676 if {$groupfilelast != $f} {
2677 $ctext insert end "\n"
2678 set here [$ctext index "end - 1c"]
2679 set difffilestart($f) $here
2680 set mark fmark.[expr {$f + 1}]
2681 $ctext mark set $mark $here
2682 $ctext mark gravity $mark left
2683 set header [lindex $mergefilelist($id) $f]
2684 set l [expr {(78 - [string length $header]) / 2}]
2685 set pad [string range "----------------------------------------" 1 $l]
2686 $ctext insert end "$pad $header $pad\n" filesep
2687 set groupfilelast $f
2688 foreach p $parents($id) {
2689 set diffoffset($p) 0
2693 $ctext insert end "@@" msep
2694 set nlines [expr {$grouplineend - $grouplinestart}]
2697 foreach p $parents($id) {
2698 set startline [expr {$grouplinestart + $diffoffset($p)}]
2700 set nl $grouplinestart
2701 if {[info exists grouphunks($p)]} {
2702 foreach h $grouphunks($p) {
2705 for {} {$nl < $l} {incr nl} {
2706 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2710 foreach chunk [lindex $h 5] {
2711 if {[llength $chunk] == 2} {
2712 set olc [lindex $chunk 0]
2713 set nlc [lindex $chunk 1]
2714 set nnl [expr {$nl + $nlc}]
2715 lappend events [list $nl $nnl $pnum $olc $nlc]
2719 incr ol [lindex $chunk 0]
2720 incr nl [lindex $chunk 0]
2725 if {$nl < $grouplineend} {
2726 for {} {$nl < $grouplineend} {incr nl} {
2727 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2731 set nlines [expr {$ol - $startline}]
2732 $ctext insert end " -$startline,$nlines" msep
2736 set nlines [expr {$grouplineend - $grouplinestart}]
2737 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2739 set events [lsort -integer -index 0 $events]
2740 set nevents [llength $events]
2741 set nmerge $nparents($diffmergeid)
2742 set l $grouplinestart
2743 for {set i 0} {$i < $nevents} {set i $j} {
2744 set nl [lindex $events $i 0]
2746 $ctext insert end " $filelines($id,$f,$l)\n"
2749 set e [lindex $events $i]
2750 set enl [lindex $e 1]
2754 set pnum [lindex $e 2]
2755 set olc [lindex $e 3]
2756 set nlc [lindex $e 4]
2757 if {![info exists delta($pnum)]} {
2758 set delta($pnum) [expr {$olc - $nlc}]
2759 lappend active $pnum
2761 incr delta($pnum) [expr {$olc - $nlc}]
2763 if {[incr j] >= $nevents} break
2764 set e [lindex $events $j]
2765 if {[lindex $e 0] >= $enl} break
2766 if {[lindex $e 1] > $enl} {
2767 set enl [lindex $e 1]
2770 set nlc [expr {$enl - $l}]
2773 if {[llength $active] == $nmerge - 1} {
2774 # no diff for one of the parents, i.e. it's identical
2775 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2776 if {![info exists delta($pnum)]} {
2777 if {$pnum < $mergemax} {
2785 } elseif {[llength $active] == $nmerge} {
2786 # all parents are different, see if one is very similar
2788 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2789 set sim [similarity $pnum $l $nlc $f \
2790 [lrange $events $i [expr {$j-1}]]]
2791 if {$sim > $bestsim} {
2797 lappend ncol m$bestpn
2801 foreach p $parents($id) {
2803 if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2804 set olc [expr {$nlc + $delta($pnum)}]
2805 set ol [expr {$l + $diffoffset($p)}]
2806 incr diffoffset($p) $delta($pnum)
2808 for {} {$olc > 0} {incr olc -1} {
2809 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2813 set endl [expr {$l + $nlc}]
2815 # show this pretty much as a normal diff
2816 set p [lindex $parents($id) $bestpn]
2817 set ol [expr {$l + $diffoffset($p)}]
2818 incr diffoffset($p) $delta($bestpn)
2819 unset delta($bestpn)
2820 for {set k $i} {$k < $j} {incr k} {
2821 set e [lindex $events $k]
2822 if {[lindex $e 2] != $bestpn} continue
2823 set nl [lindex $e 0]
2824 set ol [expr {$ol + $nl - $l}]
2825 for {} {$l < $nl} {incr l} {
2826 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2829 for {} {$c > 0} {incr c -1} {
2830 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2833 set nl [lindex $e 1]
2834 for {} {$l < $nl} {incr l} {
2835 $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2839 for {} {$l < $endl} {incr l} {
2840 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2843 while {$l < $grouplineend} {
2844 $ctext insert end " $filelines($id,$f,$l)\n"
2847 $ctext conf -state disabled
2850 proc similarity {pnum l nlc f events} {
2851 global diffmergeid parents diffoffset filelines
2854 set p [lindex $parents($id) $pnum]
2855 set ol [expr {$l + $diffoffset($p)}]
2856 set endl [expr {$l + $nlc}]
2860 if {[lindex $e 2] != $pnum} continue
2861 set nl [lindex $e 0]
2862 set ol [expr {$ol + $nl - $l}]
2863 for {} {$l < $nl} {incr l} {
2864 incr same [string length $filelines($id,$f,$l)]
2867 set oc [lindex $e 3]
2868 for {} {$oc > 0} {incr oc -1} {
2869 incr diff [string length $filelines($p,$f,$ol)]
2873 set nl [lindex $e 1]
2874 for {} {$l < $nl} {incr l} {
2875 incr diff [string length $filelines($id,$f,$l)]
2879 for {} {$l < $endl} {incr l} {
2880 incr same [string length $filelines($id,$f,$l)]
2886 return [expr {200 * $same / (2 * $same + $diff)}]
2889 proc startdiff {ids} {
2890 global treediffs diffids treepending diffmergeid
2893 catch {unset diffmergeid}
2894 if {![info exists treediffs($ids)]} {
2895 if {![info exists treepending]} {
2903 proc addtocflist {ids} {
2904 global treediffs cflist
2905 foreach f $treediffs($ids) {
2906 $cflist insert end $f
2911 proc gettreediffs {ids} {
2912 global treediff parents treepending
2913 set treepending $ids
2915 if [catch {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return
2916 fconfigure $gdtf -blocking 0
2917 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2920 proc gettreediffline {gdtf ids} {
2921 global treediff treediffs treepending diffids diffmergeid
2923 set n [gets $gdtf line]
2925 if {![eof $gdtf]} return
2927 set treediffs($ids) $treediff
2929 if {$ids != $diffids} {
2930 gettreediffs $diffids
2932 if {[info exists diffmergeid]} {
2940 set file [lindex $line 5]
2941 lappend treediff $file
2944 proc getblobdiffs {ids} {
2945 global diffopts blobdifffd diffids env curdifftag curtagstart
2946 global difffilestart nextupdate diffinhdr treediffs
2948 set env(GIT_DIFF_OPTS) $diffopts
2949 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2950 if {[catch {set bdf [open $cmd r]} err]} {
2951 puts "error getting diffs: $err"
2955 fconfigure $bdf -blocking 0
2956 set blobdifffd($ids) $bdf
2957 set curdifftag Comments
2959 catch {unset difffilestart}
2960 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2961 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2964 proc getblobdiffline {bdf ids} {
2965 global diffids blobdifffd ctext curdifftag curtagstart
2966 global diffnexthead diffnextnote difffilestart
2967 global nextupdate diffinhdr treediffs
2969 set n [gets $bdf line]
2973 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2974 $ctext tag add $curdifftag $curtagstart end
2979 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2982 $ctext conf -state normal
2983 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2984 # start of a new file
2985 $ctext insert end "\n"
2986 $ctext tag add $curdifftag $curtagstart end
2987 set curtagstart [$ctext index "end - 1c"]
2989 set here [$ctext index "end - 1c"]
2990 set i [lsearch -exact $treediffs($diffids) $fname]
2992 set difffilestart($i) $here
2994 $ctext mark set fmark.$i $here
2995 $ctext mark gravity fmark.$i left
2997 if {$newname != $fname} {
2998 set i [lsearch -exact $treediffs($diffids) $newname]
3000 set difffilestart($i) $here
3002 $ctext mark set fmark.$i $here
3003 $ctext mark gravity fmark.$i left
3006 set curdifftag "f:$fname"
3007 $ctext tag delete $curdifftag
3008 set l [expr {(78 - [string length $header]) / 2}]
3009 set pad [string range "----------------------------------------" 1 $l]
3010 $ctext insert end "$pad $header $pad\n" filesep
3012 } elseif {[regexp {^(---|\+\+\+)} $line]} {
3014 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3015 $line match f1l f1c f2l f2c rest]} {
3016 $ctext insert end "$line\n" hunksep
3019 set x [string range $line 0 0]
3020 if {$x == "-" || $x == "+"} {
3021 set tag [expr {$x == "+"}]
3022 $ctext insert end "$line\n" d$tag
3023 } elseif {$x == " "} {
3024 $ctext insert end "$line\n"
3025 } elseif {$diffinhdr || $x == "\\"} {
3026 # e.g. "\ No newline at end of file"
3027 $ctext insert end "$line\n" filesep
3029 # Something else we don't recognize
3030 if {$curdifftag != "Comments"} {
3031 $ctext insert end "\n"
3032 $ctext tag add $curdifftag $curtagstart end
3033 set curtagstart [$ctext index "end - 1c"]
3034 set curdifftag Comments
3036 $ctext insert end "$line\n" filesep
3039 $ctext conf -state disabled
3040 if {[clock clicks -milliseconds] >= $nextupdate} {
3042 fileevent $bdf readable {}
3044 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3049 global difffilestart ctext
3050 set here [$ctext index @0,0]
3051 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3052 if {[$ctext compare $difffilestart($i) > $here]} {
3053 if {![info exists pos]
3054 || [$ctext compare $difffilestart($i) < $pos]} {
3055 set pos $difffilestart($i)
3059 if {[info exists pos]} {
3064 proc listboxsel {} {
3065 global ctext cflist currentid
3066 if {![info exists currentid]} return
3067 set sel [lsort [$cflist curselection]]
3068 if {$sel eq {}} return
3069 set first [lindex $sel 0]
3070 catch {$ctext yview fmark.$first}
3074 global linespc charspc canvx0 canvy0 mainfont
3075 global xspc1 xspc2 lthickness
3077 set linespc [font metrics $mainfont -linespace]
3078 set charspc [font measure $mainfont "m"]
3079 set canvy0 [expr {3 + 0.5 * $linespc}]
3080 set canvx0 [expr {3 + 0.5 * $linespc}]
3081 set lthickness [expr {int($linespc / 9) + 1}]
3082 set xspc1(0) $linespc
3087 global stopped redisplaying phase
3088 if {$stopped > 1} return
3089 if {$phase == "getcommits"} return
3091 if {$phase == "drawgraph" || $phase == "incrdraw"} {
3098 proc incrfont {inc} {
3099 global mainfont namefont textfont ctext canv phase
3100 global stopped entries
3102 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3103 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3104 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3106 $ctext conf -font $textfont
3107 $ctext tag conf filesep -font [concat $textfont bold]
3108 foreach e $entries {
3109 $e conf -font $mainfont
3111 if {$phase == "getcommits"} {
3112 $canv itemconf textitems -font $mainfont
3118 global sha1entry sha1string
3119 if {[string length $sha1string] == 40} {
3120 $sha1entry delete 0 end
3124 proc sha1change {n1 n2 op} {
3125 global sha1string currentid sha1but
3126 if {$sha1string == {}
3127 || ([info exists currentid] && $sha1string == $currentid)} {
3132 if {[$sha1but cget -state] == $state} return
3133 if {$state == "normal"} {
3134 $sha1but conf -state normal -relief raised -text "Goto: "
3136 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3140 proc gotocommit {} {
3141 global sha1string currentid idline tagids
3142 global lineid numcommits
3144 if {$sha1string == {}
3145 || ([info exists currentid] && $sha1string == $currentid)} return
3146 if {[info exists tagids($sha1string)]} {
3147 set id $tagids($sha1string)
3149 set id [string tolower $sha1string]
3150 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3152 for {set l 0} {$l < $numcommits} {incr l} {
3153 if {[string match $id* $lineid($l)]} {
3154 lappend matches $lineid($l)
3157 if {$matches ne {}} {
3158 if {[llength $matches] > 1} {
3159 error_popup "Short SHA1 id $id is ambiguous"
3162 set id [lindex $matches 0]
3166 if {[info exists idline($id)]} {
3167 selectline $idline($id) 1
3170 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3175 error_popup "$type $sha1string is not known"
3178 proc lineenter {x y id} {
3179 global hoverx hovery hoverid hovertimer
3180 global commitinfo canv
3182 if {![info exists commitinfo($id)]} return
3186 if {[info exists hovertimer]} {
3187 after cancel $hovertimer
3189 set hovertimer [after 500 linehover]
3193 proc linemotion {x y id} {
3194 global hoverx hovery hoverid hovertimer
3196 if {[info exists hoverid] && $id == $hoverid} {
3199 if {[info exists hovertimer]} {
3200 after cancel $hovertimer
3202 set hovertimer [after 500 linehover]
3206 proc lineleave {id} {
3207 global hoverid hovertimer canv
3209 if {[info exists hoverid] && $id == $hoverid} {
3211 if {[info exists hovertimer]} {
3212 after cancel $hovertimer
3220 global hoverx hovery hoverid hovertimer
3221 global canv linespc lthickness
3222 global commitinfo mainfont
3224 set text [lindex $commitinfo($hoverid) 0]
3225 set ymax [lindex [$canv cget -scrollregion] 3]
3226 if {$ymax == {}} return
3227 set yfrac [lindex [$canv yview] 0]
3228 set x [expr {$hoverx + 2 * $linespc}]
3229 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3230 set x0 [expr {$x - 2 * $lthickness}]
3231 set y0 [expr {$y - 2 * $lthickness}]
3232 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3233 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3234 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3235 -fill \#ffff80 -outline black -width 1 -tags hover]
3237 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3241 proc clickisonarrow {id y} {
3242 global mainline mainlinearrow sidelines lthickness
3244 set thresh [expr {2 * $lthickness + 6}]
3245 if {[info exists mainline($id)]} {
3246 if {$mainlinearrow($id) ne "none"} {
3247 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3252 if {[info exists sidelines($id)]} {
3253 foreach ls $sidelines($id) {
3254 set coords [lindex $ls 0]
3255 set arrow [lindex $ls 2]
3256 if {$arrow eq "first" || $arrow eq "both"} {
3257 if {abs([lindex $coords 1] - $y) < $thresh} {
3261 if {$arrow eq "last" || $arrow eq "both"} {
3262 if {abs([lindex $coords end] - $y) < $thresh} {
3271 proc arrowjump {id dirn y} {
3272 global mainline sidelines canv canv2 canv3
3275 if {$dirn eq "down"} {
3276 if {[info exists mainline($id)]} {
3277 set y1 [lindex $mainline($id) 1]
3282 if {[info exists sidelines($id)]} {
3283 foreach ls $sidelines($id) {
3284 set y1 [lindex $ls 0 1]
3285 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3291 if {[info exists sidelines($id)]} {
3292 foreach ls $sidelines($id) {
3293 set y1 [lindex $ls 0 end]
3294 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3300 if {$yt eq {}} return
3301 set ymax [lindex [$canv cget -scrollregion] 3]
3302 if {$ymax eq {} || $ymax <= 0} return
3303 set view [$canv yview]
3304 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3305 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3309 $canv yview moveto $yfrac
3310 $canv2 yview moveto $yfrac
3311 $canv3 yview moveto $yfrac
3314 proc lineclick {x y id isnew} {
3315 global ctext commitinfo children cflist canv thickerline
3321 # draw this line thicker than normal
3325 set ymax [lindex [$canv cget -scrollregion] 3]
3326 if {$ymax eq {}} return
3327 set yfrac [lindex [$canv yview] 0]
3328 set y [expr {$y + $yfrac * $ymax}]
3330 set dirn [clickisonarrow $id $y]
3332 arrowjump $id $dirn $y
3337 addtohistory [list lineclick $x $y $id 0]
3339 # fill the details pane with info about this line
3340 $ctext conf -state normal
3341 $ctext delete 0.0 end
3342 $ctext tag conf link -foreground blue -underline 1
3343 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3344 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3345 $ctext insert end "Parent:\t"
3346 $ctext insert end $id [list link link0]
3347 $ctext tag bind link0 <1> [list selbyid $id]
3348 set info $commitinfo($id)
3349 $ctext insert end "\n\t[lindex $info 0]\n"
3350 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3351 set date [formatdate [lindex $info 2]]
3352 $ctext insert end "\tDate:\t$date\n"
3353 if {[info exists children($id)]} {
3354 $ctext insert end "\nChildren:"
3356 foreach child $children($id) {
3358 set info $commitinfo($child)
3359 $ctext insert end "\n\t"
3360 $ctext insert end $child [list link link$i]
3361 $ctext tag bind link$i <1> [list selbyid $child]
3362 $ctext insert end "\n\t[lindex $info 0]"
3363 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3364 set date [formatdate [lindex $info 2]]
3365 $ctext insert end "\n\tDate:\t$date\n"
3368 $ctext conf -state disabled
3370 $cflist delete 0 end
3373 proc normalline {} {
3375 if {[info exists thickerline]} {
3376 drawlines $thickerline 0 1
3383 if {[info exists idline($id)]} {
3384 selectline $idline($id) 1
3390 if {![info exists startmstime]} {
3391 set startmstime [clock clicks -milliseconds]
3393 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3396 proc rowmenu {x y id} {
3397 global rowctxmenu idline selectedline rowmenuid
3399 if {![info exists selectedline] || $idline($id) eq $selectedline} {
3404 $rowctxmenu entryconfigure 0 -state $state
3405 $rowctxmenu entryconfigure 1 -state $state
3406 $rowctxmenu entryconfigure 2 -state $state
3408 tk_popup $rowctxmenu $x $y
3411 proc diffvssel {dirn} {
3412 global rowmenuid selectedline lineid
3414 if {![info exists selectedline]} return
3416 set oldid $lineid($selectedline)
3417 set newid $rowmenuid
3419 set oldid $rowmenuid
3420 set newid $lineid($selectedline)
3422 addtohistory [list doseldiff $oldid $newid]
3423 doseldiff $oldid $newid
3426 proc doseldiff {oldid newid} {
3430 $ctext conf -state normal
3431 $ctext delete 0.0 end
3432 $ctext mark set fmark.0 0.0
3433 $ctext mark gravity fmark.0 left
3434 $cflist delete 0 end
3435 $cflist insert end "Top"
3436 $ctext insert end "From "
3437 $ctext tag conf link -foreground blue -underline 1
3438 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3439 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3440 $ctext tag bind link0 <1> [list selbyid $oldid]
3441 $ctext insert end $oldid [list link link0]
3442 $ctext insert end "\n "
3443 $ctext insert end [lindex $commitinfo($oldid) 0]
3444 $ctext insert end "\n\nTo "
3445 $ctext tag bind link1 <1> [list selbyid $newid]
3446 $ctext insert end $newid [list link link1]
3447 $ctext insert end "\n "
3448 $ctext insert end [lindex $commitinfo($newid) 0]
3449 $ctext insert end "\n"
3450 $ctext conf -state disabled
3451 $ctext tag delete Comments
3452 $ctext tag remove found 1.0 end
3453 startdiff [list $oldid $newid]
3457 global rowmenuid currentid commitinfo patchtop patchnum
3459 if {![info exists currentid]} return
3460 set oldid $currentid
3461 set oldhead [lindex $commitinfo($oldid) 0]
3462 set newid $rowmenuid
3463 set newhead [lindex $commitinfo($newid) 0]
3466 catch {destroy $top}
3468 label $top.title -text "Generate patch"
3469 grid $top.title - -pady 10
3470 label $top.from -text "From:"
3471 entry $top.fromsha1 -width 40 -relief flat
3472 $top.fromsha1 insert 0 $oldid
3473 $top.fromsha1 conf -state readonly
3474 grid $top.from $top.fromsha1 -sticky w
3475 entry $top.fromhead -width 60 -relief flat
3476 $top.fromhead insert 0 $oldhead
3477 $top.fromhead conf -state readonly
3478 grid x $top.fromhead -sticky w
3479 label $top.to -text "To:"
3480 entry $top.tosha1 -width 40 -relief flat
3481 $top.tosha1 insert 0 $newid
3482 $top.tosha1 conf -state readonly
3483 grid $top.to $top.tosha1 -sticky w
3484 entry $top.tohead -width 60 -relief flat
3485 $top.tohead insert 0 $newhead
3486 $top.tohead conf -state readonly
3487 grid x $top.tohead -sticky w
3488 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3489 grid $top.rev x -pady 10
3490 label $top.flab -text "Output file:"
3491 entry $top.fname -width 60
3492 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3494 grid $top.flab $top.fname -sticky w
3496 button $top.buts.gen -text "Generate" -command mkpatchgo
3497 button $top.buts.can -text "Cancel" -command mkpatchcan
3498 grid $top.buts.gen $top.buts.can
3499 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3500 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3501 grid $top.buts - -pady 10 -sticky ew
3505 proc mkpatchrev {} {
3508 set oldid [$patchtop.fromsha1 get]
3509 set oldhead [$patchtop.fromhead get]
3510 set newid [$patchtop.tosha1 get]
3511 set newhead [$patchtop.tohead get]
3512 foreach e [list fromsha1 fromhead tosha1 tohead] \
3513 v [list $newid $newhead $oldid $oldhead] {
3514 $patchtop.$e conf -state normal
3515 $patchtop.$e delete 0 end
3516 $patchtop.$e insert 0 $v
3517 $patchtop.$e conf -state readonly
3524 set oldid [$patchtop.fromsha1 get]
3525 set newid [$patchtop.tosha1 get]
3526 set fname [$patchtop.fname get]
3527 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3528 error_popup "Error creating patch: $err"
3530 catch {destroy $patchtop}
3534 proc mkpatchcan {} {
3537 catch {destroy $patchtop}
3542 global rowmenuid mktagtop commitinfo
3546 catch {destroy $top}
3548 label $top.title -text "Create tag"
3549 grid $top.title - -pady 10
3550 label $top.id -text "ID:"
3551 entry $top.sha1 -width 40 -relief flat
3552 $top.sha1 insert 0 $rowmenuid
3553 $top.sha1 conf -state readonly
3554 grid $top.id $top.sha1 -sticky w
3555 entry $top.head -width 60 -relief flat
3556 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3557 $top.head conf -state readonly
3558 grid x $top.head -sticky w
3559 label $top.tlab -text "Tag name:"
3560 entry $top.tag -width 60
3561 grid $top.tlab $top.tag -sticky w
3563 button $top.buts.gen -text "Create" -command mktaggo
3564 button $top.buts.can -text "Cancel" -command mktagcan
3565 grid $top.buts.gen $top.buts.can
3566 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3567 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3568 grid $top.buts - -pady 10 -sticky ew
3573 global mktagtop env tagids idtags
3575 set id [$mktagtop.sha1 get]
3576 set tag [$mktagtop.tag get]
3578 error_popup "No tag name specified"
3581 if {[info exists tagids($tag)]} {
3582 error_popup "Tag \"$tag\" already exists"
3587 set fname [file join $dir "refs/tags" $tag]
3588 set f [open $fname w]
3592 error_popup "Error creating tag: $err"
3596 set tagids($tag) $id
3597 lappend idtags($id) $tag
3601 proc redrawtags {id} {
3602 global canv linehtag idline idpos selectedline
3604 if {![info exists idline($id)]} return
3605 $canv delete tag.$id
3606 set xt [eval drawtags $id $idpos($id)]
3607 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3608 if {[info exists selectedline] && $selectedline == $idline($id)} {
3609 selectline $selectedline 0
3616 catch {destroy $mktagtop}
3625 proc writecommit {} {
3626 global rowmenuid wrcomtop commitinfo wrcomcmd
3628 set top .writecommit
3630 catch {destroy $top}
3632 label $top.title -text "Write commit to file"
3633 grid $top.title - -pady 10
3634 label $top.id -text "ID:"
3635 entry $top.sha1 -width 40 -relief flat
3636 $top.sha1 insert 0 $rowmenuid
3637 $top.sha1 conf -state readonly
3638 grid $top.id $top.sha1 -sticky w
3639 entry $top.head -width 60 -relief flat
3640 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3641 $top.head conf -state readonly
3642 grid x $top.head -sticky w
3643 label $top.clab -text "Command:"
3644 entry $top.cmd -width 60 -textvariable wrcomcmd
3645 grid $top.clab $top.cmd -sticky w -pady 10
3646 label $top.flab -text "Output file:"
3647 entry $top.fname -width 60
3648 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3649 grid $top.flab $top.fname -sticky w
3651 button $top.buts.gen -text "Write" -command wrcomgo
3652 button $top.buts.can -text "Cancel" -command wrcomcan
3653 grid $top.buts.gen $top.buts.can
3654 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3655 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3656 grid $top.buts - -pady 10 -sticky ew
3663 set id [$wrcomtop.sha1 get]
3664 set cmd "echo $id | [$wrcomtop.cmd get]"
3665 set fname [$wrcomtop.fname get]
3666 if {[catch {exec sh -c $cmd >$fname &} err]} {
3667 error_popup "Error writing commit: $err"
3669 catch {destroy $wrcomtop}
3676 catch {destroy $wrcomtop}
3680 proc listrefs {id} {
3681 global idtags idheads idotherrefs
3684 if {[info exists idtags($id)]} {
3688 if {[info exists idheads($id)]} {
3692 if {[info exists idotherrefs($id)]} {
3693 set z $idotherrefs($id)
3695 return [list $x $y $z]
3698 proc rereadrefs {} {
3699 global idtags idheads idotherrefs
3700 global tagids headids otherrefids
3702 set refids [concat [array names idtags] \
3703 [array names idheads] [array names idotherrefs]]
3704 foreach id $refids {
3705 if {![info exists ref($id)]} {
3706 set ref($id) [listrefs $id]
3710 set refids [lsort -unique [concat $refids [array names idtags] \
3711 [array names idheads] [array names idotherrefs]]]
3712 foreach id $refids {
3713 set v [listrefs $id]
3714 if {![info exists ref($id)] || $ref($id) != $v} {
3720 proc showtag {tag isnew} {
3721 global ctext cflist tagcontents tagids linknum
3724 addtohistory [list showtag $tag 0]
3726 $ctext conf -state normal
3727 $ctext delete 0.0 end
3729 if {[info exists tagcontents($tag)]} {
3730 set text $tagcontents($tag)
3732 set text "Tag: $tag\nId: $tagids($tag)"
3734 appendwithlinks $text
3735 $ctext conf -state disabled
3736 $cflist delete 0 end
3746 global maxwidth maxgraphpct diffopts findmergefiles
3747 global oldprefs prefstop
3751 if {[winfo exists $top]} {
3755 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3756 set oldprefs($v) [set $v]
3759 wm title $top "Gitk preferences"
3760 label $top.ldisp -text "Commit list display options"
3761 grid $top.ldisp - -sticky w -pady 10
3762 label $top.spacer -text " "
3763 label $top.maxwidthl -text "Maximum graph width (lines)" \
3765 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3766 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3767 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3769 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3770 grid x $top.maxpctl $top.maxpct -sticky w
3771 checkbutton $top.findm -variable findmergefiles
3772 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3774 grid $top.findm $top.findml - -sticky w
3775 label $top.ddisp -text "Diff display options"
3776 grid $top.ddisp - -sticky w -pady 10
3777 label $top.diffoptl -text "Options for diff program" \
3779 entry $top.diffopt -width 20 -textvariable diffopts
3780 grid x $top.diffoptl $top.diffopt -sticky w
3782 button $top.buts.ok -text "OK" -command prefsok
3783 button $top.buts.can -text "Cancel" -command prefscan
3784 grid $top.buts.ok $top.buts.can
3785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787 grid $top.buts - - -pady 10 -sticky ew
3791 global maxwidth maxgraphpct diffopts findmergefiles
3792 global oldprefs prefstop
3794 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3795 set $v $oldprefs($v)
3797 catch {destroy $prefstop}
3802 global maxwidth maxgraphpct
3803 global oldprefs prefstop
3805 catch {destroy $prefstop}
3807 if {$maxwidth != $oldprefs(maxwidth)
3808 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3813 proc formatdate {d} {
3814 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3817 # This list of encoding names and aliases is distilled from
3818 # http://www.iana.org/assignments/character-sets.
3819 # Not all of them are supported by Tcl.
3820 set encoding_aliases {
3821 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3822 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3823 { ISO-10646-UTF-1 csISO10646UTF1 }
3824 { ISO_646.basic:1983 ref csISO646basic1983 }
3825 { INVARIANT csINVARIANT }
3826 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3827 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3828 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3829 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3830 { NATS-DANO iso-ir-9-1 csNATSDANO }
3831 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3832 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3833 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3834 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3835 { ISO-2022-KR csISO2022KR }
3837 { ISO-2022-JP csISO2022JP }
3838 { ISO-2022-JP-2 csISO2022JP2 }
3839 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3841 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3842 { IT iso-ir-15 ISO646-IT csISO15Italian }
3843 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3844 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3845 { greek7-old iso-ir-18 csISO18Greek7Old }
3846 { latin-greek iso-ir-19 csISO19LatinGreek }
3847 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3848 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3849 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3850 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3851 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3852 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3853 { INIS iso-ir-49 csISO49INIS }
3854 { INIS-8 iso-ir-50 csISO50INIS8 }
3855 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3856 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3857 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3858 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3859 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3860 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3862 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3863 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3864 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3865 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3866 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3867 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3868 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3869 { greek7 iso-ir-88 csISO88Greek7 }
3870 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3871 { iso-ir-90 csISO90 }
3872 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3873 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3874 csISO92JISC62991984b }
3875 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3876 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3877 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3878 csISO95JIS62291984handadd }
3879 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3880 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3881 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3882 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3884 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3885 { T.61-7bit iso-ir-102 csISO102T617bit }
3886 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3887 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3888 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3889 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3890 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3891 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3892 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3893 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3894 arabic csISOLatinArabic }
3895 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3896 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3897 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3898 greek greek8 csISOLatinGreek }
3899 { T.101-G2 iso-ir-128 csISO128T101G2 }
3900 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3902 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3903 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3904 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3905 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3906 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3907 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3908 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3909 csISOLatinCyrillic }
3910 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3911 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3912 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3913 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3914 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3915 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3916 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3917 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3918 { ISO_10367-box iso-ir-155 csISO10367Box }
3919 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3920 { latin-lap lap iso-ir-158 csISO158Lap }
3921 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3922 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3925 { JIS_X0201 X0201 csHalfWidthKatakana }
3926 { KSC5636 ISO646-KR csKSC5636 }
3927 { ISO-10646-UCS-2 csUnicode }
3928 { ISO-10646-UCS-4 csUCS4 }
3929 { DEC-MCS dec csDECMCS }
3930 { hp-roman8 roman8 r8 csHPRoman8 }
3931 { macintosh mac csMacintosh }
3932 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3934 { IBM038 EBCDIC-INT cp038 csIBM038 }
3935 { IBM273 CP273 csIBM273 }
3936 { IBM274 EBCDIC-BE CP274 csIBM274 }
3937 { IBM275 EBCDIC-BR cp275 csIBM275 }
3938 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3939 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3940 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3941 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3942 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3943 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3944 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3945 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3946 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3947 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3948 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3949 { IBM437 cp437 437 csPC8CodePage437 }
3950 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3951 { IBM775 cp775 csPC775Baltic }
3952 { IBM850 cp850 850 csPC850Multilingual }
3953 { IBM851 cp851 851 csIBM851 }
3954 { IBM852 cp852 852 csPCp852 }
3955 { IBM855 cp855 855 csIBM855 }
3956 { IBM857 cp857 857 csIBM857 }
3957 { IBM860 cp860 860 csIBM860 }
3958 { IBM861 cp861 861 cp-is csIBM861 }
3959 { IBM862 cp862 862 csPC862LatinHebrew }
3960 { IBM863 cp863 863 csIBM863 }
3961 { IBM864 cp864 csIBM864 }
3962 { IBM865 cp865 865 csIBM865 }
3963 { IBM866 cp866 866 csIBM866 }
3964 { IBM868 CP868 cp-ar csIBM868 }
3965 { IBM869 cp869 869 cp-gr csIBM869 }
3966 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3967 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3968 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3969 { IBM891 cp891 csIBM891 }
3970 { IBM903 cp903 csIBM903 }
3971 { IBM904 cp904 904 csIBBM904 }
3972 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3973 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3974 { IBM1026 CP1026 csIBM1026 }
3975 { EBCDIC-AT-DE csIBMEBCDICATDE }
3976 { EBCDIC-AT-DE-A csEBCDICATDEA }
3977 { EBCDIC-CA-FR csEBCDICCAFR }
3978 { EBCDIC-DK-NO csEBCDICDKNO }
3979 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3980 { EBCDIC-FI-SE csEBCDICFISE }
3981 { EBCDIC-FI-SE-A csEBCDICFISEA }
3982 { EBCDIC-FR csEBCDICFR }
3983 { EBCDIC-IT csEBCDICIT }
3984 { EBCDIC-PT csEBCDICPT }
3985 { EBCDIC-ES csEBCDICES }
3986 { EBCDIC-ES-A csEBCDICESA }
3987 { EBCDIC-ES-S csEBCDICESS }
3988 { EBCDIC-UK csEBCDICUK }
3989 { EBCDIC-US csEBCDICUS }
3990 { UNKNOWN-8BIT csUnknown8BiT }
3991 { MNEMONIC csMnemonic }
3996 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3997 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3998 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3999 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4000 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4001 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4002 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4003 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4004 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4005 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4006 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4007 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4008 { IBM1047 IBM-1047 }
4009 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4010 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4011 { UNICODE-1-1 csUnicode11 }
4014 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4015 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4017 { ISO-8859-15 ISO_8859-15 Latin-9 }
4018 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4019 { GBK CP936 MS936 windows-936 }
4020 { JIS_Encoding csJISEncoding }
4021 { Shift_JIS MS_Kanji csShiftJIS }
4022 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4024 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4025 { ISO-10646-UCS-Basic csUnicodeASCII }
4026 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4027 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4028 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4029 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4030 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4031 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4032 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4033 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4034 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4035 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4036 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4037 { Ventura-US csVenturaUS }
4038 { Ventura-International csVenturaInternational }
4039 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4040 { PC8-Turkish csPC8Turkish }
4041 { IBM-Symbols csIBMSymbols }
4042 { IBM-Thai csIBMThai }
4043 { HP-Legal csHPLegal }
4044 { HP-Pi-font csHPPiFont }
4045 { HP-Math8 csHPMath8 }
4046 { Adobe-Symbol-Encoding csHPPSMath }
4047 { HP-DeskTop csHPDesktop }
4048 { Ventura-Math csVenturaMath }
4049 { Microsoft-Publishing csMicrosoftPublishing }
4050 { Windows-31J csWindows31J }
4055 proc tcl_encoding {enc} {
4056 global encoding_aliases
4057 set names [encoding names]
4058 set lcnames [string tolower $names]
4059 set enc [string tolower $enc]
4060 set i [lsearch -exact $lcnames $enc]
4062 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4063 if {[regsub {^iso[-_]} $enc iso encx]} {
4064 set i [lsearch -exact $lcnames $encx]
4068 foreach l $encoding_aliases {
4069 set ll [string tolower $l]
4070 if {[lsearch -exact $ll $enc] < 0} continue
4071 # look through the aliases for one that tcl knows about
4073 set i [lsearch -exact $lcnames $e]
4075 if {[regsub {^iso[-_]} $e iso ex]} {
4076 set i [lsearch -exact $lcnames $ex]
4085 return [lindex $names $i]
4092 set diffopts "-U 5 -p"
4093 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4097 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4099 if {$gitencoding == ""} {
4100 set gitencoding "utf-8"
4102 set tclencoding [tcl_encoding $gitencoding]
4103 if {$tclencoding == {}} {
4104 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4107 set mainfont {Helvetica 9}
4108 set textfont {Courier 9}
4109 set findmergefiles 0
4115 set colors {green red blue magenta darkgrey brown orange}
4117 catch {source ~/.gitk}
4119 set namefont $mainfont
4121 font create optionfont -family sans-serif -size -12
4125 switch -regexp -- $arg {
4127 "^-d" { set datemode 1 }
4128 "^-r" { set revlistorder 1 }
4130 lappend revtreeargs $arg
4143 makewindow $revtreeargs
4145 getcommits $revtreeargs