2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc parse_args
{rargs
} {
23 set parse_args
[concat
--default HEAD
$rargs]
24 set parsed_args
[split [eval exec git-rev-parse
$parse_args] "\n"]
26 # if git-rev-parse failed for some reason...
30 set parsed_args
$rargs
35 proc start_rev_list
{rlargs
} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
39 set startmsecs
[clock clicks
-milliseconds]
40 set nextupdate
[expr {$startmsecs + 100}]
43 set order
"--topo-order"
45 set order
"--date-order"
48 set commfd
[open
[concat | git-rev-list
--header $order \
49 --parents --boundary $rlargs] r
]
51 puts stderr
"Error executing git-rev-list: $err"
55 fconfigure
$commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure
$commfd -encoding $tclencoding
59 fileevent
$commfd readable
[list getcommitlines
$commfd]
60 . config
-cursor watch
64 proc getcommits
{rargs
} {
65 global phase canv mainfont
68 start_rev_list
[parse_args
$rargs]
70 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
71 -font $mainfont -tags textitems
74 proc getcommitlines
{commfd
} {
75 global commitlisted nextupdate
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
80 set stuff
[read $commfd]
82 if {![eof
$commfd]} return
83 # set it blocking so we wait for the process to terminate
84 fconfigure
$commfd -blocking 1
85 if {![catch
{close
$commfd} err
]} {
86 after idle finishcommits
89 if {[string range
$err 0 4] == "usage"} {
91 "Gitk: error reading commits: bad arguments to git-rev-list.\
92 (Note: arguments to gitk are passed to git-rev-list\
93 to allow selection of commits to be displayed.)"
95 set err
"Error reading commits: $err"
103 set i
[string first
"\0" $stuff $start]
105 append leftover
[string range
$stuff $start end
]
110 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
113 set cmit
[string range
$stuff $start [expr {$i - 1}]]
115 set start
[expr {$i + 1}]
116 set j
[string first
"\n" $cmit]
120 set ids
[string range
$cmit 0 [expr {$j - 1}]]
121 if {[string range
$ids 0 0] == "-"} {
123 set ids
[string range
$ids 1 end
]
127 if {[string length
$id] != 40} {
135 if {[string length
$shortcmit] > 80} {
136 set shortcmit
"[string range $shortcmit 0 80]..."
138 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
141 set id
[lindex
$ids 0]
143 set olds
[lrange
$ids 1 end
]
144 if {[llength
$olds] > 1} {
145 set olds
[lsort
-unique $olds]
148 lappend children
($p) $id
153 lappend parentlist
$olds
154 if {[info exists children
($id)]} {
155 lappend childlist
$children($id)
159 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
160 set commitrow
($id) $commitidx
162 lappend displayorder
$id
163 lappend commitlisted
$listed
169 if {[clock clicks
-milliseconds] >= $nextupdate} {
174 proc doupdate
{reading
} {
175 global commfd nextupdate numcommits ncmupdate
178 fileevent
$commfd readable
{}
181 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
182 if {$numcommits < 100} {
183 set ncmupdate
[expr {$numcommits + 1}]
184 } elseif
{$numcommits < 10000} {
185 set ncmupdate
[expr {$numcommits + 10}]
187 set ncmupdate
[expr {$numcommits + 100}]
190 fileevent
$commfd readable
[list getcommitlines
$commfd]
194 proc readcommit
{id
} {
195 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
196 parsecommit
$id $contents 0
199 proc updatecommits
{rargs
} {
201 foreach v
{colormap selectedline matchinglines treediffs
202 mergefilelist currentid rowtextx commitrow
203 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
204 linesegends crossings cornercrossings
} {
213 proc parsecommit
{id contents listed
} {
214 global commitinfo cdate
223 set hdrend
[string first
"\n\n" $contents]
225 # should never happen...
226 set hdrend
[string length
$contents]
228 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
229 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
230 foreach line
[split $header "\n"] {
231 set tag
[lindex
$line 0]
232 if {$tag == "author"} {
233 set audate
[lindex
$line end-1
]
234 set auname
[lrange
$line 1 end-2
]
235 } elseif
{$tag == "committer"} {
236 set comdate
[lindex
$line end-1
]
237 set comname
[lrange
$line 1 end-2
]
241 # take the first line of the comment as the headline
242 set i
[string first
"\n" $comment]
244 set headline
[string trim
[string range
$comment 0 $i]]
246 set headline
$comment
249 # git-rev-list indents the comment by 4 spaces;
250 # if we got this via git-cat-file, add the indentation
252 foreach line
[split $comment "\n"] {
253 append newcomment
" "
254 append newcomment
$line
255 append newcomment
"\n"
257 set comment
$newcomment
259 if {$comdate != {}} {
260 set cdate
($id) $comdate
262 set commitinfo
($id) [list
$headline $auname $audate \
263 $comname $comdate $comment]
266 proc getcommit
{id
} {
267 global commitdata commitinfo
269 if {[info exists commitdata
($id)]} {
270 parsecommit
$id $commitdata($id) 1
273 if {![info exists commitinfo
($id)]} {
274 set commitinfo
($id) {"No commit information available"}
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
284 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
287 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
288 while {0 <= [set n
[gets
$refd line
]]} {
289 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
293 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
297 if {$type == "tags"} {
298 set tagids
($name) $id
299 lappend idtags
($id) $name
304 set commit
[exec git-rev-parse
"$id^0"]
305 if {"$commit" != "$id"} {
306 set tagids
($name) $commit
307 lappend idtags
($commit) $name
311 set tagcontents
($name) [exec git-cat-file tag
"$id"]
313 } elseif
{ $type == "heads" } {
314 set headids
($name) $id
315 lappend idheads
($id) $name
317 set otherrefids
($name) $id
318 lappend idotherrefs
($id) $name
324 proc error_popup msg
{
328 message
$w.m
-text $msg -justify center
-aspect 400
329 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
330 button
$w.ok
-text OK
-command "destroy $w"
331 pack
$w.ok
-side bottom
-fill x
332 bind $w <Visibility
> "grab $w; focus $w"
333 bind $w <Key-Return
> "destroy $w"
337 proc makewindow
{rargs
} {
338 global canv canv2 canv3 linespc charspc ctext cflist textfont
339 global findtype findtypemenu findloc findstring fstring geometry
340 global entries sha1entry sha1string sha1but
341 global maincursor textcursor curtextcursor
342 global rowctxmenu mergemax
345 .bar add cascade
-label "File" -menu .bar.
file
347 .bar.
file add
command -label "Update" -command [list updatecommits
$rargs]
348 .bar.
file add
command -label "Reread references" -command rereadrefs
349 .bar.
file add
command -label "Quit" -command doquit
351 .bar add cascade
-label "Edit" -menu .bar.edit
352 .bar.edit add
command -label "Preferences" -command doprefs
354 .bar add cascade
-label "Help" -menu .bar.
help
355 .bar.
help add
command -label "About gitk" -command about
356 .bar.
help add
command -label "Key bindings" -command keys
357 . configure
-menu .bar
359 if {![info exists geometry
(canv1
)]} {
360 set geometry
(canv1
) [expr {45 * $charspc}]
361 set geometry
(canv2
) [expr {30 * $charspc}]
362 set geometry
(canv3
) [expr {15 * $charspc}]
363 set geometry
(canvh
) [expr {25 * $linespc + 4}]
364 set geometry
(ctextw
) 80
365 set geometry
(ctexth
) 30
366 set geometry
(cflistw
) 30
368 panedwindow .ctop
-orient vertical
369 if {[info exists geometry
(width
)]} {
370 .ctop conf
-width $geometry(width
) -height $geometry(height
)
371 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
372 set geometry
(ctexth
) [expr {($texth - 8) /
373 [font metrics
$textfont -linespace]}]
377 pack .ctop.top.bar
-side bottom
-fill x
378 set cscroll .ctop.top.csb
379 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
380 pack
$cscroll -side right
-fill y
381 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
382 pack .ctop.top.clist
-side top
-fill both
-expand 1
384 set canv .ctop.top.clist.canv
385 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
387 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
388 .ctop.top.clist add
$canv
389 set canv2 .ctop.top.clist.canv2
390 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
391 -bg white
-bd 0 -yscrollincr $linespc
392 .ctop.top.clist add
$canv2
393 set canv3 .ctop.top.clist.canv3
394 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
395 -bg white
-bd 0 -yscrollincr $linespc
396 .ctop.top.clist add
$canv3
397 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
399 set sha1entry .ctop.top.bar.sha1
400 set entries
$sha1entry
401 set sha1but .ctop.top.bar.sha1label
402 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
403 -command gotocommit
-width 8
404 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
405 pack .ctop.top.bar.sha1label
-side left
406 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
407 trace add variable sha1string
write sha1change
408 pack
$sha1entry -side left
-pady 2
410 image create bitmap bm-left
-data {
411 #define left_width 16
412 #define left_height 16
413 static unsigned char left_bits
[] = {
414 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
415 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
416 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
418 image create bitmap bm-right
-data {
419 #define right_width 16
420 #define right_height 16
421 static unsigned char right_bits
[] = {
422 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
423 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
424 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
426 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
427 -state disabled
-width 26
428 pack .ctop.top.bar.leftbut
-side left
-fill y
429 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
430 -state disabled
-width 26
431 pack .ctop.top.bar.rightbut
-side left
-fill y
433 button .ctop.top.bar.findbut
-text "Find" -command dofind
434 pack .ctop.top.bar.findbut
-side left
436 set fstring .ctop.top.bar.findstring
437 lappend entries
$fstring
438 entry
$fstring -width 30 -font $textfont -textvariable findstring
439 pack
$fstring -side left
-expand 1 -fill x
441 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
442 findtype Exact IgnCase Regexp
]
443 set findloc
"All fields"
444 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
445 Comments Author Committer Files Pickaxe
446 pack .ctop.top.bar.findloc
-side right
447 pack .ctop.top.bar.findtype
-side right
448 # for making sure type==Exact whenever loc==Pickaxe
449 trace add variable findloc
write findlocchange
451 panedwindow .ctop.cdet
-orient horizontal
453 frame .ctop.cdet.left
454 set ctext .ctop.cdet.left.ctext
455 text
$ctext -bg white
-state disabled
-font $textfont \
456 -width $geometry(ctextw
) -height $geometry(ctexth
) \
457 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
458 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
459 pack .ctop.cdet.left.sb
-side right
-fill y
460 pack
$ctext -side left
-fill both
-expand 1
461 .ctop.cdet add .ctop.cdet.left
463 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
464 $ctext tag conf hunksep
-fore blue
465 $ctext tag conf d0
-fore red
466 $ctext tag conf d1
-fore "#00a000"
467 $ctext tag conf m0
-fore red
468 $ctext tag conf m1
-fore blue
469 $ctext tag conf m2
-fore green
470 $ctext tag conf m3
-fore purple
471 $ctext tag conf
m4 -fore brown
472 $ctext tag conf m5
-fore "#009090"
473 $ctext tag conf m6
-fore magenta
474 $ctext tag conf m7
-fore "#808000"
475 $ctext tag conf m8
-fore "#009000"
476 $ctext tag conf m9
-fore "#ff0080"
477 $ctext tag conf m10
-fore cyan
478 $ctext tag conf m11
-fore "#b07070"
479 $ctext tag conf m12
-fore "#70b0f0"
480 $ctext tag conf m13
-fore "#70f0b0"
481 $ctext tag conf m14
-fore "#f0b070"
482 $ctext tag conf m15
-fore "#ff70b0"
483 $ctext tag conf mmax
-fore darkgrey
485 $ctext tag conf mresult
-font [concat
$textfont bold
]
486 $ctext tag conf msep
-font [concat
$textfont bold
]
487 $ctext tag conf found
-back yellow
489 frame .ctop.cdet.right
490 set cflist .ctop.cdet.right.cfiles
491 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
492 -yscrollcommand ".ctop.cdet.right.sb set"
493 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
494 pack .ctop.cdet.right.sb
-side right
-fill y
495 pack
$cflist -side left
-fill both
-expand 1
496 .ctop.cdet add .ctop.cdet.right
497 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
499 pack .ctop
-side top
-fill both
-expand 1
501 bindall
<1> {selcanvline
%W
%x
%y
}
502 #bindall <B1-Motion> {selcanvline %W %x %y}
503 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
504 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
505 bindall
<2> "canvscan mark %W %x %y"
506 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
507 bindkey
<Home
> selfirstline
508 bindkey
<End
> sellastline
509 bind .
<Key-Up
> "selnextline -1"
510 bind .
<Key-Down
> "selnextline 1"
511 bindkey
<Key-Right
> "goforw"
512 bindkey
<Key-Left
> "goback"
513 bind .
<Key-Prior
> "selnextpage -1"
514 bind .
<Key-Next
> "selnextpage 1"
515 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
516 bind .
<Control-End
> "allcanvs yview moveto 1.0"
517 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
518 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
519 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
520 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
521 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
522 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
523 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
524 bindkey p
"selnextline -1"
525 bindkey n
"selnextline 1"
528 bindkey i
"selnextline -1"
529 bindkey k
"selnextline 1"
532 bindkey b
"$ctext yview scroll -1 pages"
533 bindkey d
"$ctext yview scroll 18 units"
534 bindkey u
"$ctext yview scroll -18 units"
535 bindkey
/ {findnext
1}
536 bindkey
<Key-Return
> {findnext
0}
539 bind .
<Control-q
> doquit
540 bind .
<Control-f
> dofind
541 bind .
<Control-g
> {findnext
0}
542 bind .
<Control-r
> findprev
543 bind .
<Control-equal
> {incrfont
1}
544 bind .
<Control-KP_Add
> {incrfont
1}
545 bind .
<Control-minus
> {incrfont
-1}
546 bind .
<Control-KP_Subtract
> {incrfont
-1}
547 bind $cflist <<ListboxSelect>> listboxsel
548 bind . <Destroy> {savestuff %W}
549 bind . <Button-1> "click %W"
550 bind $fstring <Key-Return> dofind
551 bind $sha1entry <Key-Return> gotocommit
552 bind $sha1entry <<PasteSelection>> clearsha1
554 set maincursor [. cget -cursor]
555 set textcursor [$ctext cget -cursor]
556 set curtextcursor $textcursor
558 set rowctxmenu .rowctxmenu
559 menu $rowctxmenu -tearoff 0
560 $rowctxmenu add command -label "Diff this -> selected" \
561 -command {diffvssel 0}
562 $rowctxmenu add command -label "Diff selected -> this" \
563 -command {diffvssel 1}
564 $rowctxmenu add command -label "Make patch" -command mkpatch
565 $rowctxmenu add command -label "Create tag" -command mktag
566 $rowctxmenu add command -label "Write commit to file" -command writecommit
569 # mouse-2 makes all windows scan vertically, but only the one
570 # the cursor is in scans horizontally
571 proc canvscan {op w x y} {
572 global canv canv2 canv3
573 foreach c [list $canv $canv2 $canv3] {
582 proc scrollcanv {cscroll f0 f1} {
587 # when we make a key binding for the toplevel, make sure
588 # it doesn't get triggered when that key is pressed in the
589 # find string entry widget.
590 proc bindkey {ev script} {
593 set escript [bind Entry $ev]
594 if {$escript == {}} {
595 set escript [bind Entry <Key>]
598 bind $e $ev "$escript; break"
602 # set the focus back to the toplevel for any click outside
613 global canv canv2 canv3 ctext cflist mainfont textfont
614 global stuffsaved findmergefiles maxgraphpct
617 if {$stuffsaved} return
618 if {![winfo viewable .]} return
620 set f [open "~/.gitk-new" w]
621 puts $f [list set mainfont $mainfont]
622 puts $f [list set textfont $textfont]
623 puts $f [list set findmergefiles $findmergefiles]
624 puts $f [list set maxgraphpct $maxgraphpct]
625 puts $f [list set maxwidth $maxwidth]
626 puts $f "set geometry(width) [winfo width .ctop]"
627 puts $f "set geometry(height) [winfo height .ctop]"
628 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
629 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
630 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
631 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
632 set wid [expr {([winfo width $ctext] - 8) \
633 / [font measure $textfont "0"]}]
634 puts $f "set geometry(ctextw) $wid"
635 set wid [expr {([winfo width $cflist] - 11) \
636 / [font measure [$cflist cget -font] "0"]}]
637 puts $f "set geometry(cflistw) $wid"
639 file rename -force "~/.gitk-new" "~/.gitk"
644 proc resizeclistpanes {win w} {
646 if {[info exists oldwidth($win)]} {
647 set s0 [$win sash coord 0]
648 set s1 [$win sash coord 1]
650 set sash0 [expr {int($w/2 - 2)}]
651 set sash1 [expr {int($w*5/6 - 2)}]
653 set factor [expr {1.0 * $w / $oldwidth($win)}]
654 set sash0 [expr {int($factor * [lindex $s0 0])}]
655 set sash1 [expr {int($factor * [lindex $s1 0])}]
659 if {$sash1 < $sash0 + 20} {
660 set sash1 [expr {$sash0 + 20}]
662 if {$sash1 > $w - 10} {
663 set sash1 [expr {$w - 10}]
664 if {$sash0 > $sash1 - 20} {
665 set sash0 [expr {$sash1 - 20}]
669 $win sash place 0 $sash0 [lindex $s0 1]
670 $win sash place 1 $sash1 [lindex $s1 1]
672 set oldwidth($win) $w
675 proc resizecdetpanes {win w} {
677 if {[info exists oldwidth($win)]} {
678 set s0 [$win sash coord 0]
680 set sash0 [expr {int($w*3/4 - 2)}]
682 set factor [expr {1.0 * $w / $oldwidth($win)}]
683 set sash0 [expr {int($factor * [lindex $s0 0])}]
687 if {$sash0 > $w - 15} {
688 set sash0 [expr {$w - 15}]
691 $win sash place 0 $sash0 [lindex $s0 1]
693 set oldwidth($win) $w
697 global canv canv2 canv3
703 proc bindall {event action} {
704 global canv canv2 canv3
705 bind $canv $event $action
706 bind $canv2 $event $action
707 bind $canv3 $event $action
712 if {[winfo exists $w]} {
717 wm title $w "About gitk"
719 Gitk - a commit viewer for git
721 Copyright © 2005-2006 Paul Mackerras
723 Use and redistribute under the terms of the GNU General Public License} \
724 -justify center -aspect 400
725 pack $w.m -side top -fill x -padx 20 -pady 20
726 button $w.ok -text Close -command "destroy $w"
727 pack $w.ok -side bottom
732 if {[winfo exists $w]} {
737 wm title $w "Gitk key bindings"
742 <Home> Move to first commit
743 <End> Move to last commit
744 <Up>, p, i Move up one commit
745 <Down>, n, k Move down one commit
746 <Left>, z, j Go back in history list
747 <Right>, x, l Go forward in history list
748 <PageUp> Move up one page in commit list
749 <PageDown> Move down one page in commit list
750 <Ctrl-Home> Scroll to top of commit list
751 <Ctrl-End> Scroll to bottom of commit list
752 <Ctrl-Up> Scroll commit list up one line
753 <Ctrl-Down> Scroll commit list down one line
754 <Ctrl-PageUp> Scroll commit list up one page
755 <Ctrl-PageDown> Scroll commit list down one page
756 <Delete>, b Scroll diff view up one page
757 <Backspace> Scroll diff view up one page
758 <Space> Scroll diff view down one page
759 u Scroll diff view up 18 lines
760 d Scroll diff view down 18 lines
762 <Ctrl-G> Move to next find hit
763 <Ctrl-R> Move to previous find hit
764 <Return> Move to next find hit
765 / Move to next find hit, or redo find
766 ? Move to previous find hit
767 f Scroll diff view to next file
768 <Ctrl-KP+> Increase font size
769 <Ctrl-plus> Increase font size
770 <Ctrl-KP-> Decrease font size
771 <Ctrl-minus> Decrease font size
773 -justify left -bg white -border 2 -relief sunken
774 pack $w.m -side top -fill both
775 button $w.ok -text Close -command "destroy $w"
776 pack $w.ok -side bottom
779 proc shortids {ids} {
782 if {[llength $id] > 1} {
783 lappend res [shortids $id]
784 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
785 lappend res [string range $id 0 7]
793 proc incrange {l x o} {
798 lset l $x [expr {$e + $o}]
807 for {} {$n > 0} {incr n -1} {
813 proc usedinrange {id l1 l2} {
814 global children commitrow
816 if {[info exists commitrow($id)]} {
817 set r $commitrow($id)
818 if {$l1 <= $r && $r <= $l2} {
819 return [expr {$r - $l1 + 1}]
822 foreach c $children($id) {
823 if {[info exists commitrow($c)]} {
825 if {$l1 <= $r && $r <= $l2} {
826 return [expr {$r - $l1 + 1}]
833 proc sanity {row {full 0}} {
834 global rowidlist rowoffsets
837 set ids [lindex $rowidlist $row]
840 if {$id eq {}} continue
841 if {$col < [llength $ids] - 1 &&
842 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
843 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
845 set o [lindex $rowoffsets $row $col]
851 if {[lindex $rowidlist $y $x] != $id} {
852 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
853 puts " id=[shortids $id] check started at row $row"
854 for {set i $row} {$i >= $y} {incr i -1} {
855 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
860 set o [lindex $rowoffsets $y $x]
865 proc makeuparrow {oid x y z} {
866 global rowidlist rowoffsets uparrowlen idrowranges
868 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
871 set off0 [lindex $rowoffsets $y]
872 for {set x0 $x} {1} {incr x0} {
873 if {$x0 >= [llength $off0]} {
874 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
877 set z [lindex $off0 $x0]
883 set z [expr {$x0 - $x}]
884 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
885 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
887 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
888 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
889 lappend idrowranges($oid) $y
893 global rowidlist rowoffsets displayorder commitlisted
894 global rowlaidout rowoptim
895 global idinlist rowchk
896 global commitidx numcommits canvxmax canv
898 global parentlist childlist children
906 catch {unset children}
910 catch {unset idinlist}
914 set canvxmax [$canv cget -width]
917 proc setcanvscroll {} {
918 global canv canv2 canv3 numcommits linespc canvxmax canvy0
920 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
921 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
922 $canv2 conf -scrollregion [list 0 0 0 $ymax]
923 $canv3 conf -scrollregion [list 0 0 0 $ymax]
926 proc visiblerows {} {
927 global canv numcommits linespc
929 set ymax [lindex [$canv cget -scrollregion] 3]
930 if {$ymax eq {} || $ymax == 0} return
932 set y0 [expr {int([lindex $f 0] * $ymax)}]
933 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
937 set y1 [expr {int([lindex $f 1] * $ymax)}]
938 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
939 if {$r1 >= $numcommits} {
940 set r1 [expr {$numcommits - 1}]
942 return [list $r0 $r1]
946 global rowlaidout rowoptim commitidx numcommits optim_delay
950 set rowlaidout [layoutrows $row $commitidx 0]
951 set orow [expr {$rowlaidout - $uparrowlen - 1}]
952 if {$orow > $rowoptim} {
953 checkcrossings $rowoptim $orow
954 optimize_rows $rowoptim 0 $orow
957 set canshow [expr {$rowoptim - $optim_delay}]
958 if {$canshow > $numcommits} {
963 proc showstuff {canshow} {
965 global linesegends idrowranges idrangedrawn
967 if {$numcommits == 0} {
973 set numcommits $canshow
975 set rows [visiblerows]
976 set r0 [lindex $rows 0]
977 set r1 [lindex $rows 1]
978 for {set r $row} {$r < $canshow} {incr r} {
979 if {[info exists linesegends($r)]} {
980 foreach id $linesegends($r) {
982 foreach {s e} $idrowranges($id) {
984 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
985 && ![info exists idrangedrawn($id,$i)]} {
987 set idrangedrawn($id,$i) 1
993 if {$canshow > $r1} {
996 while {$row < $canshow} {
1002 proc layoutrows {row endrow last} {
1003 global rowidlist rowoffsets displayorder
1004 global uparrowlen downarrowlen maxwidth mingaplen
1005 global childlist parentlist
1006 global idrowranges linesegends
1008 global idinlist rowchk
1010 set idlist [lindex $rowidlist $row]
1011 set offs [lindex $rowoffsets $row]
1012 while {$row < $endrow} {
1013 set id [lindex $displayorder $row]
1016 foreach p [lindex $parentlist $row] {
1017 if {![info exists idinlist($p)]} {
1019 } elseif {!$idinlist($p)} {
1023 set nev [expr {[llength $idlist] + [llength $newolds]
1024 + [llength $oldolds] - $maxwidth + 1}]
1026 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1027 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1028 set i [lindex $idlist $x]
1029 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1030 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1031 [expr {$row + $uparrowlen + $mingaplen}]]
1033 set idlist [lreplace $idlist $x $x]
1034 set offs [lreplace $offs $x $x]
1035 set offs [incrange $offs $x 1]
1037 set rm1 [expr {$row - 1}]
1038 lappend linesegends($rm1) $i
1039 lappend idrowranges($i) $rm1
1040 if {[incr nev -1] <= 0} break
1043 set rowchk($id) [expr {$row + $r}]
1046 lset rowidlist $row $idlist
1047 lset rowoffsets $row $offs
1049 set col [lsearch -exact $idlist $id]
1051 set col [llength $idlist]
1053 lset rowidlist $row $idlist
1055 if {[lindex $childlist $row] ne {}} {
1056 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1060 lset rowoffsets $row $offs
1062 makeuparrow $id $col $row $z
1067 if {[info exists idrowranges($id)]} {
1068 lappend idrowranges($id) $row
1071 set offs [ntimes [llength $idlist] 0]
1072 set l [llength $newolds]
1073 set idlist [eval lreplace \$idlist $col $col $newolds]
1076 set offs [lrange $offs 0 [expr {$col - 1}]]
1077 foreach x $newolds {
1082 set tmp [expr {[llength $idlist] - [llength $offs]}]
1084 set offs [concat $offs [ntimes $tmp $o]]
1089 foreach i $newolds {
1091 set idrowranges($i) $row
1094 foreach oid $oldolds {
1095 set idinlist($oid) 1
1096 set idlist [linsert $idlist $col $oid]
1097 set offs [linsert $offs $col $o]
1098 makeuparrow $oid $col $row $o
1101 lappend rowidlist $idlist
1102 lappend rowoffsets $offs
1107 proc addextraid {id row} {
1108 global displayorder commitrow commitinfo
1110 global parentlist childlist children
1113 lappend displayorder $id
1114 lappend parentlist {}
1115 set commitrow($id) $row
1117 if {![info exists commitinfo($id)]} {
1118 set commitinfo($id) {"No commit information available"}
1120 if {[info exists children($id)]} {
1121 lappend childlist $children($id)
1123 lappend childlist {}
1127 proc layouttail {} {
1128 global rowidlist rowoffsets idinlist commitidx
1132 set idlist [lindex $rowidlist $row]
1133 while {$idlist ne {}} {
1134 set col [expr {[llength $idlist] - 1}]
1135 set id [lindex $idlist $col]
1138 lappend idrowranges($id) $row
1140 set offs [ntimes $col 0]
1141 set idlist [lreplace $idlist $col $col]
1142 lappend rowidlist $idlist
1143 lappend rowoffsets $offs
1146 foreach id [array names idinlist] {
1148 lset rowidlist $row [list $id]
1149 lset rowoffsets $row 0
1150 makeuparrow $id 0 $row 0
1151 lappend idrowranges($id) $row
1153 lappend rowidlist {}
1154 lappend rowoffsets {}
1158 proc insert_pad {row col npad} {
1159 global rowidlist rowoffsets
1161 set pad [ntimes $npad {}]
1162 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1163 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1164 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1167 proc optimize_rows {row col endrow} {
1168 global rowidlist rowoffsets idrowranges linesegends displayorder
1170 for {} {$row < $endrow} {incr row} {
1171 set idlist [lindex $rowidlist $row]
1172 set offs [lindex $rowoffsets $row]
1174 for {} {$col < [llength $offs]} {incr col} {
1175 if {[lindex $idlist $col] eq {}} {
1179 set z [lindex $offs $col]
1180 if {$z eq {}} continue
1182 set x0 [expr {$col + $z}]
1183 set y0 [expr {$row - 1}]
1184 set z0 [lindex $rowoffsets $y0 $x0]
1186 set id [lindex $idlist $col]
1187 if {[info exists idrowranges($id)] &&
1188 $y0 > [lindex $idrowranges($id) 0]} {
1192 if {$z < -1 || ($z < 0 && $isarrow)} {
1193 set npad [expr {-1 - $z + $isarrow}]
1194 set offs [incrange $offs $col $npad]
1195 insert_pad $y0 $x0 $npad
1197 optimize_rows $y0 $x0 $row
1199 set z [lindex $offs $col]
1200 set x0 [expr {$col + $z}]
1201 set z0 [lindex $rowoffsets $y0 $x0]
1202 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1203 set npad [expr {$z - 1 + $isarrow}]
1204 set y1 [expr {$row + 1}]
1205 set offs2 [lindex $rowoffsets $y1]
1209 if {$z eq {} || $x1 + $z < $col} continue
1210 if {$x1 + $z > $col} {
1213 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1216 set pad [ntimes $npad {}]
1217 set idlist [eval linsert \$idlist $col $pad]
1218 set tmp [eval linsert \$offs $col $pad]
1220 set offs [incrange $tmp $col [expr {-$npad}]]
1221 set z [lindex $offs $col]
1224 if {$z0 eq {} && !$isarrow} {
1225 # this line links to its first child on row $row-2
1226 set rm2 [expr {$row - 2}]
1227 set id [lindex $displayorder $rm2]
1228 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1230 set z0 [expr {$xc - $x0}]
1233 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1234 insert_pad $y0 $x0 1
1235 set offs [incrange $offs $col 1]
1236 optimize_rows $y0 [expr {$x0 + 1}] $row
1241 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1242 set o [lindex $offs $col]
1244 # check if this is the link to the first child
1245 set id [lindex $idlist $col]
1246 if {[info exists idrowranges($id)] &&
1247 $row == [lindex $idrowranges($id) 0]} {
1248 # it is, work out offset to child
1249 set y0 [expr {$row - 1}]
1250 set id [lindex $displayorder $y0]
1251 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1253 set o [expr {$x0 - $col}]
1257 if {$o eq {} || $o <= 0} break
1259 if {$o ne {} && [incr col] < [llength $idlist]} {
1260 set y1 [expr {$row + 1}]
1261 set offs2 [lindex $rowoffsets $y1]
1265 if {$z eq {} || $x1 + $z < $col} continue
1266 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1269 set idlist [linsert $idlist $col {}]
1270 set tmp [linsert $offs $col {}]
1272 set offs [incrange $tmp $col -1]
1275 lset rowidlist $row $idlist
1276 lset rowoffsets $row $offs
1282 global canvx0 linespc
1283 return [expr {$canvx0 + $col * $linespc}]
1287 global canvy0 linespc
1288 return [expr {$canvy0 + $row * $linespc}]
1291 proc linewidth {id} {
1292 global thickerline lthickness
1295 if {[info exists thickerline] && $id eq $thickerline} {
1296 set wid [expr {2 * $lthickness}]
1301 proc drawlineseg {id i} {
1302 global rowoffsets rowidlist idrowranges
1304 global canv colormap linespc
1306 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1307 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1308 if {$startrow == $row} return
1311 set col [lsearch -exact [lindex $rowidlist $row] $id]
1313 puts "oops: drawline: id $id not on row $row"
1319 set o [lindex $rowoffsets $row $col]
1322 # changing direction
1323 set x [xc $row $col]
1325 lappend coords $x $y
1331 set x [xc $row $col]
1333 lappend coords $x $y
1335 # draw the link to the first child as part of this line
1337 set child [lindex $displayorder $row]
1338 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1340 set x [xc $row $ccol]
1342 if {$ccol < $col - 1} {
1343 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1344 } elseif {$ccol > $col + 1} {
1345 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1347 lappend coords $x $y
1350 if {[llength $coords] < 4} return
1351 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1353 # This line has an arrow at the lower end: check if the arrow is
1354 # on a diagonal segment, and if so, work around the Tk 8.4
1355 # refusal to draw arrows on diagonal lines.
1356 set x0 [lindex $coords 0]
1357 set x1 [lindex $coords 2]
1359 set y0 [lindex $coords 1]
1360 set y1 [lindex $coords 3]
1361 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1362 # we have a nearby vertical segment, just trim off the diag bit
1363 set coords [lrange $coords 2 end]
1365 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1366 set xi [expr {$x0 - $slope * $linespc / 2}]
1367 set yi [expr {$y0 - $linespc / 2}]
1368 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1372 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1373 set arrow [lindex {none first last both} $arrow]
1374 set t [$canv create line $coords -width [linewidth $id] \
1375 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1380 proc drawparentlinks {id row col olds} {
1381 global rowidlist canv colormap idrowranges
1383 set row2 [expr {$row + 1}]
1384 set x [xc $row $col]
1387 set ids [lindex $rowidlist $row2]
1388 # rmx = right-most X coord used
1391 set i [lsearch -exact $ids $p]
1393 puts "oops, parent $p of $id not in list"
1396 set x2 [xc $row2 $i]
1400 if {[info exists idrowranges($p)] &&
1401 $row2 == [lindex $idrowranges($p) 0] &&
1402 $row2 < [lindex $idrowranges($p) 1]} {
1403 # drawlineseg will do this one for us
1407 # should handle duplicated parents here...
1408 set coords [list $x $y]
1409 if {$i < $col - 1} {
1410 lappend coords [xc $row [expr {$i + 1}]] $y
1411 } elseif {$i > $col + 1} {
1412 lappend coords [xc $row [expr {$i - 1}]] $y
1414 lappend coords $x2 $y2
1415 set t [$canv create line $coords -width [linewidth $p] \
1416 -fill $colormap($p) -tags lines.$p]
1423 proc drawlines {id} {
1424 global colormap canv
1425 global idrowranges idrangedrawn
1426 global childlist iddrawn commitrow rowidlist
1428 $canv delete lines.$id
1429 set nr [expr {[llength $idrowranges($id)] / 2}]
1430 for {set i 0} {$i < $nr} {incr i} {
1431 if {[info exists idrangedrawn($id,$i)]} {
1435 foreach child [lindex $childlist $commitrow($id)] {
1436 if {[info exists iddrawn($child)]} {
1437 set row $commitrow($child)
1438 set col [lsearch -exact [lindex $rowidlist $row] $child]
1440 drawparentlinks $child $row $col [list $id]
1446 proc drawcmittext {id row col rmx} {
1447 global linespc canv canv2 canv3 canvy0
1448 global commitlisted commitinfo rowidlist
1449 global rowtextx idpos idtags idheads idotherrefs
1450 global linehtag linentag linedtag
1451 global mainfont namefont canvxmax
1453 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1454 set x [xc $row $col]
1456 set orad [expr {$linespc / 3}]
1457 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1458 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1459 -fill $ofill -outline black -width 1]
1461 $canv bind $t <1> {selcanvline {} %x %y}
1462 set xt [xc $row [llength [lindex $rowidlist $row]]]
1466 set rowtextx($row) $xt
1467 set idpos($id) [list $x $xt $y]
1468 if {[info exists idtags($id)] || [info exists idheads($id)]
1469 || [info exists idotherrefs($id)]} {
1470 set xt [drawtags $id $x $xt $y]
1472 set headline [lindex $commitinfo($id) 0]
1473 set name [lindex $commitinfo($id) 1]
1474 set date [lindex $commitinfo($id) 2]
1475 set date [formatdate $date]
1476 set linehtag($row) [$canv create text $xt $y -anchor w \
1477 -text $headline -font $mainfont ]
1478 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1479 set linentag($row) [$canv2 create text 3 $y -anchor w \
1480 -text $name -font $namefont]
1481 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1482 -text $date -font $mainfont]
1483 set xr [expr {$xt + [font measure $mainfont $headline]}]
1484 if {$xr > $canvxmax} {
1490 proc drawcmitrow {row} {
1491 global displayorder rowidlist
1492 global idrowranges idrangedrawn iddrawn
1493 global commitinfo commitlisted parentlist numcommits
1495 if {$row >= $numcommits} return
1496 foreach id [lindex $rowidlist $row] {
1497 if {![info exists idrowranges($id)]} continue
1499 foreach {s e} $idrowranges($id) {
1501 if {$row < $s} continue
1504 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1506 set idrangedrawn($id,$i) 1
1513 set id [lindex $displayorder $row]
1514 if {[info exists iddrawn($id)]} return
1515 set col [lsearch -exact [lindex $rowidlist $row] $id]
1517 puts "oops, row $row id $id not in list"
1520 if {![info exists commitinfo($id)]} {
1524 set olds [lindex $parentlist $row]
1526 set rmx [drawparentlinks $id $row $col $olds]
1530 drawcmittext $id $row $col $rmx
1534 proc drawfrac {f0 f1} {
1535 global numcommits canv
1538 set ymax [lindex [$canv cget -scrollregion] 3]
1539 if {$ymax eq {} || $ymax == 0} return
1540 set y0 [expr {int($f0 * $ymax)}]
1541 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1545 set y1 [expr {int($f1 * $ymax)}]
1546 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1547 if {$endrow >= $numcommits} {
1548 set endrow [expr {$numcommits - 1}]
1550 for {} {$row <= $endrow} {incr row} {
1555 proc drawvisible {} {
1557 eval drawfrac [$canv yview]
1560 proc clear_display {} {
1561 global iddrawn idrangedrawn
1564 catch {unset iddrawn}
1565 catch {unset idrangedrawn}
1568 proc assigncolor {id} {
1569 global colormap colors nextcolor
1570 global commitrow parentlist children childlist
1571 global cornercrossings crossings
1573 if {[info exists colormap($id)]} return
1574 set ncolors [llength $colors]
1575 if {[info exists commitrow($id)]} {
1576 set kids [lindex $childlist $commitrow($id)]
1577 } elseif {[info exists children($id)]} {
1578 set kids $children($id)
1582 if {[llength $kids] == 1} {
1583 set child [lindex $kids 0]
1584 if {[info exists colormap($child)]
1585 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1586 set colormap($id) $colormap($child)
1591 if {[info exists cornercrossings($id)]} {
1592 foreach x $cornercrossings($id) {
1593 if {[info exists colormap($x)]
1594 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1595 lappend badcolors $colormap($x)
1598 if {[llength $badcolors] >= $ncolors} {
1602 set origbad $badcolors
1603 if {[llength $badcolors] < $ncolors - 1} {
1604 if {[info exists crossings($id)]} {
1605 foreach x $crossings($id) {
1606 if {[info exists colormap($x)]
1607 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1608 lappend badcolors $colormap($x)
1611 if {[llength $badcolors] >= $ncolors} {
1612 set badcolors $origbad
1615 set origbad $badcolors
1617 if {[llength $badcolors] < $ncolors - 1} {
1618 foreach child $kids {
1619 if {[info exists colormap($child)]
1620 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1621 lappend badcolors $colormap($child)
1623 foreach p [lindex $parentlist $commitrow($child)] {
1624 if {[info exists colormap($p)]
1625 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1626 lappend badcolors $colormap($p)
1630 if {[llength $badcolors] >= $ncolors} {
1631 set badcolors $origbad
1634 for {set i 0} {$i <= $ncolors} {incr i} {
1635 set c [lindex $colors $nextcolor]
1636 if {[incr nextcolor] >= $ncolors} {
1639 if {[lsearch -exact $badcolors $c]} break
1641 set colormap($id) $c
1644 proc bindline {t id} {
1647 $canv bind $t <Enter> "lineenter %x %y $id"
1648 $canv bind $t <Motion> "linemotion %x %y $id"
1649 $canv bind $t <Leave> "lineleave $id"
1650 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1653 proc drawtags {id x xt y1} {
1654 global idtags idheads idotherrefs
1655 global linespc lthickness
1656 global canv mainfont commitrow rowtextx
1661 if {[info exists idtags($id)]} {
1662 set marks $idtags($id)
1663 set ntags [llength $marks]
1665 if {[info exists idheads($id)]} {
1666 set marks [concat $marks $idheads($id)]
1667 set nheads [llength $idheads($id)]
1669 if {[info exists idotherrefs($id)]} {
1670 set marks [concat $marks $idotherrefs($id)]
1676 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1677 set yt [expr {$y1 - 0.5 * $linespc}]
1678 set yb [expr {$yt + $linespc - 1}]
1681 foreach tag $marks {
1682 set wid [font measure $mainfont $tag]
1685 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1687 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1688 -width $lthickness -fill black -tags tag.$id]
1690 foreach tag $marks x $xvals wid $wvals {
1691 set xl [expr {$x + $delta}]
1692 set xr [expr {$x + $delta + $wid + $lthickness}]
1693 if {[incr ntags -1] >= 0} {
1695 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1696 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1697 -width 1 -outline black -fill yellow -tags tag.$id]
1698 $canv bind $t <1> [list showtag $tag 1]
1699 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1701 # draw a head or other ref
1702 if {[incr nheads -1] >= 0} {
1707 set xl [expr {$xl - $delta/2}]
1708 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1709 -width 1 -outline black -fill $col -tags tag.$id
1711 set t [$canv create text $xl $y1 -anchor w -text $tag \
1712 -font $mainfont -tags tag.$id]
1714 $canv bind $t <1> [list showtag $tag 1]
1720 proc checkcrossings {row endrow} {
1721 global displayorder parentlist rowidlist
1723 for {} {$row < $endrow} {incr row} {
1724 set id [lindex $displayorder $row]
1725 set i [lsearch -exact [lindex $rowidlist $row] $id]
1726 if {$i < 0} continue
1727 set idlist [lindex $rowidlist [expr {$row+1}]]
1728 foreach p [lindex $parentlist $row] {
1729 set j [lsearch -exact $idlist $p]
1732 notecrossings $row $p $j $i [expr {$j+1}]
1733 } elseif {$j > $i + 1} {
1734 notecrossings $row $p $i $j [expr {$j-1}]
1741 proc notecrossings {row id lo hi corner} {
1742 global rowidlist crossings cornercrossings
1744 for {set i $lo} {[incr i] < $hi} {} {
1745 set p [lindex [lindex $rowidlist $row] $i]
1746 if {$p == {}} continue
1747 if {$i == $corner} {
1748 if {![info exists cornercrossings($id)]
1749 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1750 lappend cornercrossings($id) $p
1752 if {![info exists cornercrossings($p)]
1753 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1754 lappend cornercrossings($p) $id
1757 if {![info exists crossings($id)]
1758 || [lsearch -exact $crossings($id) $p] < 0} {
1759 lappend crossings($id) $p
1761 if {![info exists crossings($p)]
1762 || [lsearch -exact $crossings($p) $id] < 0} {
1763 lappend crossings($p) $id
1769 proc xcoord {i level ln} {
1770 global canvx0 xspc1 xspc2
1772 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1773 if {$i > 0 && $i == $level} {
1774 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1775 } elseif {$i > $level} {
1776 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1781 proc finishcommits {} {
1782 global commitidx phase
1783 global canv mainfont ctext maincursor textcursor
1784 global findinprogress
1786 if {$commitidx > 0} {
1790 $canv create text 3 3 -anchor nw -text "No commits selected" \
1791 -font $mainfont -tags textitems
1793 if {![info exists findinprogress]} {
1794 . config -cursor $maincursor
1795 settextcursor $textcursor
1800 # Don't change the text pane cursor if it is currently the hand cursor,
1801 # showing that we are over a sha1 ID link.
1802 proc settextcursor {c} {
1803 global ctext curtextcursor
1805 if {[$ctext cget -cursor] == $curtextcursor} {
1806 $ctext config -cursor $c
1808 set curtextcursor $c
1814 global canvy0 numcommits linespc
1815 global rowlaidout commitidx
1818 layoutrows $rowlaidout $commitidx 1
1820 optimize_rows $row 0 $commitidx
1821 showstuff $commitidx
1823 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1824 #puts "overall $drawmsecs ms for $numcommits commits"
1827 proc findmatches {f} {
1828 global findtype foundstring foundstrlen
1829 if {$findtype == "Regexp"} {
1830 set matches [regexp -indices -all -inline $foundstring $f]
1832 if {$findtype == "IgnCase"} {
1833 set str [string tolower $f]
1839 while {[set j [string first $foundstring $str $i]] >= 0} {
1840 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1841 set i [expr {$j + $foundstrlen}]
1848 global findtype findloc findstring markedmatches commitinfo
1849 global numcommits displayorder linehtag linentag linedtag
1850 global mainfont namefont canv canv2 canv3 selectedline
1851 global matchinglines foundstring foundstrlen matchstring
1857 set matchinglines {}
1858 if {$findloc == "Pickaxe"} {
1862 if {$findtype == "IgnCase"} {
1863 set foundstring [string tolower $findstring]
1865 set foundstring $findstring
1867 set foundstrlen [string length $findstring]
1868 if {$foundstrlen == 0} return
1869 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1870 set matchstring "*$matchstring*"
1871 if {$findloc == "Files"} {
1875 if {![info exists selectedline]} {
1878 set oldsel $selectedline
1881 set fldtypes {Headline Author Date Committer CDate Comment}
1883 foreach id $displayorder {
1884 set d $commitdata($id)
1886 if {$findtype == "Regexp"} {
1887 set doesmatch [regexp $foundstring $d]
1888 } elseif {$findtype == "IgnCase"} {
1889 set doesmatch [string match -nocase $matchstring $d]
1891 set doesmatch [string match $matchstring $d]
1893 if {!$doesmatch} continue
1894 if {![info exists commitinfo($id)]} {
1897 set info $commitinfo($id)
1899 foreach f $info ty $fldtypes {
1900 if {$findloc != "All fields" && $findloc != $ty} {
1903 set matches [findmatches $f]
1904 if {$matches == {}} continue
1906 if {$ty == "Headline"} {
1908 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1909 } elseif {$ty == "Author"} {
1911 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1912 } elseif {$ty == "Date"} {
1914 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1918 lappend matchinglines $l
1919 if {!$didsel && $l > $oldsel} {
1925 if {$matchinglines == {}} {
1927 } elseif {!$didsel} {
1928 findselectline [lindex $matchinglines 0]
1932 proc findselectline {l} {
1933 global findloc commentend ctext
1935 if {$findloc == "All fields" || $findloc == "Comments"} {
1936 # highlight the matches in the comments
1937 set f [$ctext get 1.0 $commentend]
1938 set matches [findmatches $f]
1939 foreach match $matches {
1940 set start [lindex $match 0]
1941 set end [expr {[lindex $match 1] + 1}]
1942 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1947 proc findnext {restart} {
1948 global matchinglines selectedline
1949 if {![info exists matchinglines]} {
1955 if {![info exists selectedline]} return
1956 foreach l $matchinglines {
1957 if {$l > $selectedline} {
1966 global matchinglines selectedline
1967 if {![info exists matchinglines]} {
1971 if {![info exists selectedline]} return
1973 foreach l $matchinglines {
1974 if {$l >= $selectedline} break
1978 findselectline $prev
1984 proc findlocchange {name ix op} {
1985 global findloc findtype findtypemenu
1986 if {$findloc == "Pickaxe"} {
1992 $findtypemenu entryconf 1 -state $state
1993 $findtypemenu entryconf 2 -state $state
1996 proc stopfindproc {{done 0}} {
1997 global findprocpid findprocfile findids
1998 global ctext findoldcursor phase maincursor textcursor
1999 global findinprogress
2001 catch {unset findids}
2002 if {[info exists findprocpid]} {
2004 catch {exec kill $findprocpid}
2006 catch {close $findprocfile}
2009 if {[info exists findinprogress]} {
2010 unset findinprogress
2011 if {$phase != "incrdraw"} {
2012 . config -cursor $maincursor
2013 settextcursor $textcursor
2018 proc findpatches {} {
2019 global findstring selectedline numcommits
2020 global findprocpid findprocfile
2021 global finddidsel ctext displayorder findinprogress
2022 global findinsertpos
2024 if {$numcommits == 0} return
2026 # make a list of all the ids to search, starting at the one
2027 # after the selected line (if any)
2028 if {[info exists selectedline]} {
2034 for {set i 0} {$i < $numcommits} {incr i} {
2035 if {[incr l] >= $numcommits} {
2038 append inputids [lindex $displayorder $l] "\n"
2042 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2045 error_popup "Error starting search process: $err"
2049 set findinsertpos end
2051 set findprocpid [pid $f]
2052 fconfigure $f -blocking 0
2053 fileevent $f readable readfindproc
2055 . config -cursor watch
2057 set findinprogress 1
2060 proc readfindproc {} {
2061 global findprocfile finddidsel
2062 global commitrow matchinglines findinsertpos
2064 set n [gets $findprocfile line]
2066 if {[eof $findprocfile]} {
2074 if {![regexp {^[0-9a-f]{40}} $line id]} {
2075 error_popup "Can't parse git-diff-tree output: $line"
2079 if {![info exists commitrow($id)]} {
2080 puts stderr "spurious id: $id"
2083 set l $commitrow($id)
2087 proc insertmatch {l id} {
2088 global matchinglines findinsertpos finddidsel
2090 if {$findinsertpos == "end"} {
2091 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2092 set matchinglines [linsert $matchinglines 0 $l]
2095 lappend matchinglines $l
2098 set matchinglines [linsert $matchinglines $findinsertpos $l]
2109 global selectedline numcommits displayorder ctext
2110 global ffileline finddidsel parentlist
2111 global findinprogress findstartline findinsertpos
2112 global treediffs fdiffid fdiffsneeded fdiffpos
2113 global findmergefiles
2115 if {$numcommits == 0} return
2117 if {[info exists selectedline]} {
2118 set l [expr {$selectedline + 1}]
2123 set findstartline $l
2127 set id [lindex $displayorder $l]
2128 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2129 if {![info exists treediffs($id)]} {
2130 append diffsneeded "$id\n"
2131 lappend fdiffsneeded $id
2134 if {[incr l] >= $numcommits} {
2137 if {$l == $findstartline} break
2140 # start off a git-diff-tree process if needed
2141 if {$diffsneeded ne {}} {
2143 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2145 error_popup "Error starting search process: $err"
2148 catch {unset fdiffid}
2150 fconfigure $df -blocking 0
2151 fileevent $df readable [list readfilediffs $df]
2155 set findinsertpos end
2156 set id [lindex $displayorder $l]
2157 . config -cursor watch
2159 set findinprogress 1
2164 proc readfilediffs {df} {
2165 global findid fdiffid fdiffs
2167 set n [gets $df line]
2171 if {[catch {close $df} err]} {
2174 error_popup "Error in git-diff-tree: $err"
2175 } elseif {[info exists findid]} {
2179 error_popup "Couldn't find diffs for $id"
2184 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2185 # start of a new string of diffs
2189 } elseif {[string match ":*" $line]} {
2190 lappend fdiffs [lindex $line 5]
2194 proc donefilediff {} {
2195 global fdiffid fdiffs treediffs findid
2196 global fdiffsneeded fdiffpos
2198 if {[info exists fdiffid]} {
2199 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2200 && $fdiffpos < [llength $fdiffsneeded]} {
2201 # git-diff-tree doesn't output anything for a commit
2202 # which doesn't change anything
2203 set nullid [lindex $fdiffsneeded $fdiffpos]
2204 set treediffs($nullid) {}
2205 if {[info exists findid] && $nullid eq $findid} {
2213 if {![info exists treediffs($fdiffid)]} {
2214 set treediffs($fdiffid) $fdiffs
2216 if {[info exists findid] && $fdiffid eq $findid} {
2223 proc findcont {id} {
2224 global findid treediffs parentlist
2225 global ffileline findstartline finddidsel
2226 global displayorder numcommits matchinglines findinprogress
2227 global findmergefiles
2231 set id [lindex $displayorder $l]
2232 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2233 if {![info exists treediffs($id)]} {
2239 foreach f $treediffs($id) {
2240 set x [findmatches $f]
2250 if {[incr l] >= $numcommits} {
2253 if {$l == $findstartline} break
2261 # mark a commit as matching by putting a yellow background
2262 # behind the headline
2263 proc markheadline {l id} {
2264 global canv mainfont linehtag
2267 set bbox [$canv bbox $linehtag($l)]
2268 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2272 # mark the bits of a headline, author or date that match a find string
2273 proc markmatches {canv l str tag matches font} {
2274 set bbox [$canv bbox $tag]
2275 set x0 [lindex $bbox 0]
2276 set y0 [lindex $bbox 1]
2277 set y1 [lindex $bbox 3]
2278 foreach match $matches {
2279 set start [lindex $match 0]
2280 set end [lindex $match 1]
2281 if {$start > $end} continue
2282 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2283 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2284 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2285 [expr {$x0+$xlen+2}] $y1 \
2286 -outline {} -tags matches -fill yellow]
2291 proc unmarkmatches {} {
2292 global matchinglines findids
2293 allcanvs delete matches
2294 catch {unset matchinglines}
2295 catch {unset findids}
2298 proc selcanvline {w x y} {
2299 global canv canvy0 ctext linespc
2301 set ymax [lindex [$canv cget -scrollregion] 3]
2302 if {$ymax == {}} return
2303 set yfrac [lindex [$canv yview] 0]
2304 set y [expr {$y + $yfrac * $ymax}]
2305 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2310 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2316 proc commit_descriptor {p} {
2319 if {[info exists commitinfo($p)]} {
2320 set l [lindex $commitinfo($p) 0]
2325 # append some text to the ctext widget, and make any SHA1 ID
2326 # that we know about be a clickable link.
2327 proc appendwithlinks {text} {
2328 global ctext commitrow linknum
2330 set start [$ctext index "end - 1c"]
2331 $ctext insert end $text
2332 $ctext insert end "\n"
2333 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2337 set linkid [string range $text $s $e]
2338 if {![info exists commitrow($linkid)]} continue
2340 $ctext tag add link "$start + $s c" "$start + $e c"
2341 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2342 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2345 $ctext tag conf link -foreground blue -underline 1
2346 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2347 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2350 proc viewnextline {dir} {
2354 set ymax [lindex [$canv cget -scrollregion] 3]
2355 set wnow [$canv yview]
2356 set wtop [expr {[lindex $wnow 0] * $ymax}]
2357 set newtop [expr {$wtop + $dir * $linespc}]
2360 } elseif {$newtop > $ymax} {
2363 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2366 proc selectline {l isnew} {
2367 global canv canv2 canv3 ctext commitinfo selectedline
2368 global displayorder linehtag linentag linedtag
2369 global canvy0 linespc parentlist childlist
2370 global cflist currentid sha1entry
2371 global commentend idtags linknum
2372 global mergemax numcommits
2376 if {$l < 0 || $l >= $numcommits} return
2377 set y [expr {$canvy0 + $l * $linespc}]
2378 set ymax [lindex [$canv cget -scrollregion] 3]
2379 set ytop [expr {$y - $linespc - 1}]
2380 set ybot [expr {$y + $linespc + 1}]
2381 set wnow [$canv yview]
2382 set wtop [expr {[lindex $wnow 0] * $ymax}]
2383 set wbot [expr {[lindex $wnow 1] * $ymax}]
2384 set wh [expr {$wbot - $wtop}]
2386 if {$ytop < $wtop} {
2387 if {$ybot < $wtop} {
2388 set newtop [expr {$y - $wh / 2.0}]
2391 if {$newtop > $wtop - $linespc} {
2392 set newtop [expr {$wtop - $linespc}]
2395 } elseif {$ybot > $wbot} {
2396 if {$ytop > $wbot} {
2397 set newtop [expr {$y - $wh / 2.0}]
2399 set newtop [expr {$ybot - $wh}]
2400 if {$newtop < $wtop + $linespc} {
2401 set newtop [expr {$wtop + $linespc}]
2405 if {$newtop != $wtop} {
2409 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2413 if {![info exists linehtag($l)]} return
2415 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2416 -tags secsel -fill [$canv cget -selectbackground]]
2418 $canv2 delete secsel
2419 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2420 -tags secsel -fill [$canv2 cget -selectbackground]]
2422 $canv3 delete secsel
2423 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2424 -tags secsel -fill [$canv3 cget -selectbackground]]
2428 addtohistory [list selectline $l 0]
2433 set id [lindex $displayorder $l]
2435 $sha1entry delete 0 end
2436 $sha1entry insert 0 $id
2437 $sha1entry selection from 0
2438 $sha1entry selection to end
2440 $ctext conf -state normal
2441 $ctext delete 0.0 end
2443 $ctext mark set fmark.0 0.0
2444 $ctext mark gravity fmark.0 left
2445 set info $commitinfo($id)
2446 set date [formatdate [lindex $info 2]]
2447 $ctext insert end "Author: [lindex $info 1] $date\n"
2448 set date [formatdate [lindex $info 4]]
2449 $ctext insert end "Committer: [lindex $info 3] $date\n"
2450 if {[info exists idtags($id)]} {
2451 $ctext insert end "Tags:"
2452 foreach tag $idtags($id) {
2453 $ctext insert end " $tag"
2455 $ctext insert end "\n"
2459 set olds [lindex $parentlist $l]
2460 if {[llength $olds] > 1} {
2463 if {$np >= $mergemax} {
2468 $ctext insert end "Parent: " $tag
2469 appendwithlinks [commit_descriptor $p]
2474 append comment "Parent: [commit_descriptor $p]\n"
2478 foreach c [lindex $childlist $l] {
2479 append comment "Child: [commit_descriptor $c]\n"
2482 append comment [lindex $info 5]
2484 # make anything that looks like a SHA1 ID be a clickable link
2485 appendwithlinks $comment
2487 $ctext tag delete Comments
2488 $ctext tag remove found 1.0 end
2489 $ctext conf -state disabled
2490 set commentend [$ctext index "end - 1c"]
2492 $cflist delete 0 end
2493 $cflist insert end "Comments"
2494 if {[llength $olds] <= 1} {
2501 proc selfirstline {} {
2506 proc sellastline {} {
2509 set l [expr {$numcommits - 1}]
2513 proc selnextline {dir} {
2515 if {![info exists selectedline]} return
2516 set l [expr {$selectedline + $dir}]
2521 proc selnextpage {dir} {
2522 global canv linespc selectedline numcommits
2524 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2528 allcanvs yview scroll [expr {$dir * $lpp}] units
2529 if {![info exists selectedline]} return
2530 set l [expr {$selectedline + $dir * $lpp}]
2533 } elseif {$l >= $numcommits} {
2534 set l [expr $numcommits - 1]
2540 proc unselectline {} {
2543 catch {unset selectedline}
2544 allcanvs delete secsel
2547 proc addtohistory {cmd} {
2548 global history historyindex
2550 if {$historyindex > 0
2551 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2555 if {$historyindex < [llength $history]} {
2556 set history [lreplace $history $historyindex end $cmd]
2558 lappend history $cmd
2561 if {$historyindex > 1} {
2562 .ctop.top.bar.leftbut conf -state normal
2564 .ctop.top.bar.leftbut conf -state disabled
2566 .ctop.top.bar.rightbut conf -state disabled
2570 global history historyindex
2572 if {$historyindex > 1} {
2573 incr historyindex -1
2574 set cmd [lindex $history [expr {$historyindex - 1}]]
2576 .ctop.top.bar.rightbut conf -state normal
2578 if {$historyindex <= 1} {
2579 .ctop.top.bar.leftbut conf -state disabled
2584 global history historyindex
2586 if {$historyindex < [llength $history]} {
2587 set cmd [lindex $history $historyindex]
2590 .ctop.top.bar.leftbut conf -state normal
2592 if {$historyindex >= [llength $history]} {
2593 .ctop.top.bar.rightbut conf -state disabled
2597 proc mergediff {id l} {
2598 global diffmergeid diffopts mdifffd
2599 global difffilestart diffids
2604 catch {unset difffilestart}
2605 # this doesn't seem to actually affect anything...
2606 set env(GIT_DIFF_OPTS) $diffopts
2607 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2608 if {[catch {set mdf [open $cmd r]} err]} {
2609 error_popup "Error getting merge diffs: $err"
2612 fconfigure $mdf -blocking 0
2613 set mdifffd($id) $mdf
2614 set np [llength [lindex $parentlist $l]]
2615 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2616 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2619 proc getmergediffline {mdf id np} {
2620 global diffmergeid ctext cflist nextupdate mergemax
2621 global difffilestart mdifffd
2623 set n [gets $mdf line]
2630 if {![info exists diffmergeid] || $id != $diffmergeid
2631 || $mdf != $mdifffd($id)} {
2634 $ctext conf -state normal
2635 if {[regexp {^diff --cc (.*)} $line match fname]} {
2636 # start of a new file
2637 $ctext insert end "\n"
2638 set here [$ctext index "end - 1c"]
2639 set i [$cflist index end]
2640 $ctext mark set fmark.$i $here
2641 $ctext mark gravity fmark.$i left
2642 set difffilestart([expr {$i-1}]) $here
2643 $cflist insert end $fname
2644 set l [expr {(78 - [string length $fname]) / 2}]
2645 set pad [string range "----------------------------------------" 1 $l]
2646 $ctext insert end "$pad $fname $pad\n" filesep
2647 } elseif {[regexp {^@@} $line]} {
2648 $ctext insert end "$line\n" hunksep
2649 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2652 # parse the prefix - one ' ', '-' or '+' for each parent
2657 for {set j 0} {$j < $np} {incr j} {
2658 set c [string range $line $j $j]
2661 } elseif {$c == "-"} {
2663 } elseif {$c == "+"} {
2672 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2673 # line doesn't appear in result, parents in $minuses have the line
2674 set num [lindex $minuses 0]
2675 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2676 # line appears in result, parents in $pluses don't have the line
2677 lappend tags mresult
2678 set num [lindex $spaces 0]
2681 if {$num >= $mergemax} {
2686 $ctext insert end "$line\n" $tags
2688 $ctext conf -state disabled
2689 if {[clock clicks -milliseconds] >= $nextupdate} {
2691 fileevent $mdf readable {}
2693 fileevent $mdf readable [list getmergediffline $mdf $id]
2697 proc startdiff {ids} {
2698 global treediffs diffids treepending diffmergeid
2701 catch {unset diffmergeid}
2702 if {![info exists treediffs($ids)]} {
2703 if {![info exists treepending]} {
2711 proc addtocflist {ids} {
2712 global treediffs cflist
2713 foreach f $treediffs($ids) {
2714 $cflist insert end $f
2719 proc gettreediffs {ids} {
2720 global treediff treepending
2721 set treepending $ids
2724 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2726 fconfigure $gdtf -blocking 0
2727 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2730 proc gettreediffline {gdtf ids} {
2731 global treediff treediffs treepending diffids diffmergeid
2733 set n [gets $gdtf line]
2735 if {![eof $gdtf]} return
2737 set treediffs($ids) $treediff
2739 if {$ids != $diffids} {
2740 if {![info exists diffmergeid]} {
2741 gettreediffs $diffids
2748 set file [lindex $line 5]
2749 lappend treediff $file
2752 proc getblobdiffs {ids} {
2753 global diffopts blobdifffd diffids env curdifftag curtagstart
2754 global difffilestart nextupdate diffinhdr treediffs
2756 set env(GIT_DIFF_OPTS) $diffopts
2757 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2758 if {[catch {set bdf [open $cmd r]} err]} {
2759 puts "error getting diffs: $err"
2763 fconfigure $bdf -blocking 0
2764 set blobdifffd($ids) $bdf
2765 set curdifftag Comments
2767 catch {unset difffilestart}
2768 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2769 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2772 proc getblobdiffline {bdf ids} {
2773 global diffids blobdifffd ctext curdifftag curtagstart
2774 global diffnexthead diffnextnote difffilestart
2775 global nextupdate diffinhdr treediffs
2777 set n [gets $bdf line]
2781 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2782 $ctext tag add $curdifftag $curtagstart end
2787 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2790 $ctext conf -state normal
2791 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2792 # start of a new file
2793 $ctext insert end "\n"
2794 $ctext tag add $curdifftag $curtagstart end
2795 set curtagstart [$ctext index "end - 1c"]
2797 set here [$ctext index "end - 1c"]
2798 set i [lsearch -exact $treediffs($diffids) $fname]
2800 set difffilestart($i) $here
2802 $ctext mark set fmark.$i $here
2803 $ctext mark gravity fmark.$i left
2805 if {$newname != $fname} {
2806 set i [lsearch -exact $treediffs($diffids) $newname]
2808 set difffilestart($i) $here
2810 $ctext mark set fmark.$i $here
2811 $ctext mark gravity fmark.$i left
2814 set curdifftag "f:$fname"
2815 $ctext tag delete $curdifftag
2816 set l [expr {(78 - [string length $header]) / 2}]
2817 set pad [string range "----------------------------------------" 1 $l]
2818 $ctext insert end "$pad $header $pad\n" filesep
2820 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2822 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2824 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2825 $line match f1l f1c f2l f2c rest]} {
2826 $ctext insert end "$line\n" hunksep
2829 set x [string range $line 0 0]
2830 if {$x == "-" || $x == "+"} {
2831 set tag [expr {$x == "+"}]
2832 $ctext insert end "$line\n" d$tag
2833 } elseif {$x == " "} {
2834 $ctext insert end "$line\n"
2835 } elseif {$diffinhdr || $x == "\\"} {
2836 # e.g. "\ No newline at end of file"
2837 $ctext insert end "$line\n" filesep
2839 # Something else we don't recognize
2840 if {$curdifftag != "Comments"} {
2841 $ctext insert end "\n"
2842 $ctext tag add $curdifftag $curtagstart end
2843 set curtagstart [$ctext index "end - 1c"]
2844 set curdifftag Comments
2846 $ctext insert end "$line\n" filesep
2849 $ctext conf -state disabled
2850 if {[clock clicks -milliseconds] >= $nextupdate} {
2852 fileevent $bdf readable {}
2854 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2859 global difffilestart ctext
2860 set here [$ctext index @0,0]
2861 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2862 if {[$ctext compare $difffilestart($i) > $here]} {
2863 if {![info exists pos]
2864 || [$ctext compare $difffilestart($i) < $pos]} {
2865 set pos $difffilestart($i)
2869 if {[info exists pos]} {
2874 proc listboxsel {} {
2875 global ctext cflist currentid
2876 if {![info exists currentid]} return
2877 set sel [lsort [$cflist curselection]]
2878 if {$sel eq {}} return
2879 set first [lindex $sel 0]
2880 catch {$ctext yview fmark.$first}
2884 global linespc charspc canvx0 canvy0 mainfont
2885 global xspc1 xspc2 lthickness
2887 set linespc [font metrics $mainfont -linespace]
2888 set charspc [font measure $mainfont "m"]
2889 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2890 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2891 set lthickness [expr {int($linespc / 9) + 1}]
2892 set xspc1(0) $linespc
2900 set ymax [lindex [$canv cget -scrollregion] 3]
2901 if {$ymax eq {} || $ymax == 0} return
2902 set span [$canv yview]
2905 allcanvs yview moveto [lindex $span 0]
2907 if {[info exists selectedline]} {
2908 selectline $selectedline 0
2912 proc incrfont {inc} {
2913 global mainfont namefont textfont ctext canv phase
2914 global stopped entries
2916 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2917 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2918 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2920 $ctext conf -font $textfont
2921 $ctext tag conf filesep -font [concat $textfont bold]
2922 foreach e $entries {
2923 $e conf -font $mainfont
2925 if {$phase == "getcommits"} {
2926 $canv itemconf textitems -font $mainfont
2932 global sha1entry sha1string
2933 if {[string length $sha1string] == 40} {
2934 $sha1entry delete 0 end
2938 proc sha1change {n1 n2 op} {
2939 global sha1string currentid sha1but
2940 if {$sha1string == {}
2941 || ([info exists currentid] && $sha1string == $currentid)} {
2946 if {[$sha1but cget -state] == $state} return
2947 if {$state == "normal"} {
2948 $sha1but conf -state normal -relief raised -text "Goto: "
2950 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2954 proc gotocommit {} {
2955 global sha1string currentid commitrow tagids headids
2956 global displayorder numcommits
2958 if {$sha1string == {}
2959 || ([info exists currentid] && $sha1string == $currentid)} return
2960 if {[info exists tagids($sha1string)]} {
2961 set id $tagids($sha1string)
2962 } elseif {[info exists headids($sha1string)]} {
2963 set id $headids($sha1string)
2965 set id [string tolower $sha1string]
2966 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2968 foreach i $displayorder {
2969 if {[string match $id* $i]} {
2973 if {$matches ne {}} {
2974 if {[llength $matches] > 1} {
2975 error_popup "Short SHA1 id $id is ambiguous"
2978 set id [lindex $matches 0]
2982 if {[info exists commitrow($id)]} {
2983 selectline $commitrow($id) 1
2986 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2991 error_popup "$type $sha1string is not known"
2994 proc lineenter {x y id} {
2995 global hoverx hovery hoverid hovertimer
2996 global commitinfo canv
2998 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3002 if {[info exists hovertimer]} {
3003 after cancel $hovertimer
3005 set hovertimer [after 500 linehover]
3009 proc linemotion {x y id} {
3010 global hoverx hovery hoverid hovertimer
3012 if {[info exists hoverid] && $id == $hoverid} {
3015 if {[info exists hovertimer]} {
3016 after cancel $hovertimer
3018 set hovertimer [after 500 linehover]
3022 proc lineleave {id} {
3023 global hoverid hovertimer canv
3025 if {[info exists hoverid] && $id == $hoverid} {
3027 if {[info exists hovertimer]} {
3028 after cancel $hovertimer
3036 global hoverx hovery hoverid hovertimer
3037 global canv linespc lthickness
3038 global commitinfo mainfont
3040 set text [lindex $commitinfo($hoverid) 0]
3041 set ymax [lindex [$canv cget -scrollregion] 3]
3042 if {$ymax == {}} return
3043 set yfrac [lindex [$canv yview] 0]
3044 set x [expr {$hoverx + 2 * $linespc}]
3045 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3046 set x0 [expr {$x - 2 * $lthickness}]
3047 set y0 [expr {$y - 2 * $lthickness}]
3048 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3049 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3050 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3051 -fill \#ffff80 -outline black -width 1 -tags hover]
3053 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3057 proc clickisonarrow {id y} {
3058 global lthickness idrowranges
3060 set thresh [expr {2 * $lthickness + 6}]
3061 set n [expr {[llength $idrowranges($id)] - 1}]
3062 for {set i 1} {$i < $n} {incr i} {
3063 set row [lindex $idrowranges($id) $i]
3064 if {abs([yc $row] - $y) < $thresh} {
3071 proc arrowjump {id n y} {
3072 global idrowranges canv
3074 # 1 <-> 2, 3 <-> 4, etc...
3075 set n [expr {(($n - 1) ^ 1) + 1}]
3076 set row [lindex $idrowranges($id) $n]
3078 set ymax [lindex [$canv cget -scrollregion] 3]
3079 if {$ymax eq {} || $ymax <= 0} return
3080 set view [$canv yview]
3081 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3082 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3086 allcanvs yview moveto $yfrac
3089 proc lineclick {x y id isnew} {
3090 global ctext commitinfo childlist commitrow cflist canv thickerline
3092 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3097 # draw this line thicker than normal
3101 set ymax [lindex [$canv cget -scrollregion] 3]
3102 if {$ymax eq {}} return
3103 set yfrac [lindex [$canv yview] 0]
3104 set y [expr {$y + $yfrac * $ymax}]
3106 set dirn [clickisonarrow $id $y]
3108 arrowjump $id $dirn $y
3113 addtohistory [list lineclick $x $y $id 0]
3115 # fill the details pane with info about this line
3116 $ctext conf -state normal
3117 $ctext delete 0.0 end
3118 $ctext tag conf link -foreground blue -underline 1
3119 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3120 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3121 $ctext insert end "Parent:\t"
3122 $ctext insert end $id [list link link0]
3123 $ctext tag bind link0 <1> [list selbyid $id]
3124 set info $commitinfo($id)
3125 $ctext insert end "\n\t[lindex $info 0]\n"
3126 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3127 set date [formatdate [lindex $info 2]]
3128 $ctext insert end "\tDate:\t$date\n"
3129 set kids [lindex $childlist $commitrow($id)]
3131 $ctext insert end "\nChildren:"
3133 foreach child $kids {
3135 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3136 set info $commitinfo($child)
3137 $ctext insert end "\n\t"
3138 $ctext insert end $child [list link link$i]
3139 $ctext tag bind link$i <1> [list selbyid $child]
3140 $ctext insert end "\n\t[lindex $info 0]"
3141 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3142 set date [formatdate [lindex $info 2]]
3143 $ctext insert end "\n\tDate:\t$date\n"
3146 $ctext conf -state disabled
3148 $cflist delete 0 end
3151 proc normalline {} {
3153 if {[info exists thickerline]} {
3162 if {[info exists commitrow($id)]} {
3163 selectline $commitrow($id) 1
3169 if {![info exists startmstime]} {
3170 set startmstime [clock clicks -milliseconds]
3172 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3175 proc rowmenu {x y id} {
3176 global rowctxmenu commitrow selectedline rowmenuid
3178 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3183 $rowctxmenu entryconfigure 0 -state $state
3184 $rowctxmenu entryconfigure 1 -state $state
3185 $rowctxmenu entryconfigure 2 -state $state
3187 tk_popup $rowctxmenu $x $y
3190 proc diffvssel {dirn} {
3191 global rowmenuid selectedline displayorder
3193 if {![info exists selectedline]} return
3195 set oldid [lindex $displayorder $selectedline]
3196 set newid $rowmenuid
3198 set oldid $rowmenuid
3199 set newid [lindex $displayorder $selectedline]
3201 addtohistory [list doseldiff $oldid $newid]
3202 doseldiff $oldid $newid
3205 proc doseldiff {oldid newid} {
3209 $ctext conf -state normal
3210 $ctext delete 0.0 end
3211 $ctext mark set fmark.0 0.0
3212 $ctext mark gravity fmark.0 left
3213 $cflist delete 0 end
3214 $cflist insert end "Top"
3215 $ctext insert end "From "
3216 $ctext tag conf link -foreground blue -underline 1
3217 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3218 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3219 $ctext tag bind link0 <1> [list selbyid $oldid]
3220 $ctext insert end $oldid [list link link0]
3221 $ctext insert end "\n "
3222 $ctext insert end [lindex $commitinfo($oldid) 0]
3223 $ctext insert end "\n\nTo "
3224 $ctext tag bind link1 <1> [list selbyid $newid]
3225 $ctext insert end $newid [list link link1]
3226 $ctext insert end "\n "
3227 $ctext insert end [lindex $commitinfo($newid) 0]
3228 $ctext insert end "\n"
3229 $ctext conf -state disabled
3230 $ctext tag delete Comments
3231 $ctext tag remove found 1.0 end
3232 startdiff [list $oldid $newid]
3236 global rowmenuid currentid commitinfo patchtop patchnum
3238 if {![info exists currentid]} return
3239 set oldid $currentid
3240 set oldhead [lindex $commitinfo($oldid) 0]
3241 set newid $rowmenuid
3242 set newhead [lindex $commitinfo($newid) 0]
3245 catch {destroy $top}
3247 label $top.title -text "Generate patch"
3248 grid $top.title - -pady 10
3249 label $top.from -text "From:"
3250 entry $top.fromsha1 -width 40 -relief flat
3251 $top.fromsha1 insert 0 $oldid
3252 $top.fromsha1 conf -state readonly
3253 grid $top.from $top.fromsha1 -sticky w
3254 entry $top.fromhead -width 60 -relief flat
3255 $top.fromhead insert 0 $oldhead
3256 $top.fromhead conf -state readonly
3257 grid x $top.fromhead -sticky w
3258 label $top.to -text "To:"
3259 entry $top.tosha1 -width 40 -relief flat
3260 $top.tosha1 insert 0 $newid
3261 $top.tosha1 conf -state readonly
3262 grid $top.to $top.tosha1 -sticky w
3263 entry $top.tohead -width 60 -relief flat
3264 $top.tohead insert 0 $newhead
3265 $top.tohead conf -state readonly
3266 grid x $top.tohead -sticky w
3267 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3268 grid $top.rev x -pady 10
3269 label $top.flab -text "Output file:"
3270 entry $top.fname -width 60
3271 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3273 grid $top.flab $top.fname -sticky w
3275 button $top.buts.gen -text "Generate" -command mkpatchgo
3276 button $top.buts.can -text "Cancel" -command mkpatchcan
3277 grid $top.buts.gen $top.buts.can
3278 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3279 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3280 grid $top.buts - -pady 10 -sticky ew
3284 proc mkpatchrev {} {
3287 set oldid [$patchtop.fromsha1 get]
3288 set oldhead [$patchtop.fromhead get]
3289 set newid [$patchtop.tosha1 get]
3290 set newhead [$patchtop.tohead get]
3291 foreach e [list fromsha1 fromhead tosha1 tohead] \
3292 v [list $newid $newhead $oldid $oldhead] {
3293 $patchtop.$e conf -state normal
3294 $patchtop.$e delete 0 end
3295 $patchtop.$e insert 0 $v
3296 $patchtop.$e conf -state readonly
3303 set oldid [$patchtop.fromsha1 get]
3304 set newid [$patchtop.tosha1 get]
3305 set fname [$patchtop.fname get]
3306 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3307 error_popup "Error creating patch: $err"
3309 catch {destroy $patchtop}
3313 proc mkpatchcan {} {
3316 catch {destroy $patchtop}
3321 global rowmenuid mktagtop commitinfo
3325 catch {destroy $top}
3327 label $top.title -text "Create tag"
3328 grid $top.title - -pady 10
3329 label $top.id -text "ID:"
3330 entry $top.sha1 -width 40 -relief flat
3331 $top.sha1 insert 0 $rowmenuid
3332 $top.sha1 conf -state readonly
3333 grid $top.id $top.sha1 -sticky w
3334 entry $top.head -width 60 -relief flat
3335 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3336 $top.head conf -state readonly
3337 grid x $top.head -sticky w
3338 label $top.tlab -text "Tag name:"
3339 entry $top.tag -width 60
3340 grid $top.tlab $top.tag -sticky w
3342 button $top.buts.gen -text "Create" -command mktaggo
3343 button $top.buts.can -text "Cancel" -command mktagcan
3344 grid $top.buts.gen $top.buts.can
3345 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3346 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3347 grid $top.buts - -pady 10 -sticky ew
3352 global mktagtop env tagids idtags
3354 set id [$mktagtop.sha1 get]
3355 set tag [$mktagtop.tag get]
3357 error_popup "No tag name specified"
3360 if {[info exists tagids($tag)]} {
3361 error_popup "Tag \"$tag\" already exists"
3366 set fname [file join $dir "refs/tags" $tag]
3367 set f [open $fname w]
3371 error_popup "Error creating tag: $err"
3375 set tagids($tag) $id
3376 lappend idtags($id) $tag
3380 proc redrawtags {id} {
3381 global canv linehtag commitrow idpos selectedline
3383 if {![info exists commitrow($id)]} return
3384 drawcmitrow $commitrow($id)
3385 $canv delete tag.$id
3386 set xt [eval drawtags $id $idpos($id)]
3387 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3388 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3389 selectline $selectedline 0
3396 catch {destroy $mktagtop}
3405 proc writecommit {} {
3406 global rowmenuid wrcomtop commitinfo wrcomcmd
3408 set top .writecommit
3410 catch {destroy $top}
3412 label $top.title -text "Write commit to file"
3413 grid $top.title - -pady 10
3414 label $top.id -text "ID:"
3415 entry $top.sha1 -width 40 -relief flat
3416 $top.sha1 insert 0 $rowmenuid
3417 $top.sha1 conf -state readonly
3418 grid $top.id $top.sha1 -sticky w
3419 entry $top.head -width 60 -relief flat
3420 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3421 $top.head conf -state readonly
3422 grid x $top.head -sticky w
3423 label $top.clab -text "Command:"
3424 entry $top.cmd -width 60 -textvariable wrcomcmd
3425 grid $top.clab $top.cmd -sticky w -pady 10
3426 label $top.flab -text "Output file:"
3427 entry $top.fname -width 60
3428 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3429 grid $top.flab $top.fname -sticky w
3431 button $top.buts.gen -text "Write" -command wrcomgo
3432 button $top.buts.can -text "Cancel" -command wrcomcan
3433 grid $top.buts.gen $top.buts.can
3434 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3435 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3436 grid $top.buts - -pady 10 -sticky ew
3443 set id [$wrcomtop.sha1 get]
3444 set cmd "echo $id | [$wrcomtop.cmd get]"
3445 set fname [$wrcomtop.fname get]
3446 if {[catch {exec sh -c $cmd >$fname &} err]} {
3447 error_popup "Error writing commit: $err"
3449 catch {destroy $wrcomtop}
3456 catch {destroy $wrcomtop}
3460 proc listrefs {id} {
3461 global idtags idheads idotherrefs
3464 if {[info exists idtags($id)]} {
3468 if {[info exists idheads($id)]} {
3472 if {[info exists idotherrefs($id)]} {
3473 set z $idotherrefs($id)
3475 return [list $x $y $z]
3478 proc rereadrefs {} {
3479 global idtags idheads idotherrefs
3481 set refids [concat [array names idtags] \
3482 [array names idheads] [array names idotherrefs]]
3483 foreach id $refids {
3484 if {![info exists ref($id)]} {
3485 set ref($id) [listrefs $id]
3489 set refids [lsort -unique [concat $refids [array names idtags] \
3490 [array names idheads] [array names idotherrefs]]]
3491 foreach id $refids {
3492 set v [listrefs $id]
3493 if {![info exists ref($id)] || $ref($id) != $v} {
3499 proc showtag {tag isnew} {
3500 global ctext cflist tagcontents tagids linknum
3503 addtohistory [list showtag $tag 0]
3505 $ctext conf -state normal
3506 $ctext delete 0.0 end
3508 if {[info exists tagcontents($tag)]} {
3509 set text $tagcontents($tag)
3511 set text "Tag: $tag\nId: $tagids($tag)"
3513 appendwithlinks $text
3514 $ctext conf -state disabled
3515 $cflist delete 0 end
3525 global maxwidth maxgraphpct diffopts findmergefiles
3526 global oldprefs prefstop
3530 if {[winfo exists $top]} {
3534 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3535 set oldprefs($v) [set $v]
3538 wm title $top "Gitk preferences"
3539 label $top.ldisp -text "Commit list display options"
3540 grid $top.ldisp - -sticky w -pady 10
3541 label $top.spacer -text " "
3542 label $top.maxwidthl -text "Maximum graph width (lines)" \
3544 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3545 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3546 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3548 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3549 grid x $top.maxpctl $top.maxpct -sticky w
3550 checkbutton $top.findm -variable findmergefiles
3551 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3553 grid $top.findm $top.findml - -sticky w
3554 label $top.ddisp -text "Diff display options"
3555 grid $top.ddisp - -sticky w -pady 10
3556 label $top.diffoptl -text "Options for diff program" \
3558 entry $top.diffopt -width 20 -textvariable diffopts
3559 grid x $top.diffoptl $top.diffopt -sticky w
3561 button $top.buts.ok -text "OK" -command prefsok
3562 button $top.buts.can -text "Cancel" -command prefscan
3563 grid $top.buts.ok $top.buts.can
3564 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3565 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3566 grid $top.buts - - -pady 10 -sticky ew
3570 global maxwidth maxgraphpct diffopts findmergefiles
3571 global oldprefs prefstop
3573 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3574 set $v $oldprefs($v)
3576 catch {destroy $prefstop}
3581 global maxwidth maxgraphpct
3582 global oldprefs prefstop
3584 catch {destroy $prefstop}
3586 if {$maxwidth != $oldprefs(maxwidth)
3587 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3592 proc formatdate {d} {
3593 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3596 # This list of encoding names and aliases is distilled from
3597 # http://www.iana.org/assignments/character-sets.
3598 # Not all of them are supported by Tcl.
3599 set encoding_aliases {
3600 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3601 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3602 { ISO-10646-UTF-1 csISO10646UTF1 }
3603 { ISO_646.basic:1983 ref csISO646basic1983 }
3604 { INVARIANT csINVARIANT }
3605 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3606 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3607 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3608 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3609 { NATS-DANO iso-ir-9-1 csNATSDANO }
3610 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3611 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3612 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3613 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3614 { ISO-2022-KR csISO2022KR }
3616 { ISO-2022-JP csISO2022JP }
3617 { ISO-2022-JP-2 csISO2022JP2 }
3618 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3620 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3621 { IT iso-ir-15 ISO646-IT csISO15Italian }
3622 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3623 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3624 { greek7-old iso-ir-18 csISO18Greek7Old }
3625 { latin-greek iso-ir-19 csISO19LatinGreek }
3626 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3627 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3628 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3629 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3630 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3631 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3632 { INIS iso-ir-49 csISO49INIS }
3633 { INIS-8 iso-ir-50 csISO50INIS8 }
3634 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3635 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3636 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3637 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3638 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3639 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3641 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3642 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3643 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3644 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3645 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3646 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3647 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3648 { greek7 iso-ir-88 csISO88Greek7 }
3649 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3650 { iso-ir-90 csISO90 }
3651 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3652 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3653 csISO92JISC62991984b }
3654 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3655 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3656 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3657 csISO95JIS62291984handadd }
3658 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3659 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3660 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3661 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3663 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3664 { T.61-7bit iso-ir-102 csISO102T617bit }
3665 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3666 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3667 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3668 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3669 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3670 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3671 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3672 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3673 arabic csISOLatinArabic }
3674 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3675 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3676 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3677 greek greek8 csISOLatinGreek }
3678 { T.101-G2 iso-ir-128 csISO128T101G2 }
3679 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3681 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3682 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3683 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3684 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3685 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3686 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3687 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3688 csISOLatinCyrillic }
3689 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3690 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3691 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3692 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3693 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3694 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3695 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3696 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3697 { ISO_10367-box iso-ir-155 csISO10367Box }
3698 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3699 { latin-lap lap iso-ir-158 csISO158Lap }
3700 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3701 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3704 { JIS_X0201 X0201 csHalfWidthKatakana }
3705 { KSC5636 ISO646-KR csKSC5636 }
3706 { ISO-10646-UCS-2 csUnicode }
3707 { ISO-10646-UCS-4 csUCS4 }
3708 { DEC-MCS dec csDECMCS }
3709 { hp-roman8 roman8 r8 csHPRoman8 }
3710 { macintosh mac csMacintosh }
3711 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3713 { IBM038 EBCDIC-INT cp038 csIBM038 }
3714 { IBM273 CP273 csIBM273 }
3715 { IBM274 EBCDIC-BE CP274 csIBM274 }
3716 { IBM275 EBCDIC-BR cp275 csIBM275 }
3717 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3718 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3719 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3720 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3721 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3722 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3723 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3724 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3725 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3726 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3727 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3728 { IBM437 cp437 437 csPC8CodePage437 }
3729 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3730 { IBM775 cp775 csPC775Baltic }
3731 { IBM850 cp850 850 csPC850Multilingual }
3732 { IBM851 cp851 851 csIBM851 }
3733 { IBM852 cp852 852 csPCp852 }
3734 { IBM855 cp855 855 csIBM855 }
3735 { IBM857 cp857 857 csIBM857 }
3736 { IBM860 cp860 860 csIBM860 }
3737 { IBM861 cp861 861 cp-is csIBM861 }
3738 { IBM862 cp862 862 csPC862LatinHebrew }
3739 { IBM863 cp863 863 csIBM863 }
3740 { IBM864 cp864 csIBM864 }
3741 { IBM865 cp865 865 csIBM865 }
3742 { IBM866 cp866 866 csIBM866 }
3743 { IBM868 CP868 cp-ar csIBM868 }
3744 { IBM869 cp869 869 cp-gr csIBM869 }
3745 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3746 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3747 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3748 { IBM891 cp891 csIBM891 }
3749 { IBM903 cp903 csIBM903 }
3750 { IBM904 cp904 904 csIBBM904 }
3751 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3752 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3753 { IBM1026 CP1026 csIBM1026 }
3754 { EBCDIC-AT-DE csIBMEBCDICATDE }
3755 { EBCDIC-AT-DE-A csEBCDICATDEA }
3756 { EBCDIC-CA-FR csEBCDICCAFR }
3757 { EBCDIC-DK-NO csEBCDICDKNO }
3758 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3759 { EBCDIC-FI-SE csEBCDICFISE }
3760 { EBCDIC-FI-SE-A csEBCDICFISEA }
3761 { EBCDIC-FR csEBCDICFR }
3762 { EBCDIC-IT csEBCDICIT }
3763 { EBCDIC-PT csEBCDICPT }
3764 { EBCDIC-ES csEBCDICES }
3765 { EBCDIC-ES-A csEBCDICESA }
3766 { EBCDIC-ES-S csEBCDICESS }
3767 { EBCDIC-UK csEBCDICUK }
3768 { EBCDIC-US csEBCDICUS }
3769 { UNKNOWN-8BIT csUnknown8BiT }
3770 { MNEMONIC csMnemonic }
3775 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3776 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3777 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3778 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3779 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3780 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3781 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3782 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3783 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3784 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3785 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3786 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3787 { IBM1047 IBM-1047 }
3788 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3789 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3790 { UNICODE-1-1 csUnicode11 }
3793 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3794 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3796 { ISO-8859-15 ISO_8859-15 Latin-9 }
3797 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3798 { GBK CP936 MS936 windows-936 }
3799 { JIS_Encoding csJISEncoding }
3800 { Shift_JIS MS_Kanji csShiftJIS }
3801 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3803 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3804 { ISO-10646-UCS-Basic csUnicodeASCII }
3805 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3806 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3807 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3808 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3809 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3810 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3811 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3812 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3813 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3814 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3815 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3816 { Ventura-US csVenturaUS }
3817 { Ventura-International csVenturaInternational }
3818 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3819 { PC8-Turkish csPC8Turkish }
3820 { IBM-Symbols csIBMSymbols }
3821 { IBM-Thai csIBMThai }
3822 { HP-Legal csHPLegal }
3823 { HP-Pi-font csHPPiFont }
3824 { HP-Math8 csHPMath8 }
3825 { Adobe-Symbol-Encoding csHPPSMath }
3826 { HP-DeskTop csHPDesktop }
3827 { Ventura-Math csVenturaMath }
3828 { Microsoft-Publishing csMicrosoftPublishing }
3829 { Windows-31J csWindows31J }
3834 proc tcl_encoding {enc} {
3835 global encoding_aliases
3836 set names [encoding names]
3837 set lcnames [string tolower $names]
3838 set enc [string tolower $enc]
3839 set i [lsearch -exact $lcnames $enc]
3841 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3842 if {[regsub {^iso[-_]} $enc iso encx]} {
3843 set i [lsearch -exact $lcnames $encx]
3847 foreach l $encoding_aliases {
3848 set ll [string tolower $l]
3849 if {[lsearch -exact $ll $enc] < 0} continue
3850 # look through the aliases for one that tcl knows about
3852 set i [lsearch -exact $lcnames $e]
3854 if {[regsub {^iso[-_]} $e iso ex]} {
3855 set i [lsearch -exact $lcnames $ex]
3864 return [lindex $names $i]
3871 set diffopts "-U 5 -p"
3872 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3876 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3878 if {$gitencoding == ""} {
3879 set gitencoding "utf-8"
3881 set tclencoding [tcl_encoding $gitencoding]
3882 if {$tclencoding == {}} {
3883 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3886 set mainfont {Helvetica 9}
3887 set textfont {Courier 9}
3888 set findmergefiles 0
3897 set colors {green red blue magenta darkgrey brown orange}
3899 catch {source ~/.gitk}
3901 set namefont $mainfont
3903 font create optionfont -family sans-serif -size -12
3907 switch -regexp -- $arg {
3909 "^-d" { set datemode 1 }
3911 lappend revtreeargs $arg
3916 # check that we can find a .git directory somewhere...
3918 if {![file isdirectory $gitdir]} {
3919 error_popup "Cannot find the git directory \"$gitdir\"."
3932 makewindow $revtreeargs
3934 getcommits $revtreeargs