2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish
"$0" -- "${1+$@}"
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.
10 # CVS $Revision: 1.16 $
12 proc getcommits
{rargs
} {
13 global commits commfd phase canv mainfont
19 if [catch
{set commfd
[open
"|git-rev-tree $rargs" r
]} err
] {
20 puts stderr
"Error executing git-rev-tree: $err"
23 fconfigure
$commfd -blocking 0
24 fileevent
$commfd readable
"getcommitline $commfd"
26 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
27 -font $mainfont -tags textitems
30 proc getcommitline
{commfd
} {
31 global commits parents cdate nparents children nchildren
32 set n
[gets
$commfd line
]
34 if {![eof
$commfd]} return
35 # this works around what is apparently a bug in Tcl...
36 fconfigure
$commfd -blocking 1
37 if {![catch
{close
$commfd} err
]} {
41 if {[string range
$err 0 4] == "usage"} {
43 Gitk: error reading commits: bad arguments to git-rev-tree.\n\
44 (Note: arguments to gitk are passed to git-rev-tree\
45 to allow selection of commits to be displayed.)"
47 set err
"Error reading commits: $err"
59 set id
[lindex
[split $f :] 0]
60 if {![info exists nchildren
($id)]} {
71 lappend parents
($cid) $id
74 lappend children
($id) $cid
81 proc readcommit
{id
} {
90 if [catch
{set contents
[exec git-cat-file commit
$id]}] return
91 foreach line
[split $contents "\n"] {
96 set tag
[lindex
$line 0]
97 if {$tag == "author"} {
98 set x
[expr {[llength
$line] - 2}]
99 set audate
[lindex
$line $x]
100 set auname
[lrange
$line 1 [expr {$x - 1}]]
101 } elseif
{$tag == "committer"} {
102 set x
[expr {[llength
$line] - 2}]
103 set comdate
[lindex
$line $x]
104 set comname
[lrange
$line 1 [expr {$x - 1}]]
108 if {$comment == {}} {
117 set audate
[clock format
$audate -format "%Y-%m-%d %H:%M:%S"]
119 if {$comdate != {}} {
120 set comdate
[clock format
$comdate -format "%Y-%m-%d %H:%M:%S"]
122 set commitinfo
($id) [list
$headline $auname $audate \
123 $comname $comdate $comment]
126 proc error_popup msg
{
130 message
$w.m
-text $msg -justify center
-aspect 400
131 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
132 button
$w.ok
-text OK
-command "destroy $w"
133 pack
$w.ok
-side bottom
-fill x
134 bind $w <Visibility
> "grab $w; focus $w"
139 global canv canv2 canv3 linespc charspc ctext cflist textfont
140 global sha1entry findtype findloc findstring fstring geometry
143 .bar add cascade
-label "File" -menu .bar.
file
145 .bar.
file add
command -label "Quit" -command doquit
147 .bar add cascade
-label "Help" -menu .bar.
help
148 .bar.
help add
command -label "About gitk" -command about
149 . configure
-menu .bar
151 if {![info exists geometry
(canv1
)]} {
152 set geometry
(canv1
) [expr 45 * $charspc]
153 set geometry
(canv2
) [expr 30 * $charspc]
154 set geometry
(canv3
) [expr 15 * $charspc]
155 set geometry
(canvh
) [expr 25 * $linespc + 4]
156 set geometry
(ctextw
) 80
157 set geometry
(ctexth
) 30
158 set geometry
(cflistw
) 30
160 panedwindow .ctop
-orient vertical
161 if {[info exists geometry
(width
)]} {
162 .ctop conf
-width $geometry(width
) -height $geometry(height
)
163 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
164 set geometry
(ctexth
) [expr {($texth - 8) /
165 [font metrics
$textfont -linespace]}]
169 pack .ctop.top.bar
-side bottom
-fill x
170 set cscroll .ctop.top.csb
171 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
172 pack
$cscroll -side right
-fill y
173 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
174 pack .ctop.top.clist
-side top
-fill both
-expand 1
176 set canv .ctop.top.clist.canv
177 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
179 -yscrollincr $linespc -yscrollcommand "$cscroll set"
180 .ctop.top.clist add
$canv
181 set canv2 .ctop.top.clist.canv2
182 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
183 -bg white
-bd 0 -yscrollincr $linespc
184 .ctop.top.clist add
$canv2
185 set canv3 .ctop.top.clist.canv3
186 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
187 -bg white
-bd 0 -yscrollincr $linespc
188 .ctop.top.clist add
$canv3
189 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
191 set sha1entry .ctop.top.bar.sha1
192 label .ctop.top.bar.sha1label
-text "SHA1 ID: "
193 pack .ctop.top.bar.sha1label
-side left
194 entry
$sha1entry -width 40 -font $textfont -state readonly
195 pack
$sha1entry -side left
-pady 2
196 button .ctop.top.bar.findbut
-text "Find" -command dofind
197 pack .ctop.top.bar.findbut
-side left
199 set fstring .ctop.top.bar.findstring
200 entry
$fstring -width 30 -font $textfont -textvariable findstring
201 pack
$fstring -side left
-expand 1 -fill x
203 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
204 set findloc
"All fields"
205 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
206 Comments Author Committer
207 pack .ctop.top.bar.findloc
-side right
208 pack .ctop.top.bar.findtype
-side right
210 panedwindow .ctop.cdet
-orient horizontal
212 frame .ctop.cdet.left
213 set ctext .ctop.cdet.left.ctext
214 text
$ctext -bg white
-state disabled
-font $textfont \
215 -width $geometry(ctextw
) -height $geometry(ctexth
) \
216 -yscrollcommand ".ctop.cdet.left.sb set"
217 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
218 pack .ctop.cdet.left.sb
-side right
-fill y
219 pack
$ctext -side left
-fill both
-expand 1
220 .ctop.cdet add .ctop.cdet.left
222 $ctext tag conf filesep
-font [concat
$textfont bold
]
223 $ctext tag conf hunksep
-back blue
-fore white
224 $ctext tag conf d0
-back "#ff8080"
225 $ctext tag conf d1
-back green
226 $ctext tag conf found
-back yellow
228 frame .ctop.cdet.right
229 set cflist .ctop.cdet.right.cfiles
230 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
231 -yscrollcommand ".ctop.cdet.right.sb set"
232 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
233 pack .ctop.cdet.right.sb
-side right
-fill y
234 pack
$cflist -side left
-fill both
-expand 1
235 .ctop.cdet add .ctop.cdet.right
236 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
238 pack .ctop
-side top
-fill both
-expand 1
240 bindall
<1> {selcanvline
%x
%y
}
241 bindall
<B1-Motion
> {selcanvline
%x
%y
}
242 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 u"
243 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 u"
244 bindall
<2> "allcanvs scan mark 0 %y"
245 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
246 bind .
<Key-Up
> "selnextline -1"
247 bind .
<Key-Down
> "selnextline 1"
248 bind .
<Key-Prior
> "allcanvs yview scroll -1 p"
249 bind .
<Key-Next
> "allcanvs yview scroll 1 p"
250 bindkey
<Key-Delete
> "$ctext yview scroll -1 p"
251 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 p"
252 bindkey
<Key-space
> "$ctext yview scroll 1 p"
253 bindkey p
"selnextline -1"
254 bindkey n
"selnextline 1"
255 bindkey b
"$ctext yview scroll -1 p"
256 bindkey d
"$ctext yview scroll 18 u"
257 bindkey u
"$ctext yview scroll -18 u"
260 bind .
<Control-q
> doquit
261 bind .
<Control-f
> dofind
262 bind .
<Control-g
> findnext
263 bind .
<Control-r
> findprev
264 bind .
<Control-equal
> {incrfont
1}
265 bind .
<Control-KP_Add
> {incrfont
1}
266 bind .
<Control-minus
> {incrfont
-1}
267 bind .
<Control-KP_Subtract
> {incrfont
-1}
268 bind $cflist <<ListboxSelect>> listboxsel
269 bind . <Destroy> {savestuff %W}
270 bind . <Button-1> "click %W"
271 bind $fstring <Key-Return> dofind
274 # when we make a key binding for the toplevel, make sure
275 # it doesn't get triggered when that key is pressed in the
276 # find string entry widget.
277 proc bindkey {ev script} {
280 set escript [bind Entry $ev]
281 if {$escript == {}} {
282 set escript [bind Entry <Key>]
284 bind $fstring $ev "$escript; break"
287 # set the focus back to the toplevel for any click outside
288 # the find string entry widget
291 if {$w != $fstring} {
297 global canv canv2 canv3 ctext cflist mainfont textfont
299 if {$stuffsaved} return
300 if {![winfo viewable .]} return
302 set f [open "~/.gitk-new" w]
303 puts $f "set mainfont {$mainfont}"
304 puts $f "set textfont {$textfont}"
305 puts $f "set geometry(width) [winfo width .ctop]"
306 puts $f "set geometry(height) [winfo height .ctop]"
307 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
308 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
309 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
310 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
311 set wid [expr {([winfo width $ctext] - 8) \
312 / [font measure $textfont "0"]}]
313 puts $f "set geometry(ctextw) $wid"
314 set wid [expr {([winfo width $cflist] - 11) \
315 / [font measure [$cflist cget -font] "0"]}]
316 puts $f "set geometry(cflistw) $wid"
318 file rename -force "~/.gitk-new" "~/.gitk"
323 proc resizeclistpanes {win w} {
325 if [info exists oldwidth($win)] {
326 set s0 [$win sash coord 0]
327 set s1 [$win sash coord 1]
329 set sash0 [expr {int($w/2 - 2)}]
330 set sash1 [expr {int($w*5/6 - 2)}]
332 set factor [expr {1.0 * $w / $oldwidth($win)}]
333 set sash0 [expr {int($factor * [lindex $s0 0])}]
334 set sash1 [expr {int($factor * [lindex $s1 0])}]
338 if {$sash1 < $sash0 + 20} {
339 set sash1 [expr $sash0 + 20]
341 if {$sash1 > $w - 10} {
342 set sash1 [expr $w - 10]
343 if {$sash0 > $sash1 - 20} {
344 set sash0 [expr $sash1 - 20]
348 $win sash place 0 $sash0 [lindex $s0 1]
349 $win sash place 1 $sash1 [lindex $s1 1]
351 set oldwidth($win) $w
354 proc resizecdetpanes {win w} {
356 if [info exists oldwidth($win)] {
357 set s0 [$win sash coord 0]
359 set sash0 [expr {int($w*3/4 - 2)}]
361 set factor [expr {1.0 * $w / $oldwidth($win)}]
362 set sash0 [expr {int($factor * [lindex $s0 0])}]
366 if {$sash0 > $w - 15} {
367 set sash0 [expr $w - 15]
370 $win sash place 0 $sash0 [lindex $s0 1]
372 set oldwidth($win) $w
376 global canv canv2 canv3
382 proc bindall {event action} {
383 global canv canv2 canv3
384 bind $canv $event $action
385 bind $canv2 $event $action
386 bind $canv3 $event $action
391 if {[winfo exists $w]} {
396 wm title $w "About gitk"
400 Copyright © 2005 Paul Mackerras
402 Use and redistribute under the terms of the GNU General Public License
404 (CVS $Revision: 1.16 $)} \
405 -justify center -aspect 400
406 pack $w.m -side top -fill x -padx 20 -pady 20
407 button $w.ok -text Close -command "destroy $w"
408 pack $w.ok -side bottom
411 proc truncatetofit {str width font} {
412 if {[font measure $font $str] <= $width} {
416 set bad [string length $str]
418 while {$best < $bad - 1} {
419 set try [expr {int(($best + $bad) / 2)}]
420 set tmp "[string range $str 0 [expr $try-1]]..."
421 if {[font measure $font $tmp] <= $width} {
430 proc assigncolor {id} {
431 global commitinfo colormap commcolors colors nextcolor
432 global colorbycommitter
433 global parents nparents children nchildren
434 if [info exists colormap($id)] return
435 set ncolors [llength $colors]
436 if {$colorbycommitter} {
437 if {![info exists commitinfo($id)]} {
440 set comm [lindex $commitinfo($id) 3]
441 if {![info exists commcolors($comm)]} {
442 set commcolors($comm) [lindex $colors $nextcolor]
443 if {[incr nextcolor] >= $ncolors} {
447 set colormap($id) $commcolors($comm)
449 if {$nparents($id) == 1 && $nchildren($id) == 1} {
450 set child [lindex $children($id) 0]
451 if {[info exists colormap($child)]
452 && $nparents($child) == 1} {
453 set colormap($id) $colormap($child)
458 foreach child $children($id) {
459 if {[info exists colormap($child)]
460 && [lsearch -exact $badcolors $colormap($child)] < 0} {
461 lappend badcolors $colormap($child)
463 if {[info exists parents($child)]} {
464 foreach p $parents($child) {
465 if {[info exists colormap($p)]
466 && [lsearch -exact $badcolors $colormap($p)] < 0} {
467 lappend badcolors $colormap($p)
472 if {[llength $badcolors] >= $ncolors} {
475 for {set i 0} {$i <= $ncolors} {incr i} {
476 set c [lindex $colors $nextcolor]
477 if {[incr nextcolor] >= $ncolors} {
480 if {[lsearch -exact $badcolors $c]} break
487 global parents children nparents nchildren commits
488 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
489 global datemode cdate
490 global lineid linehtag linentag linedtag commitinfo
491 global nextcolor colormap numcommits
492 global stopped phase redisplaying selectedline
496 foreach id [array names nchildren] {
497 if {$nchildren($id) == 0} {
500 set ncleft($id) $nchildren($id)
501 if {![info exists nparents($id)]} {
506 error_popup "Gitk: ERROR: No starting commits found"
515 set level [expr [llength $todo] - 1]
521 set lthickness [expr {($linespc / 9) + 1}]
524 allcanvs conf -scrollregion \
525 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
530 set nlines [llength $todo]
531 set id [lindex $todo $level]
532 set lineid($lineno) $id
534 if {[info exists parents($id)]} {
535 foreach p $parents($id) {
537 if {![info exists commitinfo($p)]} {
539 if {![info exists commitinfo($p)]} continue
541 lappend actualparents $p
544 if {![info exists commitinfo($id)]} {
546 if {![info exists commitinfo($id)]} {
547 set commitinfo($id) {"No commit information available"}
550 set x [expr $canvx0 + $level * $linespc]
551 set y2 [expr $canvy + $linespc]
552 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
553 set t [$canv create line $x $linestarty($level) $x $canvy \
554 -width $lthickness -fill $colormap($id)]
557 set linestarty($level) $canvy
558 set ofill [expr {[info exists parents($id)]? "blue": "white"}]
559 set orad [expr {$linespc / 3}]
560 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
561 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
562 -fill $ofill -outline black -width 1]
564 set xt [expr $canvx0 + $nlines * $linespc]
565 set headline [lindex $commitinfo($id) 0]
566 set name [lindex $commitinfo($id) 1]
567 set date [lindex $commitinfo($id) 2]
568 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
569 -text $headline -font $mainfont ]
570 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
571 -text $name -font $namefont]
572 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
573 -text $date -font $mainfont]
574 if {!$datemode && [llength $actualparents] == 1} {
575 set p [lindex $actualparents 0]
576 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
578 set todo [lreplace $todo $level $level $p]
586 for {set i 0} {$i < $nlines} {incr i} {
587 if {[lindex $todo $i] == {}} continue
588 if {[info exists linestarty($i)]} {
589 set oldstarty($i) $linestarty($i)
593 lappend lines [list $i [lindex $todo $i]]
596 if {$nullentry >= 0} {
597 set todo [lreplace $todo $nullentry $nullentry]
598 if {$nullentry < $level} {
603 set todo [lreplace $todo $level $level]
604 if {$nullentry > $level} {
608 foreach p $actualparents {
609 set k [lsearch -exact $todo $p]
612 set todo [linsert $todo $i $p]
613 if {$nullentry >= $i} {
617 lappend lines [list $oldlevel $p]
620 # choose which one to do next time around
621 set todol [llength $todo]
624 for {set k $todol} {[incr k -1] >= 0} {} {
625 set p [lindex $todo $k]
626 if {$p == {}} continue
627 if {$ncleft($p) == 0} {
629 if {$latest == {} || $cdate($p) > $latest} {
631 set latest $cdate($p)
641 puts "ERROR: none of the pending commits can be done yet:"
649 # If we are reducing, put in a null entry
650 if {$todol < $nlines} {
651 if {$nullentry >= 0} {
654 && [lindex $oldtodo $i] == [lindex $todo $i]} {
667 set todo [linsert $todo $nullentry {}]
678 set dst [lindex $l 1]
679 set j [lsearch -exact $todo $dst]
681 if {[info exists oldstarty($i)]} {
682 set linestarty($i) $oldstarty($i)
686 set xi [expr {$canvx0 + $i * $linespc}]
687 set xj [expr {$canvx0 + $j * $linespc}]
689 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
690 lappend coords $xi $oldstarty($i)
692 lappend coords $xi $canvy
694 lappend coords [expr $xj + $linespc] $canvy
695 } elseif {$j > $i + 1} {
696 lappend coords [expr $xj - $linespc] $canvy
698 lappend coords $xj $y2
699 set t [$canv create line $coords -width $lthickness \
700 -fill $colormap($dst)]
702 if {![info exists linestarty($j)]} {
703 set linestarty($j) $y2
709 if {$stopped == 0 && [info exists selectedline]} {
710 selectline $selectedline
721 proc findmatches {f} {
722 global findtype foundstring foundstrlen
723 if {$findtype == "Regexp"} {
724 set matches [regexp -indices -all -inline $foundstring $f]
726 if {$findtype == "IgnCase"} {
727 set str [string tolower $f]
733 while {[set j [string first $foundstring $str $i]] >= 0} {
734 lappend matches [list $j [expr $j+$foundstrlen-1]]
735 set i [expr $j + $foundstrlen]
742 global findtype findloc findstring markedmatches commitinfo
743 global numcommits lineid linehtag linentag linedtag
744 global mainfont namefont canv canv2 canv3 selectedline
745 global matchinglines foundstring foundstrlen
749 set fldtypes {Headline Author Date Committer CDate Comment}
750 if {$findtype == "IgnCase"} {
751 set foundstring [string tolower $findstring]
753 set foundstring $findstring
755 set foundstrlen [string length $findstring]
756 if {$foundstrlen == 0} return
757 if {![info exists selectedline]} {
760 set oldsel $selectedline
763 for {set l 0} {$l < $numcommits} {incr l} {
765 set info $commitinfo($id)
767 foreach f $info ty $fldtypes {
768 if {$findloc != "All fields" && $findloc != $ty} {
771 set matches [findmatches $f]
772 if {$matches == {}} continue
774 if {$ty == "Headline"} {
775 markmatches $canv $l $f $linehtag($l) $matches $mainfont
776 } elseif {$ty == "Author"} {
777 markmatches $canv2 $l $f $linentag($l) $matches $namefont
778 } elseif {$ty == "Date"} {
779 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
783 lappend matchinglines $l
784 if {!$didsel && $l > $oldsel} {
790 if {$matchinglines == {}} {
792 } elseif {!$didsel} {
793 findselectline [lindex $matchinglines 0]
797 proc findselectline {l} {
798 global findloc commentend ctext
800 if {$findloc == "All fields" || $findloc == "Comments"} {
801 # highlight the matches in the comments
802 set f [$ctext get 1.0 $commentend]
803 set matches [findmatches $f]
804 foreach match $matches {
805 set start [lindex $match 0]
806 set end [expr [lindex $match 1] + 1]
807 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
813 global matchinglines selectedline
814 if {![info exists matchinglines]} {
818 if {![info exists selectedline]} return
819 foreach l $matchinglines {
820 if {$l > $selectedline} {
829 global matchinglines selectedline
830 if {![info exists matchinglines]} {
834 if {![info exists selectedline]} return
836 foreach l $matchinglines {
837 if {$l >= $selectedline} break
847 proc markmatches {canv l str tag matches font} {
848 set bbox [$canv bbox $tag]
849 set x0 [lindex $bbox 0]
850 set y0 [lindex $bbox 1]
851 set y1 [lindex $bbox 3]
852 foreach match $matches {
853 set start [lindex $match 0]
854 set end [lindex $match 1]
855 if {$start > $end} continue
856 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
857 set xlen [font measure $font [string range $str 0 [expr $end]]]
858 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
859 -outline {} -tags matches -fill yellow]
864 proc unmarkmatches {} {
866 allcanvs delete matches
867 catch {unset matchinglines}
870 proc selcanvline {x y} {
871 global canv canvy0 ctext linespc selectedline
872 global lineid linehtag linentag linedtag
873 set ymax [lindex [$canv cget -scrollregion] 3]
874 set yfrac [lindex [$canv yview] 0]
875 set y [expr {$y + $yfrac * $ymax}]
876 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
880 if {[info exists selectedline] && $selectedline == $l} return
885 proc selectline {l} {
886 global canv canv2 canv3 ctext commitinfo selectedline
887 global lineid linehtag linentag linedtag
888 global canvy0 linespc nparents treepending
889 global cflist treediffs currentid sha1entry
890 global commentend seenfile numcommits
891 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
893 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
894 -tags secsel -fill [$canv cget -selectbackground]]
897 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
898 -tags secsel -fill [$canv2 cget -selectbackground]]
901 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
902 -tags secsel -fill [$canv3 cget -selectbackground]]
904 set y [expr {$canvy0 + $l * $linespc}]
905 set ymax [lindex [$canv cget -scrollregion] 3]
906 set ytop [expr {$y - $linespc - 1}]
907 set ybot [expr {$y + $linespc + 1}]
908 set wnow [$canv yview]
909 set wtop [expr [lindex $wnow 0] * $ymax]
910 set wbot [expr [lindex $wnow 1] * $ymax]
911 set wh [expr {$wbot - $wtop}]
915 set newtop [expr {$y - $wh / 2.0}]
918 if {$newtop > $wtop - $linespc} {
919 set newtop [expr {$wtop - $linespc}]
922 } elseif {$ybot > $wbot} {
924 set newtop [expr {$y - $wh / 2.0}]
926 set newtop [expr {$ybot - $wh}]
927 if {$newtop < $wtop + $linespc} {
928 set newtop [expr {$wtop + $linespc}]
932 if {$newtop != $wtop} {
936 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
941 $sha1entry conf -state normal
942 $sha1entry delete 0 end
943 $sha1entry insert 0 $id
944 $sha1entry selection from 0
945 $sha1entry selection to end
946 $sha1entry conf -state readonly
948 $ctext conf -state normal
949 $ctext delete 0.0 end
950 set info $commitinfo($id)
951 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
952 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
953 $ctext insert end "\n"
954 $ctext insert end [lindex $info 5]
955 $ctext insert end "\n"
956 $ctext tag delete Comments
957 $ctext tag remove found 1.0 end
958 $ctext conf -state disabled
959 set commentend [$ctext index "end - 1c"]
963 if {$nparents($id) == 1} {
964 if {![info exists treediffs($id)]} {
965 if {![info exists treepending]} {
972 catch {unset seenfile}
975 proc selnextline {dir} {
977 if {![info exists selectedline]} return
978 set l [expr $selectedline + $dir]
983 proc addtocflist {id} {
984 global currentid treediffs cflist treepending
985 if {$id != $currentid} {
986 gettreediffs $currentid
989 $cflist insert end "All files"
990 foreach f $treediffs($currentid) {
991 $cflist insert end $f
996 proc gettreediffs {id} {
997 global treediffs parents treepending
999 set treediffs($id) {}
1000 set p [lindex $parents($id) 0]
1001 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1002 fconfigure $gdtf -blocking 0
1003 fileevent $gdtf readable "gettreediffline $gdtf $id"
1006 proc gettreediffline {gdtf id} {
1007 global treediffs treepending
1008 set n [gets $gdtf line]
1010 if {![eof $gdtf]} return
1016 set type [lindex $line 1]
1017 set file [lindex $line 3]
1018 if {$type == "blob"} {
1019 lappend treediffs($id) $file
1023 proc getblobdiffs {id} {
1024 global parents diffopts blobdifffd env curdifftag curtagstart
1025 set p [lindex $parents($id) 0]
1026 set env(GIT_DIFF_OPTS) $diffopts
1027 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1028 puts "error getting diffs: $err"
1031 fconfigure $bdf -blocking 0
1032 set blobdifffd($id) $bdf
1033 set curdifftag Comments
1035 fileevent $bdf readable "getblobdiffline $bdf $id"
1038 proc getblobdiffline {bdf id} {
1039 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1040 global diffnexthead diffnextnote
1041 set n [gets $bdf line]
1045 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1046 $ctext tag add $curdifftag $curtagstart end
1047 set seenfile($curdifftag) 1
1052 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1055 $ctext conf -state normal
1056 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1057 # start of a new file
1058 $ctext insert end "\n"
1059 $ctext tag add $curdifftag $curtagstart end
1060 set seenfile($curdifftag) 1
1061 set curtagstart [$ctext index "end - 1c"]
1063 if {[info exists diffnexthead]} {
1064 set fname $diffnexthead
1065 set header "$diffnexthead ($diffnextnote)"
1068 set curdifftag "f:$fname"
1069 $ctext tag delete $curdifftag
1070 set l [expr {(78 - [string length $header]) / 2}]
1071 set pad [string range "----------------------------------------" 1 $l]
1072 $ctext insert end "$pad $header $pad\n" filesep
1073 } elseif {[string range $line 0 2] == "+++"} {
1074 # no need to do anything with this
1075 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1076 set diffnexthead $fn
1077 set diffnextnote "created, mode $m"
1078 } elseif {[string range $line 0 8] == "Deleted: "} {
1079 set diffnexthead [string range $line 9 end]
1080 set diffnextnote "deleted"
1081 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1082 $line match f1l f1c f2l f2c rest]} {
1083 $ctext insert end "\t" hunksep
1084 $ctext insert end " $f1l " d0 " $f2l " d1
1085 $ctext insert end " $rest \n" hunksep
1087 set x [string range $line 0 0]
1088 if {$x == "-" || $x == "+"} {
1089 set tag [expr {$x == "+"}]
1090 set line [string range $line 1 end]
1091 $ctext insert end "$line\n" d$tag
1092 } elseif {$x == " "} {
1093 set line [string range $line 1 end]
1094 $ctext insert end "$line\n"
1095 } elseif {$x == "\\"} {
1096 # e.g. "\ No newline at end of file"
1097 $ctext insert end "$line\n" filesep
1099 # Something else we don't recognize
1100 if {$curdifftag != "Comments"} {
1101 $ctext insert end "\n"
1102 $ctext tag add $curdifftag $curtagstart end
1103 set seenfile($curdifftag) 1
1104 set curtagstart [$ctext index "end - 1c"]
1105 set curdifftag Comments
1107 $ctext insert end "$line\n" filesep
1110 $ctext conf -state disabled
1113 proc listboxsel {} {
1114 global ctext cflist currentid treediffs seenfile
1115 if {![info exists currentid]} return
1116 set sel [$cflist curselection]
1117 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1119 $ctext tag conf Comments -elide 0
1120 foreach f $treediffs($currentid) {
1121 if [info exists seenfile(f:$f)] {
1122 $ctext tag conf "f:$f" -elide 0
1126 # just show selected files
1127 $ctext tag conf Comments -elide 1
1129 foreach f $treediffs($currentid) {
1130 set elide [expr {[lsearch -exact $sel $i] < 0}]
1131 if [info exists seenfile(f:$f)] {
1132 $ctext tag conf "f:$f" -elide $elide
1140 global linespc charspc canvx0 canvy0 mainfont
1141 set linespc [font metrics $mainfont -linespace]
1142 set charspc [font measure $mainfont "m"]
1143 set canvy0 [expr 3 + 0.5 * $linespc]
1144 set canvx0 [expr 3 + 0.5 * $linespc]
1148 global selectedline stopped redisplaying phase
1149 if {$stopped > 1} return
1150 if {$phase == "getcommits"} return
1152 if {$phase == "drawgraph"} {
1159 proc incrfont {inc} {
1160 global mainfont namefont textfont selectedline ctext canv phase
1163 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1164 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1165 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1167 $ctext conf -font $textfont
1168 $ctext tag conf filesep -font [concat $textfont bold]
1169 if {$phase == "getcommits"} {
1170 $canv itemconf textitems -font $mainfont
1184 set diffopts "-U 5 -p"
1186 set mainfont {Helvetica 9}
1187 set textfont {Courier 9}
1189 set colors {green red blue magenta darkgrey brown orange}
1190 set colorbycommitter false
1192 catch {source ~/.gitk}
1194 set namefont $mainfont
1196 lappend namefont bold
1201 switch -regexp -- $arg {
1203 "^-b" { set boldnames 1 }
1204 "^-c" { set colorbycommitter 1 }
1205 "^-d" { set datemode 1 }
1207 puts stderr "unrecognized option $arg"
1211 lappend revtreeargs $arg
1221 getcommits $revtreeargs