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.14 $
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
)
166 pack .ctop.top.bar
-side bottom
-fill x
167 set cscroll .ctop.top.csb
168 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
169 pack
$cscroll -side right
-fill y
170 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
171 pack .ctop.top.clist
-side top
-fill both
-expand 1
173 set canv .ctop.top.clist.canv
174 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
176 -yscrollincr $linespc -yscrollcommand "$cscroll set"
177 .ctop.top.clist add
$canv
178 set canv2 .ctop.top.clist.canv2
179 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
180 -bg white
-bd 0 -yscrollincr $linespc
181 .ctop.top.clist add
$canv2
182 set canv3 .ctop.top.clist.canv3
183 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
184 -bg white
-bd 0 -yscrollincr $linespc
185 .ctop.top.clist add
$canv3
186 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
188 set sha1entry .ctop.top.bar.sha1
189 label .ctop.top.bar.sha1label
-text "SHA1 ID: "
190 pack .ctop.top.bar.sha1label
-side left
191 entry
$sha1entry -width 40 -font $textfont -state readonly
192 pack
$sha1entry -side left
-pady 2
193 button .ctop.top.bar.findbut
-text "Find" -command dofind
194 pack .ctop.top.bar.findbut
-side left
196 set fstring .ctop.top.bar.findstring
197 entry
$fstring -width 30 -font $textfont -textvariable findstring
198 # stop the toplevel events from firing on key presses
199 bind $fstring <Key
> "[bind Entry <Key>]; break"
200 pack
$fstring -side left
-expand 1 -fill x
202 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
203 set findloc
"All fields"
204 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
205 Comments Author Committer
206 pack .ctop.top.bar.findloc
-side right
207 pack .ctop.top.bar.findtype
-side right
209 panedwindow .ctop.cdet
-orient horizontal
211 frame .ctop.cdet.left
212 set ctext .ctop.cdet.left.ctext
213 text
$ctext -bg white
-state disabled
-font $textfont \
214 -width $geometry(ctextw
) -height $geometry(ctexth
) \
215 -yscrollcommand ".ctop.cdet.left.sb set"
216 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
217 pack .ctop.cdet.left.sb
-side right
-fill y
218 pack
$ctext -side left
-fill both
-expand 1
219 .ctop.cdet add .ctop.cdet.left
221 $ctext tag conf filesep
-font [concat
$textfont bold
]
222 $ctext tag conf hunksep
-back blue
-fore white
223 $ctext tag conf d0
-back "#ff8080"
224 $ctext tag conf d1
-back green
225 $ctext tag conf found
-back yellow
227 frame .ctop.cdet.right
228 set cflist .ctop.cdet.right.cfiles
229 listbox
$cflist -width $geometry(cflistw
) -bg white
-selectmode extended \
230 -yscrollcommand ".ctop.cdet.right.sb set"
231 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
232 pack .ctop.cdet.right.sb
-side right
-fill y
233 pack
$cflist -side left
-fill both
-expand 1
234 .ctop.cdet add .ctop.cdet.right
235 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
237 pack .ctop
-side top
-fill both
-expand 1
239 bindall
<1> {selcanvline
%x
%y
}
240 bindall
<B1-Motion
> {selcanvline
%x
%y
}
241 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 u"
242 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 u"
243 bindall
<2> "allcanvs scan mark 0 %y"
244 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
245 bindall
<Key-Up
> "selnextline -1"
246 bindall
<Key-Down
> "selnextline 1"
247 bindall
<Key-Prior
> "allcanvs yview scroll -1 p"
248 bindall
<Key-Next
> "allcanvs yview scroll 1 p"
249 bindkey
<Key-Delete
> "$ctext yview scroll -1 p"
250 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 p"
251 bindkey
<Key-space
> "$ctext yview scroll 1 p"
252 bindkey p
"selnextline -1"
253 bindkey n
"selnextline 1"
254 bindkey b
"$ctext yview scroll -1 p"
255 bindkey d
"$ctext yview scroll 18 u"
256 bindkey u
"$ctext yview scroll -18 u"
259 bind .
<Control-q
> doquit
260 bind .
<Control-f
> dofind
261 bind .
<Control-g
> findnext
262 bind .
<Control-r
> findprev
263 bind .
<Control-equal
> {incrfont
1}
264 bind .
<Control-KP_Add
> {incrfont
1}
265 bind .
<Control-minus
> {incrfont
-1}
266 bind .
<Control-KP_Subtract
> {incrfont
-1}
267 bind $cflist <<ListboxSelect>> listboxsel
268 bind . <Destroy> {savestuff %W}
269 bind . <Button-1> "click %W"
272 # when we make a key binding for the toplevel, make sure
273 # it doesn't get triggered when that key is pressed in the
274 # find string entry widget.
275 proc bindkey {ev script} {
278 set escript [bind Entry $ev]
279 if {$escript == {}} {
280 set escript [bind Entry <Key>]
282 bind $fstring $ev "$escript; break"
285 # set the focus back to the toplevel for any click outside
286 # the find string entry widget
289 if {$w != $fstring} {
295 global canv canv2 canv3 ctext cflist mainfont textfont
297 if {$stuffsaved} return
298 if {![winfo viewable .]} return
300 set f [open "~/.gitk-new" w]
301 puts $f "set mainfont {$mainfont}"
302 puts $f "set textfont {$textfont}"
303 puts $f "set geometry(width) [winfo width .ctop]"
304 puts $f "set geometry(height) [winfo height .ctop]"
305 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
306 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
307 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
308 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
309 puts $f "set geometry(csash) {[.ctop sash coord 0]}"
310 set wid [expr {([winfo width $ctext] - 8) \
311 / [font measure $textfont "0"]}]
312 set ht [expr {([winfo height $ctext] - 8) \
313 / [font metrics $textfont -linespace]}]
314 puts $f "set geometry(ctextw) $wid"
315 puts $f "set geometry(ctexth) $ht"
316 set wid [expr {([winfo width $cflist] - 11) \
317 / [font measure [$cflist cget -font] "0"]}]
318 puts $f "set geometry(cflistw) $wid"
320 file rename -force "~/.gitk-new" "~/.gitk"
325 proc resizeclistpanes {win w} {
327 if [info exists oldwidth($win)] {
328 set s0 [$win sash coord 0]
329 set s1 [$win sash coord 1]
331 set sash0 [expr {int($w/2 - 2)}]
332 set sash1 [expr {int($w*5/6 - 2)}]
334 set factor [expr {1.0 * $w / $oldwidth($win)}]
335 set sash0 [expr {int($factor * [lindex $s0 0])}]
336 set sash1 [expr {int($factor * [lindex $s1 0])}]
340 if {$sash1 < $sash0 + 20} {
341 set sash1 [expr $sash0 + 20]
343 if {$sash1 > $w - 10} {
344 set sash1 [expr $w - 10]
345 if {$sash0 > $sash1 - 20} {
346 set sash0 [expr $sash1 - 20]
350 $win sash place 0 $sash0 [lindex $s0 1]
351 $win sash place 1 $sash1 [lindex $s1 1]
353 set oldwidth($win) $w
356 proc resizecdetpanes {win w} {
358 if [info exists oldwidth($win)] {
359 set s0 [$win sash coord 0]
361 set sash0 [expr {int($w*3/4 - 2)}]
363 set factor [expr {1.0 * $w / $oldwidth($win)}]
364 set sash0 [expr {int($factor * [lindex $s0 0])}]
368 if {$sash0 > $w - 15} {
369 set sash0 [expr $w - 15]
372 $win sash place 0 $sash0 [lindex $s0 1]
374 set oldwidth($win) $w
378 global canv canv2 canv3
384 proc bindall {event action} {
385 global canv canv2 canv3
386 bind $canv $event $action
387 bind $canv2 $event $action
388 bind $canv3 $event $action
393 if {[winfo exists $w]} {
398 wm title $w "About gitk"
402 Copyright © 2005 Paul Mackerras
404 Use and redistribute under the terms of the GNU General Public License
406 (CVS $Revision: 1.14 $)} \
407 -justify center -aspect 400
408 pack $w.m -side top -fill x -padx 20 -pady 20
409 button $w.ok -text Close -command "destroy $w"
410 pack $w.ok -side bottom
413 proc truncatetofit {str width font} {
414 if {[font measure $font $str] <= $width} {
418 set bad [string length $str]
420 while {$best < $bad - 1} {
421 set try [expr {int(($best + $bad) / 2)}]
422 set tmp "[string range $str 0 [expr $try-1]]..."
423 if {[font measure $font $tmp] <= $width} {
432 proc assigncolor {id} {
433 global commitinfo colormap commcolors colors nextcolor
434 global colorbycommitter
435 global parents nparents children nchildren
436 if [info exists colormap($id)] return
437 set ncolors [llength $colors]
438 if {$colorbycommitter} {
439 if {![info exists commitinfo($id)]} {
442 set comm [lindex $commitinfo($id) 3]
443 if {![info exists commcolors($comm)]} {
444 set commcolors($comm) [lindex $colors $nextcolor]
445 if {[incr nextcolor] >= $ncolors} {
449 set colormap($id) $commcolors($comm)
451 if {$nparents($id) == 1 && $nchildren($id) == 1} {
452 set child [lindex $children($id) 0]
453 if {[info exists colormap($child)]
454 && $nparents($child) == 1} {
455 set colormap($id) $colormap($child)
460 foreach child $children($id) {
461 if {[info exists colormap($child)]
462 && [lsearch -exact $badcolors $colormap($child)] < 0} {
463 lappend badcolors $colormap($child)
465 if {[info exists parents($child)]} {
466 foreach p $parents($child) {
467 if {[info exists colormap($p)]
468 && [lsearch -exact $badcolors $colormap($p)] < 0} {
469 lappend badcolors $colormap($p)
474 if {[llength $badcolors] >= $ncolors} {
477 for {set i 0} {$i <= $ncolors} {incr i} {
478 set c [lindex $colors $nextcolor]
479 if {[incr nextcolor] >= $ncolors} {
482 if {[lsearch -exact $badcolors $c]} break
489 global parents children nparents nchildren commits
490 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
491 global datemode cdate
492 global lineid linehtag linentag linedtag commitinfo
493 global nextcolor colormap numcommits
494 global stopped phase redisplaying selectedline
498 foreach id [array names nchildren] {
499 if {$nchildren($id) == 0} {
502 set ncleft($id) $nchildren($id)
503 if {![info exists nparents($id)]} {
508 error_popup "Gitk: ERROR: No starting commits found"
517 set level [expr [llength $todo] - 1]
525 allcanvs conf -scrollregion [list 0 0 0 $canvy]
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 2 -fill $colormap($id)]
557 set linestarty($level) $canvy
558 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
559 [expr $x + 3] [expr $canvy + 3] \
560 -fill blue -outline black -width 1]
562 set xt [expr $canvx0 + $nlines * $linespc]
563 set headline [lindex $commitinfo($id) 0]
564 set name [lindex $commitinfo($id) 1]
565 set date [lindex $commitinfo($id) 2]
566 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
567 -text $headline -font $mainfont ]
568 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
569 -text $name -font $namefont]
570 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
571 -text $date -font $mainfont]
572 if {!$datemode && [llength $actualparents] == 1} {
573 set p [lindex $actualparents 0]
574 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
576 set todo [lreplace $todo $level $level $p]
584 for {set i 0} {$i < $nlines} {incr i} {
585 if {[lindex $todo $i] == {}} continue
586 if {[info exists linestarty($i)]} {
587 set oldstarty($i) $linestarty($i)
591 lappend lines [list $i [lindex $todo $i]]
594 if {$nullentry >= 0} {
595 set todo [lreplace $todo $nullentry $nullentry]
596 if {$nullentry < $level} {
601 set todo [lreplace $todo $level $level]
602 if {$nullentry > $level} {
606 foreach p $actualparents {
607 set k [lsearch -exact $todo $p]
610 set todo [linsert $todo $i $p]
611 if {$nullentry >= $i} {
615 lappend lines [list $oldlevel $p]
618 # choose which one to do next time around
619 set todol [llength $todo]
622 for {set k $todol} {[incr k -1] >= 0} {} {
623 set p [lindex $todo $k]
624 if {$p == {}} continue
625 if {$ncleft($p) == 0} {
627 if {$latest == {} || $cdate($p) > $latest} {
629 set latest $cdate($p)
639 puts "ERROR: none of the pending commits can be done yet:"
647 # If we are reducing, put in a null entry
648 if {$todol < $nlines} {
649 if {$nullentry >= 0} {
652 && [lindex $oldtodo $i] == [lindex $todo $i]} {
665 set todo [linsert $todo $nullentry {}]
676 set dst [lindex $l 1]
677 set j [lsearch -exact $todo $dst]
679 if {[info exists oldstarty($i)]} {
680 set linestarty($i) $oldstarty($i)
684 set xi [expr {$canvx0 + $i * $linespc}]
685 set xj [expr {$canvx0 + $j * $linespc}]
687 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
688 lappend coords $xi $oldstarty($i)
690 lappend coords $xi $canvy
692 lappend coords [expr $xj + $linespc] $canvy
693 } elseif {$j > $i + 1} {
694 lappend coords [expr $xj - $linespc] $canvy
696 lappend coords $xj $y2
697 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
699 if {![info exists linestarty($j)]} {
700 set linestarty($j) $y2
706 if {$stopped == 0 && [info exists selectedline]} {
707 selectline $selectedline
718 proc findmatches {f} {
719 global findtype foundstring foundstrlen
720 if {$findtype == "Regexp"} {
721 set matches [regexp -indices -all -inline $foundstring $f]
723 if {$findtype == "IgnCase"} {
724 set str [string tolower $f]
730 while {[set j [string first $foundstring $str $i]] >= 0} {
731 lappend matches [list $j [expr $j+$foundstrlen-1]]
732 set i [expr $j + $foundstrlen]
739 global findtype findloc findstring markedmatches commitinfo
740 global numcommits lineid linehtag linentag linedtag
741 global mainfont namefont canv canv2 canv3 selectedline
742 global matchinglines foundstring foundstrlen
746 set fldtypes {Headline Author Date Committer CDate Comment}
747 if {$findtype == "IgnCase"} {
748 set foundstring [string tolower $findstring]
750 set foundstring $findstring
752 set foundstrlen [string length $findstring]
753 if {$foundstrlen == 0} return
754 if {![info exists selectedline]} {
757 set oldsel $selectedline
760 for {set l 0} {$l < $numcommits} {incr l} {
762 set info $commitinfo($id)
764 foreach f $info ty $fldtypes {
765 if {$findloc != "All fields" && $findloc != $ty} {
768 set matches [findmatches $f]
769 if {$matches == {}} continue
771 if {$ty == "Headline"} {
772 markmatches $canv $l $f $linehtag($l) $matches $mainfont
773 } elseif {$ty == "Author"} {
774 markmatches $canv2 $l $f $linentag($l) $matches $namefont
775 } elseif {$ty == "Date"} {
776 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
780 lappend matchinglines $l
781 if {!$didsel && $l > $oldsel} {
787 if {$matchinglines == {}} {
789 } elseif {!$didsel} {
790 findselectline [lindex $matchinglines 0]
794 proc findselectline {l} {
795 global findloc commentend ctext
797 if {$findloc == "All fields" || $findloc == "Comments"} {
798 # highlight the matches in the comments
799 set f [$ctext get 1.0 $commentend]
800 set matches [findmatches $f]
801 foreach match $matches {
802 set start [lindex $match 0]
803 set end [expr [lindex $match 1] + 1]
804 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
810 global matchinglines selectedline
811 if {![info exists matchinglines]} {
815 if {![info exists selectedline]} return
816 foreach l $matchinglines {
817 if {$l > $selectedline} {
826 global matchinglines selectedline
827 if {![info exists matchinglines]} {
831 if {![info exists selectedline]} return
833 foreach l $matchinglines {
834 if {$l >= $selectedline} break
844 proc markmatches {canv l str tag matches font} {
845 set bbox [$canv bbox $tag]
846 set x0 [lindex $bbox 0]
847 set y0 [lindex $bbox 1]
848 set y1 [lindex $bbox 3]
849 foreach match $matches {
850 set start [lindex $match 0]
851 set end [lindex $match 1]
852 if {$start > $end} continue
853 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
854 set xlen [font measure $font [string range $str 0 [expr $end]]]
855 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
856 -outline {} -tags matches -fill yellow]
861 proc unmarkmatches {} {
863 allcanvs delete matches
864 catch {unset matchinglines}
867 proc selcanvline {x y} {
868 global canv canvy0 ctext linespc selectedline
869 global lineid linehtag linentag linedtag
870 set ymax [lindex [$canv cget -scrollregion] 3]
871 set yfrac [lindex [$canv yview] 0]
872 set y [expr {$y + $yfrac * $ymax}]
873 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
877 if {[info exists selectedline] && $selectedline == $l} return
882 proc selectline {l} {
883 global canv canv2 canv3 ctext commitinfo selectedline
884 global lineid linehtag linentag linedtag
885 global canvy canvy0 linespc nparents treepending
886 global cflist treediffs currentid sha1entry
888 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
890 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
891 -tags secsel -fill [$canv cget -selectbackground]]
894 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
895 -tags secsel -fill [$canv2 cget -selectbackground]]
898 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
899 -tags secsel -fill [$canv3 cget -selectbackground]]
901 set y [expr {$canvy0 + $l * $linespc}]
902 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
903 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
904 set wnow [$canv yview]
905 if {$ytop < [lindex $wnow 0]} {
906 allcanvs yview moveto $ytop
907 } elseif {$ybot > [lindex $wnow 1]} {
908 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
909 allcanvs yview moveto [expr {$ybot - $wh}]
914 $sha1entry conf -state normal
915 $sha1entry delete 0 end
916 $sha1entry insert 0 $id
917 $sha1entry selection from 0
918 $sha1entry selection to end
919 $sha1entry conf -state readonly
921 $ctext conf -state normal
922 $ctext delete 0.0 end
923 set info $commitinfo($id)
924 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
925 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
926 $ctext insert end "\n"
927 $ctext insert end [lindex $info 5]
928 $ctext insert end "\n"
929 $ctext tag delete Comments
930 $ctext tag remove found 1.0 end
931 $ctext conf -state disabled
932 set commentend [$ctext index "end - 1c"]
936 if {$nparents($id) == 1} {
937 if {![info exists treediffs($id)]} {
938 if {![info exists treepending]} {
947 proc selnextline {dir} {
949 if {![info exists selectedline]} return
950 set l [expr $selectedline + $dir]
955 proc addtocflist {id} {
956 global currentid treediffs cflist treepending
957 if {$id != $currentid} {
958 gettreediffs $currentid
961 $cflist insert end "All files"
962 foreach f $treediffs($currentid) {
963 $cflist insert end $f
968 proc gettreediffs {id} {
969 global treediffs parents treepending
971 set treediffs($id) {}
972 set p [lindex $parents($id) 0]
973 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
974 fconfigure $gdtf -blocking 0
975 fileevent $gdtf readable "gettreediffline $gdtf $id"
978 proc gettreediffline {gdtf id} {
979 global treediffs treepending
980 set n [gets $gdtf line]
982 if {![eof $gdtf]} return
988 set type [lindex $line 1]
989 set file [lindex $line 3]
990 if {$type == "blob"} {
991 lappend treediffs($id) $file
995 proc getblobdiffs {id} {
996 global parents diffopts blobdifffd env curdifftag curtagstart
997 set p [lindex $parents($id) 0]
998 set env(GIT_DIFF_OPTS) $diffopts
999 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1000 puts "error getting diffs: $err"
1003 fconfigure $bdf -blocking 0
1004 set blobdifffd($id) $bdf
1005 set curdifftag Comments
1007 fileevent $bdf readable "getblobdiffline $bdf $id"
1010 proc getblobdiffline {bdf id} {
1011 global currentid blobdifffd ctext curdifftag curtagstart
1012 set n [gets $bdf line]
1016 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1017 $ctext tag add $curdifftag $curtagstart end
1022 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1025 $ctext conf -state normal
1026 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
1027 # start of a new file
1028 $ctext insert end "\n"
1029 $ctext tag add $curdifftag $curtagstart end
1030 set curtagstart [$ctext index "end - 1c"]
1031 set curdifftag "f:$fname"
1032 $ctext tag delete $curdifftag
1033 set l [expr {(78 - [string length $fname]) / 2}]
1034 set pad [string range "----------------------------------------" 1 $l]
1035 $ctext insert end "$pad $fname $pad\n" filesep
1036 } elseif {[string range $line 0 2] == "+++"} {
1037 # no need to do anything with this
1038 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1039 $line match f1l f1c f2l f2c rest]} {
1040 $ctext insert end "\t" hunksep
1041 $ctext insert end " $f1l " d0 " $f2l " d1
1042 $ctext insert end " $rest \n" hunksep
1044 set x [string range $line 0 0]
1045 if {$x == "-" || $x == "+"} {
1046 set tag [expr {$x == "+"}]
1047 set line [string range $line 1 end]
1048 $ctext insert end "$line\n" d$tag
1049 } elseif {$x == " "} {
1050 set line [string range $line 1 end]
1051 $ctext insert end "$line\n"
1053 # Something else we don't recognize
1054 if {$curdifftag != "Comments"} {
1055 $ctext insert end "\n"
1056 $ctext tag add $curdifftag $curtagstart end
1057 set curtagstart [$ctext index "end - 1c"]
1058 set curdifftag Comments
1060 $ctext insert end "$line\n" filesep
1063 $ctext conf -state disabled
1066 proc listboxsel {} {
1067 global ctext cflist currentid treediffs
1068 if {![info exists currentid]} return
1069 set sel [$cflist curselection]
1070 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1072 $ctext tag conf Comments -elide 0
1073 foreach f $treediffs($currentid) {
1074 $ctext tag conf "f:$f" -elide 0
1077 # just show selected files
1078 $ctext tag conf Comments -elide 1
1080 foreach f $treediffs($currentid) {
1081 set elide [expr {[lsearch -exact $sel $i] < 0}]
1082 $ctext tag conf "f:$f" -elide $elide
1089 global linespc charspc canvx0 canvy0 mainfont
1090 set linespc [font metrics $mainfont -linespace]
1091 set charspc [font measure $mainfont "m"]
1092 set canvy0 [expr 3 + 0.5 * $linespc]
1093 set canvx0 [expr 3 + 0.5 * $linespc]
1097 global selectedline stopped redisplaying phase
1098 if {$stopped > 1} return
1099 if {$phase == "getcommits"} return
1101 if {$phase == "drawgraph"} {
1108 proc incrfont {inc} {
1109 global mainfont namefont textfont selectedline ctext canv phase
1112 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1113 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1114 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1116 $ctext conf -font $textfont
1117 $ctext tag conf filesep -font [concat $textfont bold]
1118 if {$phase == "getcommits"} {
1119 $canv itemconf textitems -font $mainfont
1133 set diffopts "-U 5 -p"
1135 set mainfont {Helvetica 9}
1136 set namefont $mainfont
1137 set textfont {Courier 9}
1139 lappend namefont bold
1142 set colors {green red blue magenta darkgrey brown orange}
1143 set colorbycommitter false
1145 catch {source ~/.gitk}
1149 switch -regexp -- $arg {
1151 "^-b" { set boldnames 1 }
1152 "^-c" { set colorbycommitter 1 }
1153 "^-d" { set datemode 1 }
1155 puts stderr "unrecognized option $arg"
1159 lappend revtreeargs $arg
1169 getcommits $revtreeargs