2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc parse_args
{rargs
} {
20 global parsed_args cmdline_files
25 set args
[concat
--default HEAD
$rargs]
26 set args
[split [eval exec git-rev-parse
$args] "\n"]
29 if {![regexp
{^
[0-9a-f]{40}$
} $arg]} {
33 set cmdline_files
[lrange
$args $i end
]
36 lappend parsed_args
$arg
40 # if git-rev-parse failed for some reason...
41 set i
[lsearch
-exact $rargs "--"]
43 set cmdline_files
[lrange
$rargs [expr {$i+1}] end
]
44 set rargs
[lrange
$rargs 0 [expr {$i-1}]]
49 set parsed_args
$rargs
54 proc start_rev_list
{rlargs
} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs
[clock clicks
-milliseconds]
59 set nextupdate
[expr {$startmsecs + 100}]
62 set order
"--topo-order"
64 set order
"--date-order"
67 set commfd
[open
[concat | git-rev-list
--header $order \
68 --parents --boundary $rlargs] r
]
70 puts stderr
"Error executing git-rev-list: $err"
74 fconfigure
$commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure
$commfd -encoding $tclencoding
78 fileevent
$commfd readable
[list getcommitlines
$commfd]
79 . config
-cursor watch
83 proc getcommits
{rargs
} {
84 global phase canv mainfont
89 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
90 -font $mainfont -tags textitems
93 proc getcommitlines
{commfd
} {
94 global commitlisted nextupdate
96 global displayorder commitidx commitrow commitdata
97 global parentlist childlist children
99 set stuff
[read $commfd]
101 if {![eof
$commfd]} return
102 # set it blocking so we wait for the process to terminate
103 fconfigure
$commfd -blocking 1
104 if {![catch
{close
$commfd} err
]} {
105 after idle finishcommits
108 if {[string range
$err 0 4] == "usage"} {
110 "Gitk: error reading commits: bad arguments to git-rev-list.\
111 (Note: arguments to gitk are passed to git-rev-list\
112 to allow selection of commits to be displayed.)"
114 set err
"Error reading commits: $err"
122 set i
[string first
"\0" $stuff $start]
124 append leftover
[string range
$stuff $start end
]
129 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
132 set cmit
[string range
$stuff $start [expr {$i - 1}]]
134 set start
[expr {$i + 1}]
135 set j
[string first
"\n" $cmit]
139 set ids
[string range
$cmit 0 [expr {$j - 1}]]
140 if {[string range
$ids 0 0] == "-"} {
142 set ids
[string range
$ids 1 end
]
146 if {[string length
$id] != 40} {
154 if {[string length
$shortcmit] > 80} {
155 set shortcmit
"[string range $shortcmit 0 80]..."
157 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
160 set id
[lindex
$ids 0]
162 set olds
[lrange
$ids 1 end
]
165 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
166 lappend children
($p) $id
173 lappend parentlist
$olds
174 if {[info exists children
($id)]} {
175 lappend childlist
$children($id)
179 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
180 set commitrow
($id) $commitidx
182 lappend displayorder
$id
183 lappend commitlisted
$listed
189 if {[clock clicks
-milliseconds] >= $nextupdate} {
194 proc doupdate
{reading
} {
195 global commfd nextupdate numcommits ncmupdate
198 fileevent
$commfd readable
{}
201 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
202 if {$numcommits < 100} {
203 set ncmupdate
[expr {$numcommits + 1}]
204 } elseif
{$numcommits < 10000} {
205 set ncmupdate
[expr {$numcommits + 10}]
207 set ncmupdate
[expr {$numcommits + 100}]
210 fileevent
$commfd readable
[list getcommitlines
$commfd]
214 proc readcommit
{id
} {
215 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
216 parsecommit
$id $contents 0
219 proc updatecommits
{} {
220 global viewdata curview revtreeargs
224 catch
{unset viewdata
($n)}
225 parse_args
$revtreeargs
229 proc parsecommit
{id contents listed
} {
230 global commitinfo cdate
239 set hdrend
[string first
"\n\n" $contents]
241 # should never happen...
242 set hdrend
[string length
$contents]
244 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
245 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
246 foreach line
[split $header "\n"] {
247 set tag
[lindex
$line 0]
248 if {$tag == "author"} {
249 set audate
[lindex
$line end-1
]
250 set auname
[lrange
$line 1 end-2
]
251 } elseif
{$tag == "committer"} {
252 set comdate
[lindex
$line end-1
]
253 set comname
[lrange
$line 1 end-2
]
257 # take the first line of the comment as the headline
258 set i
[string first
"\n" $comment]
260 set headline
[string trim
[string range
$comment 0 $i]]
262 set headline
$comment
265 # git-rev-list indents the comment by 4 spaces;
266 # if we got this via git-cat-file, add the indentation
268 foreach line
[split $comment "\n"] {
269 append newcomment
" "
270 append newcomment
$line
271 append newcomment
"\n"
273 set comment
$newcomment
275 if {$comdate != {}} {
276 set cdate
($id) $comdate
278 set commitinfo
($id) [list
$headline $auname $audate \
279 $comname $comdate $comment]
282 proc getcommit
{id
} {
283 global commitdata commitinfo
285 if {[info exists commitdata
($id)]} {
286 parsecommit
$id $commitdata($id) 1
289 if {![info exists commitinfo
($id)]} {
290 set commitinfo
($id) {"No commit information available"}
297 global tagids idtags headids idheads tagcontents
298 global otherrefids idotherrefs
300 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
303 set refd
[open
[list | git-ls-remote
[gitdir
]] r
]
304 while {0 <= [set n
[gets
$refd line
]]} {
305 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
309 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
313 if {$type == "tags"} {
314 set tagids
($name) $id
315 lappend idtags
($id) $name
320 set commit
[exec git-rev-parse
"$id^0"]
321 if {"$commit" != "$id"} {
322 set tagids
($name) $commit
323 lappend idtags
($commit) $name
327 set tagcontents
($name) [exec git-cat-file tag
"$id"]
329 } elseif
{ $type == "heads" } {
330 set headids
($name) $id
331 lappend idheads
($id) $name
333 set otherrefids
($name) $id
334 lappend idotherrefs
($id) $name
340 proc error_popup msg
{
344 message
$w.m
-text $msg -justify center
-aspect 400
345 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
346 button
$w.ok
-text OK
-command "destroy $w"
347 pack
$w.ok
-side bottom
-fill x
348 bind $w <Visibility
> "grab $w; focus $w"
349 bind $w <Key-Return
> "destroy $w"
354 global canv canv2 canv3 linespc charspc ctext cflist textfont
355 global findtype findtypemenu findloc findstring fstring geometry
356 global entries sha1entry sha1string sha1but
357 global maincursor textcursor curtextcursor
358 global rowctxmenu mergemax
361 .bar add cascade
-label "File" -menu .bar.
file
363 .bar.
file add
command -label "Update" -command updatecommits
364 .bar.
file add
command -label "Reread references" -command rereadrefs
365 .bar.
file add
command -label "Quit" -command doquit
367 .bar add cascade
-label "Edit" -menu .bar.edit
368 .bar.edit add
command -label "Preferences" -command doprefs
370 .bar add cascade
-label "View" -menu .bar.view
371 .bar.view add
command -label "New view..." -command newview
372 .bar.view add
command -label "Delete view" -command delview
-state disabled
373 .bar.view add separator
374 .bar.view add
command -label "All files" -command {showview
0}
376 .bar add cascade
-label "Help" -menu .bar.
help
377 .bar.
help add
command -label "About gitk" -command about
378 . configure
-menu .bar
380 if {![info exists geometry
(canv1
)]} {
381 set geometry
(canv1
) [expr {45 * $charspc}]
382 set geometry
(canv2
) [expr {30 * $charspc}]
383 set geometry
(canv3
) [expr {15 * $charspc}]
384 set geometry
(canvh
) [expr {25 * $linespc + 4}]
385 set geometry
(ctextw
) 80
386 set geometry
(ctexth
) 30
387 set geometry
(cflistw
) 30
389 panedwindow .ctop
-orient vertical
390 if {[info exists geometry
(width
)]} {
391 .ctop conf
-width $geometry(width
) -height $geometry(height
)
392 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
393 set geometry
(ctexth
) [expr {($texth - 8) /
394 [font metrics
$textfont -linespace]}]
398 pack .ctop.top.bar
-side bottom
-fill x
399 set cscroll .ctop.top.csb
400 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
401 pack
$cscroll -side right
-fill y
402 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
403 pack .ctop.top.clist
-side top
-fill both
-expand 1
405 set canv .ctop.top.clist.canv
406 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
408 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
409 .ctop.top.clist add
$canv
410 set canv2 .ctop.top.clist.canv2
411 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
412 -bg white
-bd 0 -yscrollincr $linespc
413 .ctop.top.clist add
$canv2
414 set canv3 .ctop.top.clist.canv3
415 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
416 -bg white
-bd 0 -yscrollincr $linespc
417 .ctop.top.clist add
$canv3
418 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
420 set sha1entry .ctop.top.bar.sha1
421 set entries
$sha1entry
422 set sha1but .ctop.top.bar.sha1label
423 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
424 -command gotocommit
-width 8
425 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
426 pack .ctop.top.bar.sha1label
-side left
427 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
428 trace add variable sha1string
write sha1change
429 pack
$sha1entry -side left
-pady 2
431 image create bitmap bm-left
-data {
432 #define left_width 16
433 #define left_height 16
434 static unsigned char left_bits
[] = {
435 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
436 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
437 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
439 image create bitmap bm-right
-data {
440 #define right_width 16
441 #define right_height 16
442 static unsigned char right_bits
[] = {
443 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
444 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
445 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
447 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
448 -state disabled
-width 26
449 pack .ctop.top.bar.leftbut
-side left
-fill y
450 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
451 -state disabled
-width 26
452 pack .ctop.top.bar.rightbut
-side left
-fill y
454 button .ctop.top.bar.findbut
-text "Find" -command dofind
455 pack .ctop.top.bar.findbut
-side left
457 set fstring .ctop.top.bar.findstring
458 lappend entries
$fstring
459 entry
$fstring -width 30 -font $textfont -textvariable findstring
460 pack
$fstring -side left
-expand 1 -fill x
462 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
463 findtype Exact IgnCase Regexp
]
464 set findloc
"All fields"
465 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
466 Comments Author Committer Files Pickaxe
467 pack .ctop.top.bar.findloc
-side right
468 pack .ctop.top.bar.findtype
-side right
469 # for making sure type==Exact whenever loc==Pickaxe
470 trace add variable findloc
write findlocchange
472 panedwindow .ctop.cdet
-orient horizontal
474 frame .ctop.cdet.left
475 set ctext .ctop.cdet.left.ctext
476 text
$ctext -bg white
-state disabled
-font $textfont \
477 -width $geometry(ctextw
) -height $geometry(ctexth
) \
478 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
479 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
480 pack .ctop.cdet.left.sb
-side right
-fill y
481 pack
$ctext -side left
-fill both
-expand 1
482 .ctop.cdet add .ctop.cdet.left
484 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
485 $ctext tag conf hunksep
-fore blue
486 $ctext tag conf d0
-fore red
487 $ctext tag conf d1
-fore "#00a000"
488 $ctext tag conf m0
-fore red
489 $ctext tag conf m1
-fore blue
490 $ctext tag conf m2
-fore green
491 $ctext tag conf m3
-fore purple
492 $ctext tag conf
m4 -fore brown
493 $ctext tag conf m5
-fore "#009090"
494 $ctext tag conf m6
-fore magenta
495 $ctext tag conf m7
-fore "#808000"
496 $ctext tag conf m8
-fore "#009000"
497 $ctext tag conf m9
-fore "#ff0080"
498 $ctext tag conf m10
-fore cyan
499 $ctext tag conf m11
-fore "#b07070"
500 $ctext tag conf m12
-fore "#70b0f0"
501 $ctext tag conf m13
-fore "#70f0b0"
502 $ctext tag conf m14
-fore "#f0b070"
503 $ctext tag conf m15
-fore "#ff70b0"
504 $ctext tag conf mmax
-fore darkgrey
506 $ctext tag conf mresult
-font [concat
$textfont bold
]
507 $ctext tag conf msep
-font [concat
$textfont bold
]
508 $ctext tag conf found
-back yellow
510 frame .ctop.cdet.right
511 set cflist .ctop.cdet.right.cfiles
512 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
513 -yscrollcommand ".ctop.cdet.right.sb set"
514 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
515 pack .ctop.cdet.right.sb
-side right
-fill y
516 pack
$cflist -side left
-fill both
-expand 1
517 .ctop.cdet add .ctop.cdet.right
518 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
520 pack .ctop
-side top
-fill both
-expand 1
522 bindall
<1> {selcanvline
%W
%x
%y
}
523 #bindall <B1-Motion> {selcanvline %W %x %y}
524 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
525 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
526 bindall
<2> "canvscan mark %W %x %y"
527 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
528 bind .
<Key-Up
> "selnextline -1"
529 bind .
<Key-Down
> "selnextline 1"
530 bind .
<Key-Right
> "goforw"
531 bind .
<Key-Left
> "goback"
532 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
533 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
534 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
535 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
536 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
537 bindkey p
"selnextline -1"
538 bindkey n
"selnextline 1"
541 bindkey i
"selnextline -1"
542 bindkey k
"selnextline 1"
545 bindkey b
"$ctext yview scroll -1 pages"
546 bindkey d
"$ctext yview scroll 18 units"
547 bindkey u
"$ctext yview scroll -18 units"
548 bindkey
/ {findnext
1}
549 bindkey
<Key-Return
> {findnext
0}
552 bind .
<Control-q
> doquit
553 bind .
<Control-f
> dofind
554 bind .
<Control-g
> {findnext
0}
555 bind .
<Control-r
> findprev
556 bind .
<Control-equal
> {incrfont
1}
557 bind .
<Control-KP_Add
> {incrfont
1}
558 bind .
<Control-minus
> {incrfont
-1}
559 bind .
<Control-KP_Subtract
> {incrfont
-1}
560 bind $cflist <<ListboxSelect>> listboxsel
561 bind . <Destroy> {savestuff %W}
562 bind . <Button-1> "click %W"
563 bind $fstring <Key-Return> dofind
564 bind $sha1entry <Key-Return> gotocommit
565 bind $sha1entry <<PasteSelection>> clearsha1
567 set maincursor [. cget -cursor]
568 set textcursor [$ctext cget -cursor]
569 set curtextcursor $textcursor
571 set rowctxmenu .rowctxmenu
572 menu $rowctxmenu -tearoff 0
573 $rowctxmenu add command -label "Diff this -> selected" \
574 -command {diffvssel 0}
575 $rowctxmenu add command -label "Diff selected -> this" \
576 -command {diffvssel 1}
577 $rowctxmenu add command -label "Make patch" -command mkpatch
578 $rowctxmenu add command -label "Create tag" -command mktag
579 $rowctxmenu add command -label "Write commit to file" -command writecommit
582 # mouse-2 makes all windows scan vertically, but only the one
583 # the cursor is in scans horizontally
584 proc canvscan {op w x y} {
585 global canv canv2 canv3
586 foreach c [list $canv $canv2 $canv3] {
595 proc scrollcanv {cscroll f0 f1} {
600 # when we make a key binding for the toplevel, make sure
601 # it doesn't get triggered when that key is pressed in the
602 # find string entry widget.
603 proc bindkey {ev script} {
606 set escript [bind Entry $ev]
607 if {$escript == {}} {
608 set escript [bind Entry <Key>]
611 bind $e $ev "$escript; break"
615 # set the focus back to the toplevel for any click outside
626 global canv canv2 canv3 ctext cflist mainfont textfont
627 global stuffsaved findmergefiles maxgraphpct
630 if {$stuffsaved} return
631 if {![winfo viewable .]} return
633 set f [open "~/.gitk-new" w]
634 puts $f [list set mainfont $mainfont]
635 puts $f [list set textfont $textfont]
636 puts $f [list set findmergefiles $findmergefiles]
637 puts $f [list set maxgraphpct $maxgraphpct]
638 puts $f [list set maxwidth $maxwidth]
639 puts $f "set geometry(width) [winfo width .ctop]"
640 puts $f "set geometry(height) [winfo height .ctop]"
641 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
642 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
643 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
644 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
645 set wid [expr {([winfo width $ctext] - 8) \
646 / [font measure $textfont "0"]}]
647 puts $f "set geometry(ctextw) $wid"
648 set wid [expr {([winfo width $cflist] - 11) \
649 / [font measure [$cflist cget -font] "0"]}]
650 puts $f "set geometry(cflistw) $wid"
652 file rename -force "~/.gitk-new" "~/.gitk"
657 proc resizeclistpanes {win w} {
659 if {[info exists oldwidth($win)]} {
660 set s0 [$win sash coord 0]
661 set s1 [$win sash coord 1]
663 set sash0 [expr {int($w/2 - 2)}]
664 set sash1 [expr {int($w*5/6 - 2)}]
666 set factor [expr {1.0 * $w / $oldwidth($win)}]
667 set sash0 [expr {int($factor * [lindex $s0 0])}]
668 set sash1 [expr {int($factor * [lindex $s1 0])}]
672 if {$sash1 < $sash0 + 20} {
673 set sash1 [expr {$sash0 + 20}]
675 if {$sash1 > $w - 10} {
676 set sash1 [expr {$w - 10}]
677 if {$sash0 > $sash1 - 20} {
678 set sash0 [expr {$sash1 - 20}]
682 $win sash place 0 $sash0 [lindex $s0 1]
683 $win sash place 1 $sash1 [lindex $s1 1]
685 set oldwidth($win) $w
688 proc resizecdetpanes {win w} {
690 if {[info exists oldwidth($win)]} {
691 set s0 [$win sash coord 0]
693 set sash0 [expr {int($w*3/4 - 2)}]
695 set factor [expr {1.0 * $w / $oldwidth($win)}]
696 set sash0 [expr {int($factor * [lindex $s0 0])}]
700 if {$sash0 > $w - 15} {
701 set sash0 [expr {$w - 15}]
704 $win sash place 0 $sash0 [lindex $s0 1]
706 set oldwidth($win) $w
710 global canv canv2 canv3
716 proc bindall {event action} {
717 global canv canv2 canv3
718 bind $canv $event $action
719 bind $canv2 $event $action
720 bind $canv3 $event $action
725 if {[winfo exists $w]} {
730 wm title $w "About gitk"
732 Gitk - a commit viewer for git
734 Copyright © 2005-2006 Paul Mackerras
736 Use and redistribute under the terms of the GNU General Public License} \
737 -justify center -aspect 400
738 pack $w.m -side top -fill x -padx 20 -pady 20
739 button $w.ok -text Close -command "destroy $w"
740 pack $w.ok -side bottom
744 global newviewname nextviewnum newviewtop
747 if {[winfo exists $top]} {
753 wm title $top "Gitk view definition"
754 label $top.nl -text "Name"
755 entry $top.name -width 20 -textvariable newviewname
756 set newviewname "View $nextviewnum"
757 grid $top.nl $top.name -sticky w
758 label $top.l -text "Files and directories to include:"
759 grid $top.l - -sticky w -pady 10
760 text $top.t -width 30 -height 10
761 grid $top.t - -sticky w
763 button $top.buts.ok -text "OK" -command newviewok
764 button $top.buts.can -text "Cancel" -command newviewcan
765 grid $top.buts.ok $top.buts.can
766 grid columnconfigure $top.buts 0 -weight 1 -uniform a
767 grid columnconfigure $top.buts 1 -weight 1 -uniform a
768 grid $top.buts - -pady 10 -sticky ew
773 global newviewtop nextviewnum
774 global viewname viewfiles
778 set viewname($n) [$newviewtop.name get]
780 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
781 set ft [string trim $f]
786 set viewfiles($n) $files
787 catch {destroy $newviewtop}
789 .bar.view add command -label $viewname($n) -command [list showview $n]
790 after idle showview $n
796 catch {destroy $newviewtop}
801 global curview viewdata
803 if {$curview == 0} return
804 set nmenu [.bar.view index end]
805 set targetcmd [list showview $curview]
806 for {set i 5} {$i <= $nmenu} {incr i} {
807 if {[.bar.view entrycget $i -command] eq $targetcmd} {
812 set viewdata($curview) {}
817 global curview viewdata viewfiles
818 global displayorder parentlist childlist rowidlist rowoffsets
819 global colormap rowtextx commitrow
820 global numcommits rowrangelist commitlisted idrowranges
821 global selectedline currentid canv canvy0
822 global matchinglines treediffs
824 global pending_select phase
826 if {$n == $curview} return
828 if {[info exists selectedline]} {
830 set y [yc $selectedline]
831 set ymax [lindex [$canv cget -scrollregion] 3]
832 set span [$canv yview]
833 set ytop [expr {[lindex $span 0] * $ymax}]
834 set ybot [expr {[lindex $span 1] * $ymax}]
835 if {$ytop < $y && $y < $ybot} {
836 set yscreen [expr {$y - $ytop}]
838 set yscreen [expr {($ybot - $ytop) / 2}]
843 if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
844 set viewdata($curview) \
845 [list $displayorder $parentlist $childlist $rowidlist \
846 $rowoffsets $rowrangelist $commitlisted]
848 catch {unset matchinglines}
849 catch {unset treediffs}
854 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
856 if {![info exists viewdata($n)]} {
857 set args $parsed_args
858 if {$viewfiles($n) ne {}} {
859 set args [concat $args "--" $viewfiles($n)]
861 set pending_select $selid
866 set displayorder [lindex $viewdata($n) 0]
867 set parentlist [lindex $viewdata($n) 1]
868 set childlist [lindex $viewdata($n) 2]
869 set rowidlist [lindex $viewdata($n) 3]
870 set rowoffsets [lindex $viewdata($n) 4]
871 set rowrangelist [lindex $viewdata($n) 5]
872 set commitlisted [lindex $viewdata($n) 6]
873 set numcommits [llength $displayorder]
874 catch {unset colormap}
875 catch {unset rowtextx}
876 catch {unset commitrow}
877 catch {unset idrowranges}
880 foreach id $displayorder {
881 set commitrow($id) $row
887 if {$selid ne {} && [info exists commitrow($selid)]} {
888 set row $commitrow($selid)
889 # try to get the selected row in the same position on the screen
890 set ymax [lindex [$canv cget -scrollregion] 3]
891 set ytop [expr {[yc $row] - $yscreen}]
895 set yf [expr {$ytop * 1.0 / $ymax}]
897 allcanvs yview moveto $yf
902 proc shortids {ids} {
905 if {[llength $id] > 1} {
906 lappend res [shortids $id]
907 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
908 lappend res [string range $id 0 7]
916 proc incrange {l x o} {
921 lset l $x [expr {$e + $o}]
930 for {} {$n > 0} {incr n -1} {
936 proc usedinrange {id l1 l2} {
937 global children commitrow
939 if {[info exists commitrow($id)]} {
940 set r $commitrow($id)
941 if {$l1 <= $r && $r <= $l2} {
942 return [expr {$r - $l1 + 1}]
945 foreach c $children($id) {
946 if {[info exists commitrow($c)]} {
948 if {$l1 <= $r && $r <= $l2} {
949 return [expr {$r - $l1 + 1}]
956 proc sanity {row {full 0}} {
957 global rowidlist rowoffsets
960 set ids [lindex $rowidlist $row]
963 if {$id eq {}} continue
964 if {$col < [llength $ids] - 1 &&
965 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
966 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
968 set o [lindex $rowoffsets $row $col]
974 if {[lindex $rowidlist $y $x] != $id} {
975 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
976 puts " id=[shortids $id] check started at row $row"
977 for {set i $row} {$i >= $y} {incr i -1} {
978 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
983 set o [lindex $rowoffsets $y $x]
988 proc makeuparrow {oid x y z} {
989 global rowidlist rowoffsets uparrowlen idrowranges
991 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
994 set off0 [lindex $rowoffsets $y]
995 for {set x0 $x} {1} {incr x0} {
996 if {$x0 >= [llength $off0]} {
997 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1000 set z [lindex $off0 $x0]
1006 set z [expr {$x0 - $x}]
1007 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1008 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1010 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1011 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1012 lappend idrowranges($oid) $y
1015 proc initlayout {} {
1016 global rowidlist rowoffsets displayorder commitlisted
1017 global rowlaidout rowoptim
1018 global idinlist rowchk rowrangelist idrowranges
1019 global commitidx numcommits canvxmax canv
1021 global parentlist childlist children
1022 global colormap rowtextx commitrow
1032 catch {unset children}
1036 catch {unset idinlist}
1037 catch {unset rowchk}
1040 set canvxmax [$canv cget -width]
1041 catch {unset colormap}
1042 catch {unset rowtextx}
1043 catch {unset commitrow}
1044 catch {unset idrowranges}
1045 catch {unset linesegends}
1048 proc setcanvscroll {} {
1049 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1051 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1052 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1053 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1054 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1057 proc visiblerows {} {
1058 global canv numcommits linespc
1060 set ymax [lindex [$canv cget -scrollregion] 3]
1061 if {$ymax eq {} || $ymax == 0} return
1063 set y0 [expr {int([lindex $f 0] * $ymax)}]
1064 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1068 set y1 [expr {int([lindex $f 1] * $ymax)}]
1069 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1070 if {$r1 >= $numcommits} {
1071 set r1 [expr {$numcommits - 1}]
1073 return [list $r0 $r1]
1076 proc layoutmore {} {
1077 global rowlaidout rowoptim commitidx numcommits optim_delay
1081 set rowlaidout [layoutrows $row $commitidx 0]
1082 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1083 if {$orow > $rowoptim} {
1084 optimize_rows $rowoptim 0 $orow
1087 set canshow [expr {$rowoptim - $optim_delay}]
1088 if {$canshow > $numcommits} {
1093 proc showstuff {canshow} {
1094 global numcommits commitrow pending_select
1095 global linesegends idrowranges idrangedrawn
1097 if {$numcommits == 0} {
1099 set phase "incrdraw"
1103 set numcommits $canshow
1105 set rows [visiblerows]
1106 set r0 [lindex $rows 0]
1107 set r1 [lindex $rows 1]
1109 for {set r $row} {$r < $canshow} {incr r} {
1110 if {[info exists linesegends($r)]} {
1111 foreach id $linesegends($r) {
1113 foreach {s e} $idrowranges($id) {
1115 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1116 && ![info exists idrangedrawn($id,$i)]} {
1118 set idrangedrawn($id,$i) 1
1124 if {$canshow > $r1} {
1127 while {$row < $canshow} {
1131 if {[info exists pending_select] &&
1132 [info exists commitrow($pending_select)] &&
1133 $commitrow($pending_select) < $numcommits} {
1134 selectline $commitrow($pending_select) 1
1138 proc layoutrows {row endrow last} {
1139 global rowidlist rowoffsets displayorder
1140 global uparrowlen downarrowlen maxwidth mingaplen
1141 global childlist parentlist
1142 global idrowranges linesegends
1144 global idinlist rowchk rowrangelist
1146 set idlist [lindex $rowidlist $row]
1147 set offs [lindex $rowoffsets $row]
1148 while {$row < $endrow} {
1149 set id [lindex $displayorder $row]
1152 foreach p [lindex $parentlist $row] {
1153 if {![info exists idinlist($p)]} {
1155 } elseif {!$idinlist($p)} {
1159 set nev [expr {[llength $idlist] + [llength $newolds]
1160 + [llength $oldolds] - $maxwidth + 1}]
1162 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1163 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1164 set i [lindex $idlist $x]
1165 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1166 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1167 [expr {$row + $uparrowlen + $mingaplen}]]
1169 set idlist [lreplace $idlist $x $x]
1170 set offs [lreplace $offs $x $x]
1171 set offs [incrange $offs $x 1]
1173 set rm1 [expr {$row - 1}]
1174 lappend linesegends($rm1) $i
1175 lappend idrowranges($i) $rm1
1176 if {[incr nev -1] <= 0} break
1179 set rowchk($id) [expr {$row + $r}]
1182 lset rowidlist $row $idlist
1183 lset rowoffsets $row $offs
1185 set col [lsearch -exact $idlist $id]
1187 set col [llength $idlist]
1189 lset rowidlist $row $idlist
1191 if {[lindex $childlist $row] ne {}} {
1192 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1196 lset rowoffsets $row $offs
1198 makeuparrow $id $col $row $z
1204 if {[info exists idrowranges($id)]} {
1205 lappend idrowranges($id) $row
1206 set ranges $idrowranges($id)
1208 lappend rowrangelist $ranges
1210 set offs [ntimes [llength $idlist] 0]
1211 set l [llength $newolds]
1212 set idlist [eval lreplace \$idlist $col $col $newolds]
1215 set offs [lrange $offs 0 [expr {$col - 1}]]
1216 foreach x $newolds {
1221 set tmp [expr {[llength $idlist] - [llength $offs]}]
1223 set offs [concat $offs [ntimes $tmp $o]]
1228 foreach i $newolds {
1230 set idrowranges($i) $row
1233 foreach oid $oldolds {
1234 set idinlist($oid) 1
1235 set idlist [linsert $idlist $col $oid]
1236 set offs [linsert $offs $col $o]
1237 makeuparrow $oid $col $row $o
1240 lappend rowidlist $idlist
1241 lappend rowoffsets $offs
1246 proc addextraid {id row} {
1247 global displayorder commitrow commitinfo
1249 global parentlist childlist children
1252 lappend displayorder $id
1253 lappend parentlist {}
1254 set commitrow($id) $row
1256 if {![info exists commitinfo($id)]} {
1257 set commitinfo($id) {"No commit information available"}
1259 if {[info exists children($id)]} {
1260 lappend childlist $children($id)
1262 lappend childlist {}
1266 proc layouttail {} {
1267 global rowidlist rowoffsets idinlist commitidx
1268 global idrowranges rowrangelist
1271 set idlist [lindex $rowidlist $row]
1272 while {$idlist ne {}} {
1273 set col [expr {[llength $idlist] - 1}]
1274 set id [lindex $idlist $col]
1277 lappend idrowranges($id) $row
1278 lappend rowrangelist $idrowranges($id)
1280 set offs [ntimes $col 0]
1281 set idlist [lreplace $idlist $col $col]
1282 lappend rowidlist $idlist
1283 lappend rowoffsets $offs
1286 foreach id [array names idinlist] {
1288 lset rowidlist $row [list $id]
1289 lset rowoffsets $row 0
1290 makeuparrow $id 0 $row 0
1291 lappend idrowranges($id) $row
1292 lappend rowrangelist $idrowranges($id)
1294 lappend rowidlist {}
1295 lappend rowoffsets {}
1299 proc insert_pad {row col npad} {
1300 global rowidlist rowoffsets
1302 set pad [ntimes $npad {}]
1303 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1304 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1305 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1308 proc optimize_rows {row col endrow} {
1309 global rowidlist rowoffsets idrowranges displayorder
1311 for {} {$row < $endrow} {incr row} {
1312 set idlist [lindex $rowidlist $row]
1313 set offs [lindex $rowoffsets $row]
1315 for {} {$col < [llength $offs]} {incr col} {
1316 if {[lindex $idlist $col] eq {}} {
1320 set z [lindex $offs $col]
1321 if {$z eq {}} continue
1323 set x0 [expr {$col + $z}]
1324 set y0 [expr {$row - 1}]
1325 set z0 [lindex $rowoffsets $y0 $x0]
1327 set id [lindex $idlist $col]
1328 if {[info exists idrowranges($id)] &&
1329 $y0 > [lindex $idrowranges($id) 0]} {
1333 if {$z < -1 || ($z < 0 && $isarrow)} {
1334 set npad [expr {-1 - $z + $isarrow}]
1335 set offs [incrange $offs $col $npad]
1336 insert_pad $y0 $x0 $npad
1338 optimize_rows $y0 $x0 $row
1340 set z [lindex $offs $col]
1341 set x0 [expr {$col + $z}]
1342 set z0 [lindex $rowoffsets $y0 $x0]
1343 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1344 set npad [expr {$z - 1 + $isarrow}]
1345 set y1 [expr {$row + 1}]
1346 set offs2 [lindex $rowoffsets $y1]
1350 if {$z eq {} || $x1 + $z < $col} continue
1351 if {$x1 + $z > $col} {
1354 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1357 set pad [ntimes $npad {}]
1358 set idlist [eval linsert \$idlist $col $pad]
1359 set tmp [eval linsert \$offs $col $pad]
1361 set offs [incrange $tmp $col [expr {-$npad}]]
1362 set z [lindex $offs $col]
1365 if {$z0 eq {} && !$isarrow} {
1366 # this line links to its first child on row $row-2
1367 set rm2 [expr {$row - 2}]
1368 set id [lindex $displayorder $rm2]
1369 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1371 set z0 [expr {$xc - $x0}]
1374 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1375 insert_pad $y0 $x0 1
1376 set offs [incrange $offs $col 1]
1377 optimize_rows $y0 [expr {$x0 + 1}] $row
1382 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1383 set o [lindex $offs $col]
1385 # check if this is the link to the first child
1386 set id [lindex $idlist $col]
1387 if {[info exists idrowranges($id)] &&
1388 $row == [lindex $idrowranges($id) 0]} {
1389 # it is, work out offset to child
1390 set y0 [expr {$row - 1}]
1391 set id [lindex $displayorder $y0]
1392 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1394 set o [expr {$x0 - $col}]
1398 if {$o eq {} || $o <= 0} break
1400 if {$o ne {} && [incr col] < [llength $idlist]} {
1401 set y1 [expr {$row + 1}]
1402 set offs2 [lindex $rowoffsets $y1]
1406 if {$z eq {} || $x1 + $z < $col} continue
1407 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1410 set idlist [linsert $idlist $col {}]
1411 set tmp [linsert $offs $col {}]
1413 set offs [incrange $tmp $col -1]
1416 lset rowidlist $row $idlist
1417 lset rowoffsets $row $offs
1423 global canvx0 linespc
1424 return [expr {$canvx0 + $col * $linespc}]
1428 global canvy0 linespc
1429 return [expr {$canvy0 + $row * $linespc}]
1432 proc linewidth {id} {
1433 global thickerline lthickness
1436 if {[info exists thickerline] && $id eq $thickerline} {
1437 set wid [expr {2 * $lthickness}]
1442 proc rowranges {id} {
1443 global idrowranges commitrow numcommits rowrangelist
1446 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1447 set ranges [lindex $rowrangelist $commitrow($id)]
1448 } elseif {[info exists idrowranges($id)]} {
1449 set ranges $idrowranges($id)
1454 proc drawlineseg {id i} {
1455 global rowoffsets rowidlist
1457 global canv colormap linespc
1458 global numcommits commitrow
1460 set ranges [rowranges $id]
1462 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1463 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1467 set startrow [lindex $ranges [expr {2 * $i}]]
1468 set row [lindex $ranges [expr {2 * $i + 1}]]
1469 if {$startrow == $row} return
1472 set col [lsearch -exact [lindex $rowidlist $row] $id]
1474 puts "oops: drawline: id $id not on row $row"
1480 set o [lindex $rowoffsets $row $col]
1483 # changing direction
1484 set x [xc $row $col]
1486 lappend coords $x $y
1492 set x [xc $row $col]
1494 lappend coords $x $y
1496 # draw the link to the first child as part of this line
1498 set child [lindex $displayorder $row]
1499 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1501 set x [xc $row $ccol]
1503 if {$ccol < $col - 1} {
1504 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1505 } elseif {$ccol > $col + 1} {
1506 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1508 lappend coords $x $y
1511 if {[llength $coords] < 4} return
1513 # This line has an arrow at the lower end: check if the arrow is
1514 # on a diagonal segment, and if so, work around the Tk 8.4
1515 # refusal to draw arrows on diagonal lines.
1516 set x0 [lindex $coords 0]
1517 set x1 [lindex $coords 2]
1519 set y0 [lindex $coords 1]
1520 set y1 [lindex $coords 3]
1521 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1522 # we have a nearby vertical segment, just trim off the diag bit
1523 set coords [lrange $coords 2 end]
1525 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1526 set xi [expr {$x0 - $slope * $linespc / 2}]
1527 set yi [expr {$y0 - $linespc / 2}]
1528 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1532 set arrow [expr {2 * ($i > 0) + $downarrow}]
1533 set arrow [lindex {none first last both} $arrow]
1534 set t [$canv create line $coords -width [linewidth $id] \
1535 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1540 proc drawparentlinks {id row col olds} {
1541 global rowidlist canv colormap
1543 set row2 [expr {$row + 1}]
1544 set x [xc $row $col]
1547 set ids [lindex $rowidlist $row2]
1548 # rmx = right-most X coord used
1551 set i [lsearch -exact $ids $p]
1553 puts "oops, parent $p of $id not in list"
1556 set x2 [xc $row2 $i]
1560 set ranges [rowranges $p]
1561 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1562 && $row2 < [lindex $ranges 1]} {
1563 # drawlineseg will do this one for us
1567 # should handle duplicated parents here...
1568 set coords [list $x $y]
1569 if {$i < $col - 1} {
1570 lappend coords [xc $row [expr {$i + 1}]] $y
1571 } elseif {$i > $col + 1} {
1572 lappend coords [xc $row [expr {$i - 1}]] $y
1574 lappend coords $x2 $y2
1575 set t [$canv create line $coords -width [linewidth $p] \
1576 -fill $colormap($p) -tags lines.$p]
1583 proc drawlines {id} {
1584 global colormap canv
1586 global childlist iddrawn commitrow rowidlist
1588 $canv delete lines.$id
1589 set nr [expr {[llength [rowranges $id]] / 2}]
1590 for {set i 0} {$i < $nr} {incr i} {
1591 if {[info exists idrangedrawn($id,$i)]} {
1595 foreach child [lindex $childlist $commitrow($id)] {
1596 if {[info exists iddrawn($child)]} {
1597 set row $commitrow($child)
1598 set col [lsearch -exact [lindex $rowidlist $row] $child]
1600 drawparentlinks $child $row $col [list $id]
1606 proc drawcmittext {id row col rmx} {
1607 global linespc canv canv2 canv3 canvy0
1608 global commitlisted commitinfo rowidlist
1609 global rowtextx idpos idtags idheads idotherrefs
1610 global linehtag linentag linedtag
1611 global mainfont namefont canvxmax
1613 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1614 set x [xc $row $col]
1616 set orad [expr {$linespc / 3}]
1617 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1618 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1619 -fill $ofill -outline black -width 1]
1621 $canv bind $t <1> {selcanvline {} %x %y}
1622 set xt [xc $row [llength [lindex $rowidlist $row]]]
1626 set rowtextx($row) $xt
1627 set idpos($id) [list $x $xt $y]
1628 if {[info exists idtags($id)] || [info exists idheads($id)]
1629 || [info exists idotherrefs($id)]} {
1630 set xt [drawtags $id $x $xt $y]
1632 set headline [lindex $commitinfo($id) 0]
1633 set name [lindex $commitinfo($id) 1]
1634 set date [lindex $commitinfo($id) 2]
1635 set date [formatdate $date]
1636 set linehtag($row) [$canv create text $xt $y -anchor w \
1637 -text $headline -font $mainfont ]
1638 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1639 set linentag($row) [$canv2 create text 3 $y -anchor w \
1640 -text $name -font $namefont]
1641 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1642 -text $date -font $mainfont]
1643 set xr [expr {$xt + [font measure $mainfont $headline]}]
1644 if {$xr > $canvxmax} {
1650 proc drawcmitrow {row} {
1651 global displayorder rowidlist
1652 global idrangedrawn iddrawn
1653 global commitinfo commitlisted parentlist numcommits
1655 if {$row >= $numcommits} return
1656 foreach id [lindex $rowidlist $row] {
1658 foreach {s e} [rowranges $id] {
1660 if {$row < $s} continue
1663 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1665 set idrangedrawn($id,$i) 1
1672 set id [lindex $displayorder $row]
1673 if {[info exists iddrawn($id)]} return
1674 set col [lsearch -exact [lindex $rowidlist $row] $id]
1676 puts "oops, row $row id $id not in list"
1679 if {![info exists commitinfo($id)]} {
1683 set olds [lindex $parentlist $row]
1685 set rmx [drawparentlinks $id $row $col $olds]
1689 drawcmittext $id $row $col $rmx
1693 proc drawfrac {f0 f1} {
1694 global numcommits canv
1697 set ymax [lindex [$canv cget -scrollregion] 3]
1698 if {$ymax eq {} || $ymax == 0} return
1699 set y0 [expr {int($f0 * $ymax)}]
1700 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1704 set y1 [expr {int($f1 * $ymax)}]
1705 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1706 if {$endrow >= $numcommits} {
1707 set endrow [expr {$numcommits - 1}]
1709 for {} {$row <= $endrow} {incr row} {
1714 proc drawvisible {} {
1716 eval drawfrac [$canv yview]
1719 proc clear_display {} {
1720 global iddrawn idrangedrawn
1723 catch {unset iddrawn}
1724 catch {unset idrangedrawn}
1727 proc findcrossings {id} {
1728 global rowidlist parentlist numcommits rowoffsets displayorder
1732 foreach {s e} [rowranges $id] {
1733 if {$e >= $numcommits} {
1734 set e [expr {$numcommits - 1}]
1736 if {$e <= $s} continue
1737 set x [lsearch -exact [lindex $rowidlist $e] $id]
1739 puts "findcrossings: oops, no [shortids $id] in row $e"
1742 for {set row $e} {[incr row -1] >= $s} {} {
1743 set olds [lindex $parentlist $row]
1744 set kid [lindex $displayorder $row]
1745 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1746 if {$kidx < 0} continue
1747 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1749 set px [lsearch -exact $nextrow $p]
1750 if {$px < 0} continue
1751 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1752 if {[lsearch -exact $ccross $p] >= 0} continue
1753 if {$x == $px + ($kidx < $px? -1: 1)} {
1755 } elseif {[lsearch -exact $cross $p] < 0} {
1760 set inc [lindex $rowoffsets $row $x]
1761 if {$inc eq {}} break
1765 return [concat $ccross {{}} $cross]
1768 proc assigncolor {id} {
1769 global colormap colors nextcolor
1770 global commitrow parentlist children childlist
1772 if {[info exists colormap($id)]} return
1773 set ncolors [llength $colors]
1774 if {[info exists commitrow($id)]} {
1775 set kids [lindex $childlist $commitrow($id)]
1776 } elseif {[info exists children($id)]} {
1777 set kids $children($id)
1781 if {[llength $kids] == 1} {
1782 set child [lindex $kids 0]
1783 if {[info exists colormap($child)]
1784 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1785 set colormap($id) $colormap($child)
1791 foreach x [findcrossings $id] {
1793 # delimiter between corner crossings and other crossings
1794 if {[llength $badcolors] >= $ncolors - 1} break
1795 set origbad $badcolors
1797 if {[info exists colormap($x)]
1798 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1799 lappend badcolors $colormap($x)
1802 if {[llength $badcolors] >= $ncolors} {
1803 set badcolors $origbad
1805 set origbad $badcolors
1806 if {[llength $badcolors] < $ncolors - 1} {
1807 foreach child $kids {
1808 if {[info exists colormap($child)]
1809 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1810 lappend badcolors $colormap($child)
1812 foreach p [lindex $parentlist $commitrow($child)] {
1813 if {[info exists colormap($p)]
1814 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1815 lappend badcolors $colormap($p)
1819 if {[llength $badcolors] >= $ncolors} {
1820 set badcolors $origbad
1823 for {set i 0} {$i <= $ncolors} {incr i} {
1824 set c [lindex $colors $nextcolor]
1825 if {[incr nextcolor] >= $ncolors} {
1828 if {[lsearch -exact $badcolors $c]} break
1830 set colormap($id) $c
1833 proc bindline {t id} {
1836 $canv bind $t <Enter> "lineenter %x %y $id"
1837 $canv bind $t <Motion> "linemotion %x %y $id"
1838 $canv bind $t <Leave> "lineleave $id"
1839 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1842 proc drawtags {id x xt y1} {
1843 global idtags idheads idotherrefs
1844 global linespc lthickness
1845 global canv mainfont commitrow rowtextx
1850 if {[info exists idtags($id)]} {
1851 set marks $idtags($id)
1852 set ntags [llength $marks]
1854 if {[info exists idheads($id)]} {
1855 set marks [concat $marks $idheads($id)]
1856 set nheads [llength $idheads($id)]
1858 if {[info exists idotherrefs($id)]} {
1859 set marks [concat $marks $idotherrefs($id)]
1865 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1866 set yt [expr {$y1 - 0.5 * $linespc}]
1867 set yb [expr {$yt + $linespc - 1}]
1870 foreach tag $marks {
1871 set wid [font measure $mainfont $tag]
1874 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1876 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1877 -width $lthickness -fill black -tags tag.$id]
1879 foreach tag $marks x $xvals wid $wvals {
1880 set xl [expr {$x + $delta}]
1881 set xr [expr {$x + $delta + $wid + $lthickness}]
1882 if {[incr ntags -1] >= 0} {
1884 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1885 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1886 -width 1 -outline black -fill yellow -tags tag.$id]
1887 $canv bind $t <1> [list showtag $tag 1]
1888 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1890 # draw a head or other ref
1891 if {[incr nheads -1] >= 0} {
1896 set xl [expr {$xl - $delta/2}]
1897 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1898 -width 1 -outline black -fill $col -tags tag.$id
1900 set t [$canv create text $xl $y1 -anchor w -text $tag \
1901 -font $mainfont -tags tag.$id]
1903 $canv bind $t <1> [list showtag $tag 1]
1909 proc xcoord {i level ln} {
1910 global canvx0 xspc1 xspc2
1912 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1913 if {$i > 0 && $i == $level} {
1914 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1915 } elseif {$i > $level} {
1916 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1921 proc finishcommits {} {
1922 global commitidx phase
1923 global canv mainfont ctext maincursor textcursor
1924 global findinprogress
1926 if {$commitidx > 0} {
1930 $canv create text 3 3 -anchor nw -text "No commits selected" \
1931 -font $mainfont -tags textitems
1933 if {![info exists findinprogress]} {
1934 . config -cursor $maincursor
1935 settextcursor $textcursor
1940 # Don't change the text pane cursor if it is currently the hand cursor,
1941 # showing that we are over a sha1 ID link.
1942 proc settextcursor {c} {
1943 global ctext curtextcursor
1945 if {[$ctext cget -cursor] == $curtextcursor} {
1946 $ctext config -cursor $c
1948 set curtextcursor $c
1954 global canvy0 numcommits linespc
1955 global rowlaidout commitidx
1958 layoutrows $rowlaidout $commitidx 1
1960 optimize_rows $row 0 $commitidx
1961 showstuff $commitidx
1963 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1964 #puts "overall $drawmsecs ms for $numcommits commits"
1967 proc findmatches {f} {
1968 global findtype foundstring foundstrlen
1969 if {$findtype == "Regexp"} {
1970 set matches [regexp -indices -all -inline $foundstring $f]
1972 if {$findtype == "IgnCase"} {
1973 set str [string tolower $f]
1979 while {[set j [string first $foundstring $str $i]] >= 0} {
1980 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1981 set i [expr {$j + $foundstrlen}]
1988 global findtype findloc findstring markedmatches commitinfo
1989 global numcommits displayorder linehtag linentag linedtag
1990 global mainfont namefont canv canv2 canv3 selectedline
1991 global matchinglines foundstring foundstrlen matchstring
1997 set matchinglines {}
1998 if {$findloc == "Pickaxe"} {
2002 if {$findtype == "IgnCase"} {
2003 set foundstring [string tolower $findstring]
2005 set foundstring $findstring
2007 set foundstrlen [string length $findstring]
2008 if {$foundstrlen == 0} return
2009 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2010 set matchstring "*$matchstring*"
2011 if {$findloc == "Files"} {
2015 if {![info exists selectedline]} {
2018 set oldsel $selectedline
2021 set fldtypes {Headline Author Date Committer CDate Comment}
2023 foreach id $displayorder {
2024 set d $commitdata($id)
2026 if {$findtype == "Regexp"} {
2027 set doesmatch [regexp $foundstring $d]
2028 } elseif {$findtype == "IgnCase"} {
2029 set doesmatch [string match -nocase $matchstring $d]
2031 set doesmatch [string match $matchstring $d]
2033 if {!$doesmatch} continue
2034 if {![info exists commitinfo($id)]} {
2037 set info $commitinfo($id)
2039 foreach f $info ty $fldtypes {
2040 if {$findloc != "All fields" && $findloc != $ty} {
2043 set matches [findmatches $f]
2044 if {$matches == {}} continue
2046 if {$ty == "Headline"} {
2048 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2049 } elseif {$ty == "Author"} {
2051 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2052 } elseif {$ty == "Date"} {
2054 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2058 lappend matchinglines $l
2059 if {!$didsel && $l > $oldsel} {
2065 if {$matchinglines == {}} {
2067 } elseif {!$didsel} {
2068 findselectline [lindex $matchinglines 0]
2072 proc findselectline {l} {
2073 global findloc commentend ctext
2075 if {$findloc == "All fields" || $findloc == "Comments"} {
2076 # highlight the matches in the comments
2077 set f [$ctext get 1.0 $commentend]
2078 set matches [findmatches $f]
2079 foreach match $matches {
2080 set start [lindex $match 0]
2081 set end [expr {[lindex $match 1] + 1}]
2082 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2087 proc findnext {restart} {
2088 global matchinglines selectedline
2089 if {![info exists matchinglines]} {
2095 if {![info exists selectedline]} return
2096 foreach l $matchinglines {
2097 if {$l > $selectedline} {
2106 global matchinglines selectedline
2107 if {![info exists matchinglines]} {
2111 if {![info exists selectedline]} return
2113 foreach l $matchinglines {
2114 if {$l >= $selectedline} break
2118 findselectline $prev
2124 proc findlocchange {name ix op} {
2125 global findloc findtype findtypemenu
2126 if {$findloc == "Pickaxe"} {
2132 $findtypemenu entryconf 1 -state $state
2133 $findtypemenu entryconf 2 -state $state
2136 proc stopfindproc {{done 0}} {
2137 global findprocpid findprocfile findids
2138 global ctext findoldcursor phase maincursor textcursor
2139 global findinprogress
2141 catch {unset findids}
2142 if {[info exists findprocpid]} {
2144 catch {exec kill $findprocpid}
2146 catch {close $findprocfile}
2149 if {[info exists findinprogress]} {
2150 unset findinprogress
2151 if {$phase != "incrdraw"} {
2152 . config -cursor $maincursor
2153 settextcursor $textcursor
2158 proc findpatches {} {
2159 global findstring selectedline numcommits
2160 global findprocpid findprocfile
2161 global finddidsel ctext displayorder findinprogress
2162 global findinsertpos
2164 if {$numcommits == 0} return
2166 # make a list of all the ids to search, starting at the one
2167 # after the selected line (if any)
2168 if {[info exists selectedline]} {
2174 for {set i 0} {$i < $numcommits} {incr i} {
2175 if {[incr l] >= $numcommits} {
2178 append inputids [lindex $displayorder $l] "\n"
2182 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2185 error_popup "Error starting search process: $err"
2189 set findinsertpos end
2191 set findprocpid [pid $f]
2192 fconfigure $f -blocking 0
2193 fileevent $f readable readfindproc
2195 . config -cursor watch
2197 set findinprogress 1
2200 proc readfindproc {} {
2201 global findprocfile finddidsel
2202 global commitrow matchinglines findinsertpos
2204 set n [gets $findprocfile line]
2206 if {[eof $findprocfile]} {
2214 if {![regexp {^[0-9a-f]{40}} $line id]} {
2215 error_popup "Can't parse git-diff-tree output: $line"
2219 if {![info exists commitrow($id)]} {
2220 puts stderr "spurious id: $id"
2223 set l $commitrow($id)
2227 proc insertmatch {l id} {
2228 global matchinglines findinsertpos finddidsel
2230 if {$findinsertpos == "end"} {
2231 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2232 set matchinglines [linsert $matchinglines 0 $l]
2235 lappend matchinglines $l
2238 set matchinglines [linsert $matchinglines $findinsertpos $l]
2249 global selectedline numcommits displayorder ctext
2250 global ffileline finddidsel parentlist
2251 global findinprogress findstartline findinsertpos
2252 global treediffs fdiffid fdiffsneeded fdiffpos
2253 global findmergefiles
2255 if {$numcommits == 0} return
2257 if {[info exists selectedline]} {
2258 set l [expr {$selectedline + 1}]
2263 set findstartline $l
2267 set id [lindex $displayorder $l]
2268 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2269 if {![info exists treediffs($id)]} {
2270 append diffsneeded "$id\n"
2271 lappend fdiffsneeded $id
2274 if {[incr l] >= $numcommits} {
2277 if {$l == $findstartline} break
2280 # start off a git-diff-tree process if needed
2281 if {$diffsneeded ne {}} {
2283 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2285 error_popup "Error starting search process: $err"
2288 catch {unset fdiffid}
2290 fconfigure $df -blocking 0
2291 fileevent $df readable [list readfilediffs $df]
2295 set findinsertpos end
2296 set id [lindex $displayorder $l]
2297 . config -cursor watch
2299 set findinprogress 1
2304 proc readfilediffs {df} {
2305 global findid fdiffid fdiffs
2307 set n [gets $df line]
2311 if {[catch {close $df} err]} {
2314 error_popup "Error in git-diff-tree: $err"
2315 } elseif {[info exists findid]} {
2319 error_popup "Couldn't find diffs for $id"
2324 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2325 # start of a new string of diffs
2329 } elseif {[string match ":*" $line]} {
2330 lappend fdiffs [lindex $line 5]
2334 proc donefilediff {} {
2335 global fdiffid fdiffs treediffs findid
2336 global fdiffsneeded fdiffpos
2338 if {[info exists fdiffid]} {
2339 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2340 && $fdiffpos < [llength $fdiffsneeded]} {
2341 # git-diff-tree doesn't output anything for a commit
2342 # which doesn't change anything
2343 set nullid [lindex $fdiffsneeded $fdiffpos]
2344 set treediffs($nullid) {}
2345 if {[info exists findid] && $nullid eq $findid} {
2353 if {![info exists treediffs($fdiffid)]} {
2354 set treediffs($fdiffid) $fdiffs
2356 if {[info exists findid] && $fdiffid eq $findid} {
2364 global findid treediffs parentlist
2365 global ffileline findstartline finddidsel
2366 global displayorder numcommits matchinglines findinprogress
2367 global findmergefiles
2371 set id [lindex $displayorder $l]
2372 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2373 if {![info exists treediffs($id)]} {
2379 foreach f $treediffs($id) {
2380 set x [findmatches $f]
2390 if {[incr l] >= $numcommits} {
2393 if {$l == $findstartline} break
2401 # mark a commit as matching by putting a yellow background
2402 # behind the headline
2403 proc markheadline {l id} {
2404 global canv mainfont linehtag
2407 set bbox [$canv bbox $linehtag($l)]
2408 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2412 # mark the bits of a headline, author or date that match a find string
2413 proc markmatches {canv l str tag matches font} {
2414 set bbox [$canv bbox $tag]
2415 set x0 [lindex $bbox 0]
2416 set y0 [lindex $bbox 1]
2417 set y1 [lindex $bbox 3]
2418 foreach match $matches {
2419 set start [lindex $match 0]
2420 set end [lindex $match 1]
2421 if {$start > $end} continue
2422 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2423 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2424 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2425 [expr {$x0+$xlen+2}] $y1 \
2426 -outline {} -tags matches -fill yellow]
2431 proc unmarkmatches {} {
2432 global matchinglines findids
2433 allcanvs delete matches
2434 catch {unset matchinglines}
2435 catch {unset findids}
2438 proc selcanvline {w x y} {
2439 global canv canvy0 ctext linespc
2441 set ymax [lindex [$canv cget -scrollregion] 3]
2442 if {$ymax == {}} return
2443 set yfrac [lindex [$canv yview] 0]
2444 set y [expr {$y + $yfrac * $ymax}]
2445 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2450 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2456 proc commit_descriptor {p} {
2459 if {[info exists commitinfo($p)]} {
2460 set l [lindex $commitinfo($p) 0]
2465 # append some text to the ctext widget, and make any SHA1 ID
2466 # that we know about be a clickable link.
2467 proc appendwithlinks {text} {
2468 global ctext commitrow linknum
2470 set start [$ctext index "end - 1c"]
2471 $ctext insert end $text
2472 $ctext insert end "\n"
2473 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2477 set linkid [string range $text $s $e]
2478 if {![info exists commitrow($linkid)]} continue
2480 $ctext tag add link "$start + $s c" "$start + $e c"
2481 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2482 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2485 $ctext tag conf link -foreground blue -underline 1
2486 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2487 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2490 proc selectline {l isnew} {
2491 global canv canv2 canv3 ctext commitinfo selectedline
2492 global displayorder linehtag linentag linedtag
2493 global canvy0 linespc parentlist childlist
2494 global cflist currentid sha1entry
2495 global commentend idtags linknum
2496 global mergemax numcommits pending_select
2498 catch {unset pending_select}
2501 if {$l < 0 || $l >= $numcommits} return
2502 set y [expr {$canvy0 + $l * $linespc}]
2503 set ymax [lindex [$canv cget -scrollregion] 3]
2504 set ytop [expr {$y - $linespc - 1}]
2505 set ybot [expr {$y + $linespc + 1}]
2506 set wnow [$canv yview]
2507 set wtop [expr {[lindex $wnow 0] * $ymax}]
2508 set wbot [expr {[lindex $wnow 1] * $ymax}]
2509 set wh [expr {$wbot - $wtop}]
2511 if {$ytop < $wtop} {
2512 if {$ybot < $wtop} {
2513 set newtop [expr {$y - $wh / 2.0}]
2516 if {$newtop > $wtop - $linespc} {
2517 set newtop [expr {$wtop - $linespc}]
2520 } elseif {$ybot > $wbot} {
2521 if {$ytop > $wbot} {
2522 set newtop [expr {$y - $wh / 2.0}]
2524 set newtop [expr {$ybot - $wh}]
2525 if {$newtop < $wtop + $linespc} {
2526 set newtop [expr {$wtop + $linespc}]
2530 if {$newtop != $wtop} {
2534 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2538 if {![info exists linehtag($l)]} return
2540 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2541 -tags secsel -fill [$canv cget -selectbackground]]
2543 $canv2 delete secsel
2544 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2545 -tags secsel -fill [$canv2 cget -selectbackground]]
2547 $canv3 delete secsel
2548 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2549 -tags secsel -fill [$canv3 cget -selectbackground]]
2553 addtohistory [list selectline $l 0]
2558 set id [lindex $displayorder $l]
2560 $sha1entry delete 0 end
2561 $sha1entry insert 0 $id
2562 $sha1entry selection from 0
2563 $sha1entry selection to end
2565 $ctext conf -state normal
2566 $ctext delete 0.0 end
2568 $ctext mark set fmark.0 0.0
2569 $ctext mark gravity fmark.0 left
2570 set info $commitinfo($id)
2571 set date [formatdate [lindex $info 2]]
2572 $ctext insert end "Author: [lindex $info 1] $date\n"
2573 set date [formatdate [lindex $info 4]]
2574 $ctext insert end "Committer: [lindex $info 3] $date\n"
2575 if {[info exists idtags($id)]} {
2576 $ctext insert end "Tags:"
2577 foreach tag $idtags($id) {
2578 $ctext insert end " $tag"
2580 $ctext insert end "\n"
2584 set olds [lindex $parentlist $l]
2585 if {[llength $olds] > 1} {
2588 if {$np >= $mergemax} {
2593 $ctext insert end "Parent: " $tag
2594 appendwithlinks [commit_descriptor $p]
2599 append comment "Parent: [commit_descriptor $p]\n"
2603 foreach c [lindex $childlist $l] {
2604 append comment "Child: [commit_descriptor $c]\n"
2607 append comment [lindex $info 5]
2609 # make anything that looks like a SHA1 ID be a clickable link
2610 appendwithlinks $comment
2612 $ctext tag delete Comments
2613 $ctext tag remove found 1.0 end
2614 $ctext conf -state disabled
2615 set commentend [$ctext index "end - 1c"]
2617 $cflist delete 0 end
2618 $cflist insert end "Comments"
2619 if {[llength $olds] <= 1} {
2626 proc selnextline {dir} {
2628 if {![info exists selectedline]} return
2629 set l [expr {$selectedline + $dir}]
2634 proc unselectline {} {
2635 global selectedline currentid
2637 catch {unset selectedline}
2638 catch {unset currentid}
2639 allcanvs delete secsel
2642 proc addtohistory {cmd} {
2643 global history historyindex
2645 if {$historyindex > 0
2646 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2650 if {$historyindex < [llength $history]} {
2651 set history [lreplace $history $historyindex end $cmd]
2653 lappend history $cmd
2656 if {$historyindex > 1} {
2657 .ctop.top.bar.leftbut conf -state normal
2659 .ctop.top.bar.leftbut conf -state disabled
2661 .ctop.top.bar.rightbut conf -state disabled
2665 global history historyindex
2667 if {$historyindex > 1} {
2668 incr historyindex -1
2669 set cmd [lindex $history [expr {$historyindex - 1}]]
2671 .ctop.top.bar.rightbut conf -state normal
2673 if {$historyindex <= 1} {
2674 .ctop.top.bar.leftbut conf -state disabled
2679 global history historyindex
2681 if {$historyindex < [llength $history]} {
2682 set cmd [lindex $history $historyindex]
2685 .ctop.top.bar.leftbut conf -state normal
2687 if {$historyindex >= [llength $history]} {
2688 .ctop.top.bar.rightbut conf -state disabled
2692 proc mergediff {id l} {
2693 global diffmergeid diffopts mdifffd
2694 global difffilestart diffids
2699 catch {unset difffilestart}
2700 # this doesn't seem to actually affect anything...
2701 set env(GIT_DIFF_OPTS) $diffopts
2702 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2703 if {[catch {set mdf [open $cmd r]} err]} {
2704 error_popup "Error getting merge diffs: $err"
2707 fconfigure $mdf -blocking 0
2708 set mdifffd($id) $mdf
2709 set np [llength [lindex $parentlist $l]]
2710 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2711 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2714 proc getmergediffline {mdf id np} {
2715 global diffmergeid ctext cflist nextupdate mergemax
2716 global difffilestart mdifffd
2718 set n [gets $mdf line]
2725 if {![info exists diffmergeid] || $id != $diffmergeid
2726 || $mdf != $mdifffd($id)} {
2729 $ctext conf -state normal
2730 if {[regexp {^diff --cc (.*)} $line match fname]} {
2731 # start of a new file
2732 $ctext insert end "\n"
2733 set here [$ctext index "end - 1c"]
2734 set i [$cflist index end]
2735 $ctext mark set fmark.$i $here
2736 $ctext mark gravity fmark.$i left
2737 set difffilestart([expr {$i-1}]) $here
2738 $cflist insert end $fname
2739 set l [expr {(78 - [string length $fname]) / 2}]
2740 set pad [string range "----------------------------------------" 1 $l]
2741 $ctext insert end "$pad $fname $pad\n" filesep
2742 } elseif {[regexp {^@@} $line]} {
2743 $ctext insert end "$line\n" hunksep
2744 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2747 # parse the prefix - one ' ', '-' or '+' for each parent
2752 for {set j 0} {$j < $np} {incr j} {
2753 set c [string range $line $j $j]
2756 } elseif {$c == "-"} {
2758 } elseif {$c == "+"} {
2767 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2768 # line doesn't appear in result, parents in $minuses have the line
2769 set num [lindex $minuses 0]
2770 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2771 # line appears in result, parents in $pluses don't have the line
2772 lappend tags mresult
2773 set num [lindex $spaces 0]
2776 if {$num >= $mergemax} {
2781 $ctext insert end "$line\n" $tags
2783 $ctext conf -state disabled
2784 if {[clock clicks -milliseconds] >= $nextupdate} {
2786 fileevent $mdf readable {}
2788 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2792 proc startdiff {ids} {
2793 global treediffs diffids treepending diffmergeid
2796 catch {unset diffmergeid}
2797 if {![info exists treediffs($ids)]} {
2798 if {![info exists treepending]} {
2806 proc addtocflist {ids} {
2807 global treediffs cflist
2808 foreach f $treediffs($ids) {
2809 $cflist insert end $f
2814 proc gettreediffs {ids} {
2815 global treediff treepending
2816 set treepending $ids
2819 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2821 fconfigure $gdtf -blocking 0
2822 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2825 proc gettreediffline {gdtf ids} {
2826 global treediff treediffs treepending diffids diffmergeid
2828 set n [gets $gdtf line]
2830 if {![eof $gdtf]} return
2832 set treediffs($ids) $treediff
2834 if {$ids != $diffids} {
2835 if {![info exists diffmergeid]} {
2836 gettreediffs $diffids
2843 set file [lindex $line 5]
2844 lappend treediff $file
2847 proc getblobdiffs {ids} {
2848 global diffopts blobdifffd diffids env curdifftag curtagstart
2849 global difffilestart nextupdate diffinhdr treediffs
2851 set env(GIT_DIFF_OPTS) $diffopts
2852 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2853 if {[catch {set bdf [open $cmd r]} err]} {
2854 puts "error getting diffs: $err"
2858 fconfigure $bdf -blocking 0
2859 set blobdifffd($ids) $bdf
2860 set curdifftag Comments
2862 catch {unset difffilestart}
2863 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2864 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2867 proc getblobdiffline {bdf ids} {
2868 global diffids blobdifffd ctext curdifftag curtagstart
2869 global diffnexthead diffnextnote difffilestart
2870 global nextupdate diffinhdr treediffs
2872 set n [gets $bdf line]
2876 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2877 $ctext tag add $curdifftag $curtagstart end
2882 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2885 $ctext conf -state normal
2886 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2887 # start of a new file
2888 $ctext insert end "\n"
2889 $ctext tag add $curdifftag $curtagstart end
2890 set curtagstart [$ctext index "end - 1c"]
2892 set here [$ctext index "end - 1c"]
2893 set i [lsearch -exact $treediffs($diffids) $fname]
2895 set difffilestart($i) $here
2897 $ctext mark set fmark.$i $here
2898 $ctext mark gravity fmark.$i left
2900 if {$newname != $fname} {
2901 set i [lsearch -exact $treediffs($diffids) $newname]
2903 set difffilestart($i) $here
2905 $ctext mark set fmark.$i $here
2906 $ctext mark gravity fmark.$i left
2909 set curdifftag "f:$fname"
2910 $ctext tag delete $curdifftag
2911 set l [expr {(78 - [string length $header]) / 2}]
2912 set pad [string range "----------------------------------------" 1 $l]
2913 $ctext insert end "$pad $header $pad\n" filesep
2915 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2917 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2919 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2920 $line match f1l f1c f2l f2c rest]} {
2921 $ctext insert end "$line\n" hunksep
2924 set x [string range $line 0 0]
2925 if {$x == "-" || $x == "+"} {
2926 set tag [expr {$x == "+"}]
2927 $ctext insert end "$line\n" d$tag
2928 } elseif {$x == " "} {
2929 $ctext insert end "$line\n"
2930 } elseif {$diffinhdr || $x == "\\"} {
2931 # e.g. "\ No newline at end of file"
2932 $ctext insert end "$line\n" filesep
2934 # Something else we don't recognize
2935 if {$curdifftag != "Comments"} {
2936 $ctext insert end "\n"
2937 $ctext tag add $curdifftag $curtagstart end
2938 set curtagstart [$ctext index "end - 1c"]
2939 set curdifftag Comments
2941 $ctext insert end "$line\n" filesep
2944 $ctext conf -state disabled
2945 if {[clock clicks -milliseconds] >= $nextupdate} {
2947 fileevent $bdf readable {}
2949 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2954 global difffilestart ctext
2955 set here [$ctext index @0,0]
2956 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2957 if {[$ctext compare $difffilestart($i) > $here]} {
2958 if {![info exists pos]
2959 || [$ctext compare $difffilestart($i) < $pos]} {
2960 set pos $difffilestart($i)
2964 if {[info exists pos]} {
2969 proc listboxsel {} {
2970 global ctext cflist currentid
2971 if {![info exists currentid]} return
2972 set sel [lsort [$cflist curselection]]
2973 if {$sel eq {}} return
2974 set first [lindex $sel 0]
2975 catch {$ctext yview fmark.$first}
2979 global linespc charspc canvx0 canvy0 mainfont
2980 global xspc1 xspc2 lthickness
2982 set linespc [font metrics $mainfont -linespace]
2983 set charspc [font measure $mainfont "m"]
2984 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2985 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2986 set lthickness [expr {int($linespc / 9) + 1}]
2987 set xspc1(0) $linespc
2995 set ymax [lindex [$canv cget -scrollregion] 3]
2996 if {$ymax eq {} || $ymax == 0} return
2997 set span [$canv yview]
3000 allcanvs yview moveto [lindex $span 0]
3002 if {[info exists selectedline]} {
3003 selectline $selectedline 0
3007 proc incrfont {inc} {
3008 global mainfont namefont textfont ctext canv phase
3009 global stopped entries
3011 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3012 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3013 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3015 $ctext conf -font $textfont
3016 $ctext tag conf filesep -font [concat $textfont bold]
3017 foreach e $entries {
3018 $e conf -font $mainfont
3020 if {$phase == "getcommits"} {
3021 $canv itemconf textitems -font $mainfont
3027 global sha1entry sha1string
3028 if {[string length $sha1string] == 40} {
3029 $sha1entry delete 0 end
3033 proc sha1change {n1 n2 op} {
3034 global sha1string currentid sha1but
3035 if {$sha1string == {}
3036 || ([info exists currentid] && $sha1string == $currentid)} {
3041 if {[$sha1but cget -state] == $state} return
3042 if {$state == "normal"} {
3043 $sha1but conf -state normal -relief raised -text "Goto: "
3045 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3049 proc gotocommit {} {
3050 global sha1string currentid commitrow tagids
3051 global displayorder numcommits
3053 if {$sha1string == {}
3054 || ([info exists currentid] && $sha1string == $currentid)} return
3055 if {[info exists tagids($sha1string)]} {
3056 set id $tagids($sha1string)
3058 set id [string tolower $sha1string]
3059 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3061 foreach i $displayorder {
3062 if {[string match $id* $i]} {
3066 if {$matches ne {}} {
3067 if {[llength $matches] > 1} {
3068 error_popup "Short SHA1 id $id is ambiguous"
3071 set id [lindex $matches 0]
3075 if {[info exists commitrow($id)]} {
3076 selectline $commitrow($id) 1
3079 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3084 error_popup "$type $sha1string is not known"
3087 proc lineenter {x y id} {
3088 global hoverx hovery hoverid hovertimer
3089 global commitinfo canv
3091 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3095 if {[info exists hovertimer]} {
3096 after cancel $hovertimer
3098 set hovertimer [after 500 linehover]
3102 proc linemotion {x y id} {
3103 global hoverx hovery hoverid hovertimer
3105 if {[info exists hoverid] && $id == $hoverid} {
3108 if {[info exists hovertimer]} {
3109 after cancel $hovertimer
3111 set hovertimer [after 500 linehover]
3115 proc lineleave {id} {
3116 global hoverid hovertimer canv
3118 if {[info exists hoverid] && $id == $hoverid} {
3120 if {[info exists hovertimer]} {
3121 after cancel $hovertimer
3129 global hoverx hovery hoverid hovertimer
3130 global canv linespc lthickness
3131 global commitinfo mainfont
3133 set text [lindex $commitinfo($hoverid) 0]
3134 set ymax [lindex [$canv cget -scrollregion] 3]
3135 if {$ymax == {}} return
3136 set yfrac [lindex [$canv yview] 0]
3137 set x [expr {$hoverx + 2 * $linespc}]
3138 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3139 set x0 [expr {$x - 2 * $lthickness}]
3140 set y0 [expr {$y - 2 * $lthickness}]
3141 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3142 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3143 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3144 -fill \#ffff80 -outline black -width 1 -tags hover]
3146 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3150 proc clickisonarrow {id y} {
3153 set ranges [rowranges $id]
3154 set thresh [expr {2 * $lthickness + 6}]
3155 set n [expr {[llength $ranges] - 1}]
3156 for {set i 1} {$i < $n} {incr i} {
3157 set row [lindex $ranges $i]
3158 if {abs([yc $row] - $y) < $thresh} {
3165 proc arrowjump {id n y} {
3168 # 1 <-> 2, 3 <-> 4, etc...
3169 set n [expr {(($n - 1) ^ 1) + 1}]
3170 set row [lindex [rowranges $id] $n]
3172 set ymax [lindex [$canv cget -scrollregion] 3]
3173 if {$ymax eq {} || $ymax <= 0} return
3174 set view [$canv yview]
3175 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3176 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3180 allcanvs yview moveto $yfrac
3183 proc lineclick {x y id isnew} {
3184 global ctext commitinfo childlist commitrow cflist canv thickerline
3186 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3191 # draw this line thicker than normal
3195 set ymax [lindex [$canv cget -scrollregion] 3]
3196 if {$ymax eq {}} return
3197 set yfrac [lindex [$canv yview] 0]
3198 set y [expr {$y + $yfrac * $ymax}]
3200 set dirn [clickisonarrow $id $y]
3202 arrowjump $id $dirn $y
3207 addtohistory [list lineclick $x $y $id 0]
3209 # fill the details pane with info about this line
3210 $ctext conf -state normal
3211 $ctext delete 0.0 end
3212 $ctext tag conf link -foreground blue -underline 1
3213 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3214 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3215 $ctext insert end "Parent:\t"
3216 $ctext insert end $id [list link link0]
3217 $ctext tag bind link0 <1> [list selbyid $id]
3218 set info $commitinfo($id)
3219 $ctext insert end "\n\t[lindex $info 0]\n"
3220 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3221 set date [formatdate [lindex $info 2]]
3222 $ctext insert end "\tDate:\t$date\n"
3223 set kids [lindex $childlist $commitrow($id)]
3225 $ctext insert end "\nChildren:"
3227 foreach child $kids {
3229 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3230 set info $commitinfo($child)
3231 $ctext insert end "\n\t"
3232 $ctext insert end $child [list link link$i]
3233 $ctext tag bind link$i <1> [list selbyid $child]
3234 $ctext insert end "\n\t[lindex $info 0]"
3235 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3236 set date [formatdate [lindex $info 2]]
3237 $ctext insert end "\n\tDate:\t$date\n"
3240 $ctext conf -state disabled
3242 $cflist delete 0 end
3245 proc normalline {} {
3247 if {[info exists thickerline]} {
3256 if {[info exists commitrow($id)]} {
3257 selectline $commitrow($id) 1
3263 if {![info exists startmstime]} {
3264 set startmstime [clock clicks -milliseconds]
3266 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3269 proc rowmenu {x y id} {
3270 global rowctxmenu commitrow selectedline rowmenuid
3272 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3277 $rowctxmenu entryconfigure 0 -state $state
3278 $rowctxmenu entryconfigure 1 -state $state
3279 $rowctxmenu entryconfigure 2 -state $state
3281 tk_popup $rowctxmenu $x $y
3284 proc diffvssel {dirn} {
3285 global rowmenuid selectedline displayorder
3287 if {![info exists selectedline]} return
3289 set oldid [lindex $displayorder $selectedline]
3290 set newid $rowmenuid
3292 set oldid $rowmenuid
3293 set newid [lindex $displayorder $selectedline]
3295 addtohistory [list doseldiff $oldid $newid]
3296 doseldiff $oldid $newid
3299 proc doseldiff {oldid newid} {
3303 $ctext conf -state normal
3304 $ctext delete 0.0 end
3305 $ctext mark set fmark.0 0.0
3306 $ctext mark gravity fmark.0 left
3307 $cflist delete 0 end
3308 $cflist insert end "Top"
3309 $ctext insert end "From "
3310 $ctext tag conf link -foreground blue -underline 1
3311 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3312 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3313 $ctext tag bind link0 <1> [list selbyid $oldid]
3314 $ctext insert end $oldid [list link link0]
3315 $ctext insert end "\n "
3316 $ctext insert end [lindex $commitinfo($oldid) 0]
3317 $ctext insert end "\n\nTo "
3318 $ctext tag bind link1 <1> [list selbyid $newid]
3319 $ctext insert end $newid [list link link1]
3320 $ctext insert end "\n "
3321 $ctext insert end [lindex $commitinfo($newid) 0]
3322 $ctext insert end "\n"
3323 $ctext conf -state disabled
3324 $ctext tag delete Comments
3325 $ctext tag remove found 1.0 end
3326 startdiff [list $oldid $newid]
3330 global rowmenuid currentid commitinfo patchtop patchnum
3332 if {![info exists currentid]} return
3333 set oldid $currentid
3334 set oldhead [lindex $commitinfo($oldid) 0]
3335 set newid $rowmenuid
3336 set newhead [lindex $commitinfo($newid) 0]
3339 catch {destroy $top}
3341 label $top.title -text "Generate patch"
3342 grid $top.title - -pady 10
3343 label $top.from -text "From:"
3344 entry $top.fromsha1 -width 40 -relief flat
3345 $top.fromsha1 insert 0 $oldid
3346 $top.fromsha1 conf -state readonly
3347 grid $top.from $top.fromsha1 -sticky w
3348 entry $top.fromhead -width 60 -relief flat
3349 $top.fromhead insert 0 $oldhead
3350 $top.fromhead conf -state readonly
3351 grid x $top.fromhead -sticky w
3352 label $top.to -text "To:"
3353 entry $top.tosha1 -width 40 -relief flat
3354 $top.tosha1 insert 0 $newid
3355 $top.tosha1 conf -state readonly
3356 grid $top.to $top.tosha1 -sticky w
3357 entry $top.tohead -width 60 -relief flat
3358 $top.tohead insert 0 $newhead
3359 $top.tohead conf -state readonly
3360 grid x $top.tohead -sticky w
3361 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3362 grid $top.rev x -pady 10
3363 label $top.flab -text "Output file:"
3364 entry $top.fname -width 60
3365 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3367 grid $top.flab $top.fname -sticky w
3369 button $top.buts.gen -text "Generate" -command mkpatchgo
3370 button $top.buts.can -text "Cancel" -command mkpatchcan
3371 grid $top.buts.gen $top.buts.can
3372 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3373 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3374 grid $top.buts - -pady 10 -sticky ew
3378 proc mkpatchrev {} {
3381 set oldid [$patchtop.fromsha1 get]
3382 set oldhead [$patchtop.fromhead get]
3383 set newid [$patchtop.tosha1 get]
3384 set newhead [$patchtop.tohead get]
3385 foreach e [list fromsha1 fromhead tosha1 tohead] \
3386 v [list $newid $newhead $oldid $oldhead] {
3387 $patchtop.$e conf -state normal
3388 $patchtop.$e delete 0 end
3389 $patchtop.$e insert 0 $v
3390 $patchtop.$e conf -state readonly
3397 set oldid [$patchtop.fromsha1 get]
3398 set newid [$patchtop.tosha1 get]
3399 set fname [$patchtop.fname get]
3400 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3401 error_popup "Error creating patch: $err"
3403 catch {destroy $patchtop}
3407 proc mkpatchcan {} {
3410 catch {destroy $patchtop}
3415 global rowmenuid mktagtop commitinfo
3419 catch {destroy $top}
3421 label $top.title -text "Create tag"
3422 grid $top.title - -pady 10
3423 label $top.id -text "ID:"
3424 entry $top.sha1 -width 40 -relief flat
3425 $top.sha1 insert 0 $rowmenuid
3426 $top.sha1 conf -state readonly
3427 grid $top.id $top.sha1 -sticky w
3428 entry $top.head -width 60 -relief flat
3429 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3430 $top.head conf -state readonly
3431 grid x $top.head -sticky w
3432 label $top.tlab -text "Tag name:"
3433 entry $top.tag -width 60
3434 grid $top.tlab $top.tag -sticky w
3436 button $top.buts.gen -text "Create" -command mktaggo
3437 button $top.buts.can -text "Cancel" -command mktagcan
3438 grid $top.buts.gen $top.buts.can
3439 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3440 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3441 grid $top.buts - -pady 10 -sticky ew
3446 global mktagtop env tagids idtags
3448 set id [$mktagtop.sha1 get]
3449 set tag [$mktagtop.tag get]
3451 error_popup "No tag name specified"
3454 if {[info exists tagids($tag)]} {
3455 error_popup "Tag \"$tag\" already exists"
3460 set fname [file join $dir "refs/tags" $tag]
3461 set f [open $fname w]
3465 error_popup "Error creating tag: $err"
3469 set tagids($tag) $id
3470 lappend idtags($id) $tag
3474 proc redrawtags {id} {
3475 global canv linehtag commitrow idpos selectedline
3477 if {![info exists commitrow($id)]} return
3478 drawcmitrow $commitrow($id)
3479 $canv delete tag.$id
3480 set xt [eval drawtags $id $idpos($id)]
3481 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3482 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3483 selectline $selectedline 0
3490 catch {destroy $mktagtop}
3499 proc writecommit {} {
3500 global rowmenuid wrcomtop commitinfo wrcomcmd
3502 set top .writecommit
3504 catch {destroy $top}
3506 label $top.title -text "Write commit to file"
3507 grid $top.title - -pady 10
3508 label $top.id -text "ID:"
3509 entry $top.sha1 -width 40 -relief flat
3510 $top.sha1 insert 0 $rowmenuid
3511 $top.sha1 conf -state readonly
3512 grid $top.id $top.sha1 -sticky w
3513 entry $top.head -width 60 -relief flat
3514 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3515 $top.head conf -state readonly
3516 grid x $top.head -sticky w
3517 label $top.clab -text "Command:"
3518 entry $top.cmd -width 60 -textvariable wrcomcmd
3519 grid $top.clab $top.cmd -sticky w -pady 10
3520 label $top.flab -text "Output file:"
3521 entry $top.fname -width 60
3522 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3523 grid $top.flab $top.fname -sticky w
3525 button $top.buts.gen -text "Write" -command wrcomgo
3526 button $top.buts.can -text "Cancel" -command wrcomcan
3527 grid $top.buts.gen $top.buts.can
3528 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3529 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3530 grid $top.buts - -pady 10 -sticky ew
3537 set id [$wrcomtop.sha1 get]
3538 set cmd "echo $id | [$wrcomtop.cmd get]"
3539 set fname [$wrcomtop.fname get]
3540 if {[catch {exec sh -c $cmd >$fname &} err]} {
3541 error_popup "Error writing commit: $err"
3543 catch {destroy $wrcomtop}
3550 catch {destroy $wrcomtop}
3554 proc listrefs {id} {
3555 global idtags idheads idotherrefs
3558 if {[info exists idtags($id)]} {
3562 if {[info exists idheads($id)]} {
3566 if {[info exists idotherrefs($id)]} {
3567 set z $idotherrefs($id)
3569 return [list $x $y $z]
3572 proc rereadrefs {} {
3573 global idtags idheads idotherrefs
3574 global tagids headids otherrefids
3576 set refids [concat [array names idtags] \
3577 [array names idheads] [array names idotherrefs]]
3578 foreach id $refids {
3579 if {![info exists ref($id)]} {
3580 set ref($id) [listrefs $id]
3584 set refids [lsort -unique [concat $refids [array names idtags] \
3585 [array names idheads] [array names idotherrefs]]]
3586 foreach id $refids {
3587 set v [listrefs $id]
3588 if {![info exists ref($id)] || $ref($id) != $v} {
3594 proc showtag {tag isnew} {
3595 global ctext cflist tagcontents tagids linknum
3598 addtohistory [list showtag $tag 0]
3600 $ctext conf -state normal
3601 $ctext delete 0.0 end
3603 if {[info exists tagcontents($tag)]} {
3604 set text $tagcontents($tag)
3606 set text "Tag: $tag\nId: $tagids($tag)"
3608 appendwithlinks $text
3609 $ctext conf -state disabled
3610 $cflist delete 0 end
3620 global maxwidth maxgraphpct diffopts findmergefiles
3621 global oldprefs prefstop
3625 if {[winfo exists $top]} {
3629 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3630 set oldprefs($v) [set $v]
3633 wm title $top "Gitk preferences"
3634 label $top.ldisp -text "Commit list display options"
3635 grid $top.ldisp - -sticky w -pady 10
3636 label $top.spacer -text " "
3637 label $top.maxwidthl -text "Maximum graph width (lines)" \
3639 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3640 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3641 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3643 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3644 grid x $top.maxpctl $top.maxpct -sticky w
3645 checkbutton $top.findm -variable findmergefiles
3646 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3648 grid $top.findm $top.findml - -sticky w
3649 label $top.ddisp -text "Diff display options"
3650 grid $top.ddisp - -sticky w -pady 10
3651 label $top.diffoptl -text "Options for diff program" \
3653 entry $top.diffopt -width 20 -textvariable diffopts
3654 grid x $top.diffoptl $top.diffopt -sticky w
3656 button $top.buts.ok -text "OK" -command prefsok
3657 button $top.buts.can -text "Cancel" -command prefscan
3658 grid $top.buts.ok $top.buts.can
3659 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3660 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3661 grid $top.buts - - -pady 10 -sticky ew
3665 global maxwidth maxgraphpct diffopts findmergefiles
3666 global oldprefs prefstop
3668 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3669 set $v $oldprefs($v)
3671 catch {destroy $prefstop}
3676 global maxwidth maxgraphpct
3677 global oldprefs prefstop
3679 catch {destroy $prefstop}
3681 if {$maxwidth != $oldprefs(maxwidth)
3682 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3687 proc formatdate {d} {
3688 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3691 # This list of encoding names and aliases is distilled from
3692 # http://www.iana.org/assignments/character-sets.
3693 # Not all of them are supported by Tcl.
3694 set encoding_aliases {
3695 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3696 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3697 { ISO-10646-UTF-1 csISO10646UTF1 }
3698 { ISO_646.basic:1983 ref csISO646basic1983 }
3699 { INVARIANT csINVARIANT }
3700 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3701 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3702 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3703 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3704 { NATS-DANO iso-ir-9-1 csNATSDANO }
3705 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3706 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3707 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3708 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3709 { ISO-2022-KR csISO2022KR }
3711 { ISO-2022-JP csISO2022JP }
3712 { ISO-2022-JP-2 csISO2022JP2 }
3713 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3715 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3716 { IT iso-ir-15 ISO646-IT csISO15Italian }
3717 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3718 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3719 { greek7-old iso-ir-18 csISO18Greek7Old }
3720 { latin-greek iso-ir-19 csISO19LatinGreek }
3721 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3722 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3723 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3724 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3725 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3726 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3727 { INIS iso-ir-49 csISO49INIS }
3728 { INIS-8 iso-ir-50 csISO50INIS8 }
3729 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3730 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3731 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3732 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3733 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3734 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3736 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3737 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3738 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3739 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3740 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3741 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3742 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3743 { greek7 iso-ir-88 csISO88Greek7 }
3744 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3745 { iso-ir-90 csISO90 }
3746 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3747 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3748 csISO92JISC62991984b }
3749 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3750 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3751 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3752 csISO95JIS62291984handadd }
3753 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3754 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3755 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3756 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3758 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3759 { T.61-7bit iso-ir-102 csISO102T617bit }
3760 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3761 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3762 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3763 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3764 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3765 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3766 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3767 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3768 arabic csISOLatinArabic }
3769 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3770 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3771 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3772 greek greek8 csISOLatinGreek }
3773 { T.101-G2 iso-ir-128 csISO128T101G2 }
3774 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3776 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3777 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3778 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3779 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3780 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3781 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3782 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3783 csISOLatinCyrillic }
3784 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3785 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3786 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3787 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3788 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3789 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3790 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3791 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3792 { ISO_10367-box iso-ir-155 csISO10367Box }
3793 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3794 { latin-lap lap iso-ir-158 csISO158Lap }
3795 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3796 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3799 { JIS_X0201 X0201 csHalfWidthKatakana }
3800 { KSC5636 ISO646-KR csKSC5636 }
3801 { ISO-10646-UCS-2 csUnicode }
3802 { ISO-10646-UCS-4 csUCS4 }
3803 { DEC-MCS dec csDECMCS }
3804 { hp-roman8 roman8 r8 csHPRoman8 }
3805 { macintosh mac csMacintosh }
3806 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3808 { IBM038 EBCDIC-INT cp038 csIBM038 }
3809 { IBM273 CP273 csIBM273 }
3810 { IBM274 EBCDIC-BE CP274 csIBM274 }
3811 { IBM275 EBCDIC-BR cp275 csIBM275 }
3812 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3813 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3814 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3815 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3816 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3817 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3818 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3819 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3820 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3821 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3822 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3823 { IBM437 cp437 437 csPC8CodePage437 }
3824 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3825 { IBM775 cp775 csPC775Baltic }
3826 { IBM850 cp850 850 csPC850Multilingual }
3827 { IBM851 cp851 851 csIBM851 }
3828 { IBM852 cp852 852 csPCp852 }
3829 { IBM855 cp855 855 csIBM855 }
3830 { IBM857 cp857 857 csIBM857 }
3831 { IBM860 cp860 860 csIBM860 }
3832 { IBM861 cp861 861 cp-is csIBM861 }
3833 { IBM862 cp862 862 csPC862LatinHebrew }
3834 { IBM863 cp863 863 csIBM863 }
3835 { IBM864 cp864 csIBM864 }
3836 { IBM865 cp865 865 csIBM865 }
3837 { IBM866 cp866 866 csIBM866 }
3838 { IBM868 CP868 cp-ar csIBM868 }
3839 { IBM869 cp869 869 cp-gr csIBM869 }
3840 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3841 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3842 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3843 { IBM891 cp891 csIBM891 }
3844 { IBM903 cp903 csIBM903 }
3845 { IBM904 cp904 904 csIBBM904 }
3846 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3847 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3848 { IBM1026 CP1026 csIBM1026 }
3849 { EBCDIC-AT-DE csIBMEBCDICATDE }
3850 { EBCDIC-AT-DE-A csEBCDICATDEA }
3851 { EBCDIC-CA-FR csEBCDICCAFR }
3852 { EBCDIC-DK-NO csEBCDICDKNO }
3853 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3854 { EBCDIC-FI-SE csEBCDICFISE }
3855 { EBCDIC-FI-SE-A csEBCDICFISEA }
3856 { EBCDIC-FR csEBCDICFR }
3857 { EBCDIC-IT csEBCDICIT }
3858 { EBCDIC-PT csEBCDICPT }
3859 { EBCDIC-ES csEBCDICES }
3860 { EBCDIC-ES-A csEBCDICESA }
3861 { EBCDIC-ES-S csEBCDICESS }
3862 { EBCDIC-UK csEBCDICUK }
3863 { EBCDIC-US csEBCDICUS }
3864 { UNKNOWN-8BIT csUnknown8BiT }
3865 { MNEMONIC csMnemonic }
3870 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3871 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3872 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3873 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3874 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3875 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3876 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3877 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3878 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3879 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3880 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3881 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3882 { IBM1047 IBM-1047 }
3883 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3884 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3885 { UNICODE-1-1 csUnicode11 }
3888 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3889 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3891 { ISO-8859-15 ISO_8859-15 Latin-9 }
3892 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3893 { GBK CP936 MS936 windows-936 }
3894 { JIS_Encoding csJISEncoding }
3895 { Shift_JIS MS_Kanji csShiftJIS }
3896 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3898 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3899 { ISO-10646-UCS-Basic csUnicodeASCII }
3900 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3901 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3902 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3903 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3904 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3905 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3906 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3907 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3908 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3909 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3910 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3911 { Ventura-US csVenturaUS }
3912 { Ventura-International csVenturaInternational }
3913 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3914 { PC8-Turkish csPC8Turkish }
3915 { IBM-Symbols csIBMSymbols }
3916 { IBM-Thai csIBMThai }
3917 { HP-Legal csHPLegal }
3918 { HP-Pi-font csHPPiFont }
3919 { HP-Math8 csHPMath8 }
3920 { Adobe-Symbol-Encoding csHPPSMath }
3921 { HP-DeskTop csHPDesktop }
3922 { Ventura-Math csVenturaMath }
3923 { Microsoft-Publishing csMicrosoftPublishing }
3924 { Windows-31J csWindows31J }
3929 proc tcl_encoding {enc} {
3930 global encoding_aliases
3931 set names [encoding names]
3932 set lcnames [string tolower $names]
3933 set enc [string tolower $enc]
3934 set i [lsearch -exact $lcnames $enc]
3936 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3937 if {[regsub {^iso[-_]} $enc iso encx]} {
3938 set i [lsearch -exact $lcnames $encx]
3942 foreach l $encoding_aliases {
3943 set ll [string tolower $l]
3944 if {[lsearch -exact $ll $enc] < 0} continue
3945 # look through the aliases for one that tcl knows about
3947 set i [lsearch -exact $lcnames $e]
3949 if {[regsub {^iso[-_]} $e iso ex]} {
3950 set i [lsearch -exact $lcnames $ex]
3959 return [lindex $names $i]
3966 set diffopts "-U 5 -p"
3967 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3971 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3973 if {$gitencoding == ""} {
3974 set gitencoding "utf-8"
3976 set tclencoding [tcl_encoding $gitencoding]
3977 if {$tclencoding == {}} {
3978 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3981 set mainfont {Helvetica 9}
3982 set textfont {Courier 9}
3983 set findmergefiles 0
3992 set colors {green red blue magenta darkgrey brown orange}
3994 catch {source ~/.gitk}
3996 set namefont $mainfont
3998 font create optionfont -family sans-serif -size -12
4002 switch -regexp -- $arg {
4004 "^-d" { set datemode 1 }
4006 lappend revtreeargs $arg
4011 # check that we can find a .git directory somewhere...
4013 if {![file isdirectory $gitdir]} {
4014 error_popup "Cannot find the git directory \"$gitdir\"."
4033 parse_args $revtreeargs
4034 set args $parsed_args
4035 if {$cmdline_files ne {}} {
4036 # create a view for the files/dirs specified on the command line
4039 set viewname(1) "Command line"
4040 set viewfiles(1) $cmdline_files
4041 .bar.view add command -label $viewname(1) -command {showview 1}
4042 .bar.view entryconf 2 -state normal
4043 set args [concat $args "--" $cmdline_files]