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.20 $
12 proc getcommits
{rargs
} {
13 global commits commfd phase canv mainfont
19 if [catch
{set commfd
[open
"|git-rev-list $rargs" r
]} err
] {
20 puts stderr
"Error executing git-rev-list: $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
]} {
38 after idle readallcommits
41 if {[string range
$err 0 4] == "usage"} {
43 Gitk: error reading commits: bad arguments to git-rev-list.\n\
44 (Note: arguments to gitk are passed to git-rev-list\
45 to allow selection of commits to be displayed.)"
47 set err
"Error reading commits: $err"
52 if {![regexp
{^
[0-9a-f]{40}$
} $line]} {
53 error_popup
"Can't parse git-rev-tree output: {$line}"
59 proc readallcommits
{} {
68 proc readcommit
{id
} {
69 global commitinfo children nchildren parents nparents cdate
77 if {![info exists nchildren
($id)]} {
83 if [catch
{set contents
[exec git-cat-file commit
$id]}] return
84 foreach line
[split $contents "\n"] {
89 set tag
[lindex
$line 0]
90 if {$tag == "parent"} {
91 set p
[lindex
$line 1]
92 if {![info exists nchildren
($p)]} {
96 lappend parents
($id) $p
98 if {[lsearch
-exact $children($p) $id] < 0} {
99 lappend children
($p) $id
102 } elseif
{$tag == "author"} {
103 set x
[expr {[llength
$line] - 2}]
104 set audate
[lindex
$line $x]
105 set auname
[lrange
$line 1 [expr {$x - 1}]]
106 } elseif
{$tag == "committer"} {
107 set x
[expr {[llength
$line] - 2}]
108 set comdate
[lindex
$line $x]
109 set comname
[lrange
$line 1 [expr {$x - 1}]]
113 if {$comment == {}} {
122 set audate
[clock format
$audate -format "%Y-%m-%d %H:%M:%S"]
124 if {$comdate != {}} {
125 set cdate
($id) $comdate
126 set comdate
[clock format
$comdate -format "%Y-%m-%d %H:%M:%S"]
128 set commitinfo
($id) [list
$headline $auname $audate \
129 $comname $comdate $comment]
134 set tags
[glob
-nocomplain -types f .git
/refs
/tags
/*]
139 if {[regexp
{^
[0-9a-f]{40}} $line id
]} {
140 set contents
[split [exec git-cat-file tag
$id] "\n"]
144 foreach l
$contents {
146 switch
-- [lindex
$l 0] {
147 "object" {set obj
[lindex
$l 1]}
148 "type" {set type [lindex
$l 1]}
149 "tag" {set tag
[string range
$l 4 end
]}
152 if {$obj != {} && $type == "commit" && $tag != {}} {
153 set tagids
($tag) $obj
154 lappend idtags
($obj) $tag
161 proc error_popup msg
{
165 message
$w.m
-text $msg -justify center
-aspect 400
166 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
167 button
$w.ok
-text OK
-command "destroy $w"
168 pack
$w.ok
-side bottom
-fill x
169 bind $w <Visibility
> "grab $w; focus $w"
174 global canv canv2 canv3 linespc charspc ctext cflist textfont
175 global findtype findloc findstring fstring geometry
176 global entries sha1entry sha1string sha1but
179 .bar add cascade
-label "File" -menu .bar.
file
181 .bar.
file add
command -label "Quit" -command doquit
183 .bar add cascade
-label "Help" -menu .bar.
help
184 .bar.
help add
command -label "About gitk" -command about
185 . configure
-menu .bar
187 if {![info exists geometry
(canv1
)]} {
188 set geometry
(canv1
) [expr 45 * $charspc]
189 set geometry
(canv2
) [expr 30 * $charspc]
190 set geometry
(canv3
) [expr 15 * $charspc]
191 set geometry
(canvh
) [expr 25 * $linespc + 4]
192 set geometry
(ctextw
) 80
193 set geometry
(ctexth
) 30
194 set geometry
(cflistw
) 30
196 panedwindow .ctop
-orient vertical
197 if {[info exists geometry
(width
)]} {
198 .ctop conf
-width $geometry(width
) -height $geometry(height
)
199 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
200 set geometry
(ctexth
) [expr {($texth - 8) /
201 [font metrics
$textfont -linespace]}]
205 pack .ctop.top.bar
-side bottom
-fill x
206 set cscroll .ctop.top.csb
207 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
208 pack
$cscroll -side right
-fill y
209 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
210 pack .ctop.top.clist
-side top
-fill both
-expand 1
212 set canv .ctop.top.clist.canv
213 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
215 -yscrollincr $linespc -yscrollcommand "$cscroll set"
216 .ctop.top.clist add
$canv
217 set canv2 .ctop.top.clist.canv2
218 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
219 -bg white
-bd 0 -yscrollincr $linespc
220 .ctop.top.clist add
$canv2
221 set canv3 .ctop.top.clist.canv3
222 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
223 -bg white
-bd 0 -yscrollincr $linespc
224 .ctop.top.clist add
$canv3
225 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
227 set sha1entry .ctop.top.bar.sha1
228 set entries
$sha1entry
229 set sha1but .ctop.top.bar.sha1label
230 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
231 -command gotocommit
-width 8
232 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
233 pack .ctop.top.bar.sha1label
-side left
234 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
235 trace add variable sha1string
write sha1change
236 pack
$sha1entry -side left
-pady 2
237 button .ctop.top.bar.findbut
-text "Find" -command dofind
238 pack .ctop.top.bar.findbut
-side left
240 set fstring .ctop.top.bar.findstring
241 lappend entries
$fstring
242 entry
$fstring -width 30 -font $textfont -textvariable findstring
243 pack
$fstring -side left
-expand 1 -fill x
245 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
246 set findloc
"All fields"
247 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
248 Comments Author Committer
249 pack .ctop.top.bar.findloc
-side right
250 pack .ctop.top.bar.findtype
-side right
252 panedwindow .ctop.cdet
-orient horizontal
254 frame .ctop.cdet.left
255 set ctext .ctop.cdet.left.ctext
256 text
$ctext -bg white
-state disabled
-font $textfont \
257 -width $geometry(ctextw
) -height $geometry(ctexth
) \
258 -yscrollcommand ".ctop.cdet.left.sb set"
259 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
260 pack .ctop.cdet.left.sb
-side right
-fill y
261 pack
$ctext -side left
-fill both
-expand 1
262 .ctop.cdet add .ctop.cdet.left
264 $ctext tag conf filesep
-font [concat
$textfont bold
]
265 $ctext tag conf hunksep
-back blue
-fore white
266 $ctext tag conf d0
-back "#ff8080"
267 $ctext tag conf d1
-back green
268 $ctext tag conf found
-back yellow
270 frame .ctop.cdet.right
271 set cflist .ctop.cdet.right.cfiles
272 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
273 -yscrollcommand ".ctop.cdet.right.sb set"
274 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
275 pack .ctop.cdet.right.sb
-side right
-fill y
276 pack
$cflist -side left
-fill both
-expand 1
277 .ctop.cdet add .ctop.cdet.right
278 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
280 pack .ctop
-side top
-fill both
-expand 1
282 bindall
<1> {selcanvline
%x
%y
}
283 bindall
<B1-Motion
> {selcanvline
%x
%y
}
284 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
285 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
286 bindall
<2> "allcanvs scan mark 0 %y"
287 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
288 bind .
<Key-Up
> "selnextline -1"
289 bind .
<Key-Down
> "selnextline 1"
290 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
291 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
292 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
293 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
294 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
295 bindkey p
"selnextline -1"
296 bindkey n
"selnextline 1"
297 bindkey b
"$ctext yview scroll -1 pages"
298 bindkey d
"$ctext yview scroll 18 units"
299 bindkey u
"$ctext yview scroll -18 units"
303 bind .
<Control-q
> doquit
304 bind .
<Control-f
> dofind
305 bind .
<Control-g
> findnext
306 bind .
<Control-r
> findprev
307 bind .
<Control-equal
> {incrfont
1}
308 bind .
<Control-KP_Add
> {incrfont
1}
309 bind .
<Control-minus
> {incrfont
-1}
310 bind .
<Control-KP_Subtract
> {incrfont
-1}
311 bind $cflist <<ListboxSelect>> listboxsel
312 bind . <Destroy> {savestuff %W}
313 bind . <Button-1> "click %W"
314 bind $fstring <Key-Return> dofind
315 bind $sha1entry <Key-Return> gotocommit
318 # when we make a key binding for the toplevel, make sure
319 # it doesn't get triggered when that key is pressed in the
320 # find string entry widget.
321 proc bindkey {ev script} {
324 set escript [bind Entry $ev]
325 if {$escript == {}} {
326 set escript [bind Entry <Key>]
329 bind $e $ev "$escript; break"
333 # set the focus back to the toplevel for any click outside
344 global canv canv2 canv3 ctext cflist mainfont textfont
346 if {$stuffsaved} return
347 if {![winfo viewable .]} return
349 set f [open "~/.gitk-new" w]
350 puts $f "set mainfont {$mainfont}"
351 puts $f "set textfont {$textfont}"
352 puts $f "set geometry(width) [winfo width .ctop]"
353 puts $f "set geometry(height) [winfo height .ctop]"
354 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
355 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
356 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
357 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
358 set wid [expr {([winfo width $ctext] - 8) \
359 / [font measure $textfont "0"]}]
360 puts $f "set geometry(ctextw) $wid"
361 set wid [expr {([winfo width $cflist] - 11) \
362 / [font measure [$cflist cget -font] "0"]}]
363 puts $f "set geometry(cflistw) $wid"
365 file rename -force "~/.gitk-new" "~/.gitk"
370 proc resizeclistpanes {win w} {
372 if [info exists oldwidth($win)] {
373 set s0 [$win sash coord 0]
374 set s1 [$win sash coord 1]
376 set sash0 [expr {int($w/2 - 2)}]
377 set sash1 [expr {int($w*5/6 - 2)}]
379 set factor [expr {1.0 * $w / $oldwidth($win)}]
380 set sash0 [expr {int($factor * [lindex $s0 0])}]
381 set sash1 [expr {int($factor * [lindex $s1 0])}]
385 if {$sash1 < $sash0 + 20} {
386 set sash1 [expr $sash0 + 20]
388 if {$sash1 > $w - 10} {
389 set sash1 [expr $w - 10]
390 if {$sash0 > $sash1 - 20} {
391 set sash0 [expr $sash1 - 20]
395 $win sash place 0 $sash0 [lindex $s0 1]
396 $win sash place 1 $sash1 [lindex $s1 1]
398 set oldwidth($win) $w
401 proc resizecdetpanes {win w} {
403 if [info exists oldwidth($win)] {
404 set s0 [$win sash coord 0]
406 set sash0 [expr {int($w*3/4 - 2)}]
408 set factor [expr {1.0 * $w / $oldwidth($win)}]
409 set sash0 [expr {int($factor * [lindex $s0 0])}]
413 if {$sash0 > $w - 15} {
414 set sash0 [expr $w - 15]
417 $win sash place 0 $sash0 [lindex $s0 1]
419 set oldwidth($win) $w
423 global canv canv2 canv3
429 proc bindall {event action} {
430 global canv canv2 canv3
431 bind $canv $event $action
432 bind $canv2 $event $action
433 bind $canv3 $event $action
438 if {[winfo exists $w]} {
443 wm title $w "About gitk"
447 Copyright © 2005 Paul Mackerras
449 Use and redistribute under the terms of the GNU General Public License
451 (CVS $Revision: 1.20 $)} \
452 -justify center -aspect 400
453 pack $w.m -side top -fill x -padx 20 -pady 20
454 button $w.ok -text Close -command "destroy $w"
455 pack $w.ok -side bottom
458 proc truncatetofit {str width font} {
459 if {[font measure $font $str] <= $width} {
463 set bad [string length $str]
465 while {$best < $bad - 1} {
466 set try [expr {int(($best + $bad) / 2)}]
467 set tmp "[string range $str 0 [expr $try-1]]..."
468 if {[font measure $font $tmp] <= $width} {
477 proc assigncolor {id} {
478 global commitinfo colormap commcolors colors nextcolor
479 global colorbycommitter
480 global parents nparents children nchildren
481 if [info exists colormap($id)] return
482 set ncolors [llength $colors]
483 if {$colorbycommitter} {
484 if {![info exists commitinfo($id)]} {
487 set comm [lindex $commitinfo($id) 3]
488 if {![info exists commcolors($comm)]} {
489 set commcolors($comm) [lindex $colors $nextcolor]
490 if {[incr nextcolor] >= $ncolors} {
494 set colormap($id) $commcolors($comm)
496 if {$nparents($id) == 1 && $nchildren($id) == 1} {
497 set child [lindex $children($id) 0]
498 if {[info exists colormap($child)]
499 && $nparents($child) == 1} {
500 set colormap($id) $colormap($child)
505 foreach child $children($id) {
506 if {[info exists colormap($child)]
507 && [lsearch -exact $badcolors $colormap($child)] < 0} {
508 lappend badcolors $colormap($child)
510 if {[info exists parents($child)]} {
511 foreach p $parents($child) {
512 if {[info exists colormap($p)]
513 && [lsearch -exact $badcolors $colormap($p)] < 0} {
514 lappend badcolors $colormap($p)
519 if {[llength $badcolors] >= $ncolors} {
522 for {set i 0} {$i <= $ncolors} {incr i} {
523 set c [lindex $colors $nextcolor]
524 if {[incr nextcolor] >= $ncolors} {
527 if {[lsearch -exact $badcolors $c]} break
534 global parents children nparents nchildren commits
535 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
536 global datemode cdate
537 global lineid linehtag linentag linedtag commitinfo
538 global nextcolor colormap numcommits
539 global stopped phase redisplaying selectedline idtags idline
543 foreach id [array names nchildren] {
544 if {$nchildren($id) == 0} {
547 set ncleft($id) $nchildren($id)
548 if {![info exists nparents($id)]} {
553 error_popup "Gitk: ERROR: No starting commits found"
562 set level [expr [llength $todo] - 1]
568 set lthickness [expr {($linespc / 9) + 1}]
571 allcanvs conf -scrollregion \
572 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
577 set nlines [llength $todo]
578 set id [lindex $todo $level]
579 set lineid($lineno) $id
580 set idline($id) $lineno
583 if {[info exists parents($id)]} {
584 foreach p $parents($id) {
585 if {[info exists ncleft($p)]} {
587 if {![info exists commitinfo($p)]} {
589 if {![info exists commitinfo($p)]} continue
591 lappend actualparents $p
596 if {![info exists commitinfo($id)]} {
598 if {![info exists commitinfo($id)]} {
599 set commitinfo($id) {"No commit information available"}
602 set x [expr $canvx0 + $level * $linespc]
603 set y2 [expr $canvy + $linespc]
604 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
605 set t [$canv create line $x $linestarty($level) $x $canvy \
606 -width $lthickness -fill $colormap($id)]
609 set linestarty($level) $canvy
610 set orad [expr {$linespc / 3}]
611 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
612 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
613 -fill $ofill -outline black -width 1]
615 set xt [expr $canvx0 + $nlines * $linespc]
616 if {$nparents($id) > 2} {
617 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
619 if {[info exists idtags($id)] && $idtags($id) != {}} {
620 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
621 set yt [expr $canvy - 0.5 * $linespc]
622 set yb [expr $yt + $linespc - 1]
625 foreach tag $idtags($id) {
626 set wid [font measure $mainfont $tag]
629 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
631 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \
632 -width $lthickness -fill black]
634 foreach tag $idtags($id) x $xvals wid $wvals {
635 set xl [expr $x + $delta]
636 set xr [expr $x + $delta + $wid + $lthickness]
637 $canv create polygon $x [expr $yt + $delta] $xl $yt\
638 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
639 -width 1 -outline black -fill yellow
640 $canv create text $xl $canvy -anchor w -text $tag \
644 set headline [lindex $commitinfo($id) 0]
645 set name [lindex $commitinfo($id) 1]
646 set date [lindex $commitinfo($id) 2]
647 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
648 -text $headline -font $mainfont ]
649 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
650 -text $name -font $namefont]
651 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
652 -text $date -font $mainfont]
653 if {!$datemode && [llength $actualparents] == 1} {
654 set p [lindex $actualparents 0]
655 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
657 set todo [lreplace $todo $level $level $p]
665 for {set i 0} {$i < $nlines} {incr i} {
666 if {[lindex $todo $i] == {}} continue
667 if {[info exists linestarty($i)]} {
668 set oldstarty($i) $linestarty($i)
672 lappend lines [list $i [lindex $todo $i]]
675 if {$nullentry >= 0} {
676 set todo [lreplace $todo $nullentry $nullentry]
677 if {$nullentry < $level} {
682 set todo [lreplace $todo $level $level]
683 if {$nullentry > $level} {
687 foreach p $actualparents {
688 set k [lsearch -exact $todo $p]
691 set todo [linsert $todo $i $p]
692 if {$nullentry >= $i} {
697 lappend lines [list $oldlevel $p]
700 # choose which one to do next time around
701 set todol [llength $todo]
704 for {set k $todol} {[incr k -1] >= 0} {} {
705 set p [lindex $todo $k]
706 if {$p == {}} continue
707 if {$ncleft($p) == 0} {
709 if {$latest == {} || $cdate($p) > $latest} {
711 set latest $cdate($p)
721 puts "ERROR: none of the pending commits can be done yet:"
729 # If we are reducing, put in a null entry
730 if {$todol < $nlines} {
731 if {$nullentry >= 0} {
734 && [lindex $oldtodo $i] == [lindex $todo $i]} {
747 set todo [linsert $todo $nullentry {}]
758 set dst [lindex $l 1]
759 set j [lsearch -exact $todo $dst]
761 if {[info exists oldstarty($i)]} {
762 set linestarty($i) $oldstarty($i)
766 set xi [expr {$canvx0 + $i * $linespc}]
767 set xj [expr {$canvx0 + $j * $linespc}]
769 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
770 lappend coords $xi $oldstarty($i)
772 lappend coords $xi $canvy
774 lappend coords [expr $xj + $linespc] $canvy
775 } elseif {$j > $i + 1} {
776 lappend coords [expr $xj - $linespc] $canvy
778 lappend coords $xj $y2
779 set t [$canv create line $coords -width $lthickness \
780 -fill $colormap($dst)]
782 if {![info exists linestarty($j)]} {
783 set linestarty($j) $y2
789 if {$stopped == 0 && [info exists selectedline]} {
790 selectline $selectedline
801 proc findmatches {f} {
802 global findtype foundstring foundstrlen
803 if {$findtype == "Regexp"} {
804 set matches [regexp -indices -all -inline $foundstring $f]
806 if {$findtype == "IgnCase"} {
807 set str [string tolower $f]
813 while {[set j [string first $foundstring $str $i]] >= 0} {
814 lappend matches [list $j [expr $j+$foundstrlen-1]]
815 set i [expr $j + $foundstrlen]
822 global findtype findloc findstring markedmatches commitinfo
823 global numcommits lineid linehtag linentag linedtag
824 global mainfont namefont canv canv2 canv3 selectedline
825 global matchinglines foundstring foundstrlen idtags
829 set fldtypes {Headline Author Date Committer CDate Comment}
830 if {$findtype == "IgnCase"} {
831 set foundstring [string tolower $findstring]
833 set foundstring $findstring
835 set foundstrlen [string length $findstring]
836 if {$foundstrlen == 0} return
837 if {![info exists selectedline]} {
840 set oldsel $selectedline
843 for {set l 0} {$l < $numcommits} {incr l} {
845 set info $commitinfo($id)
847 foreach f $info ty $fldtypes {
848 if {$findloc != "All fields" && $findloc != $ty} {
851 set matches [findmatches $f]
852 if {$matches == {}} continue
854 if {$ty == "Headline"} {
855 markmatches $canv $l $f $linehtag($l) $matches $mainfont
856 } elseif {$ty == "Author"} {
857 markmatches $canv2 $l $f $linentag($l) $matches $namefont
858 } elseif {$ty == "Date"} {
859 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
863 lappend matchinglines $l
864 if {!$didsel && $l > $oldsel} {
870 if {$matchinglines == {}} {
872 } elseif {!$didsel} {
873 findselectline [lindex $matchinglines 0]
877 proc findselectline {l} {
878 global findloc commentend ctext
880 if {$findloc == "All fields" || $findloc == "Comments"} {
881 # highlight the matches in the comments
882 set f [$ctext get 1.0 $commentend]
883 set matches [findmatches $f]
884 foreach match $matches {
885 set start [lindex $match 0]
886 set end [expr [lindex $match 1] + 1]
887 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
893 global matchinglines selectedline
894 if {![info exists matchinglines]} {
898 if {![info exists selectedline]} return
899 foreach l $matchinglines {
900 if {$l > $selectedline} {
909 global matchinglines selectedline
910 if {![info exists matchinglines]} {
914 if {![info exists selectedline]} return
916 foreach l $matchinglines {
917 if {$l >= $selectedline} break
927 proc markmatches {canv l str tag matches font} {
928 set bbox [$canv bbox $tag]
929 set x0 [lindex $bbox 0]
930 set y0 [lindex $bbox 1]
931 set y1 [lindex $bbox 3]
932 foreach match $matches {
933 set start [lindex $match 0]
934 set end [lindex $match 1]
935 if {$start > $end} continue
936 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
937 set xlen [font measure $font [string range $str 0 [expr $end]]]
938 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
939 -outline {} -tags matches -fill yellow]
944 proc unmarkmatches {} {
946 allcanvs delete matches
947 catch {unset matchinglines}
950 proc selcanvline {x y} {
951 global canv canvy0 ctext linespc selectedline
952 global lineid linehtag linentag linedtag
953 set ymax [lindex [$canv cget -scrollregion] 3]
954 if {$ymax == {}} return
955 set yfrac [lindex [$canv yview] 0]
956 set y [expr {$y + $yfrac * $ymax}]
957 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
961 if {[info exists selectedline] && $selectedline == $l} return
966 proc selectline {l} {
967 global canv canv2 canv3 ctext commitinfo selectedline
968 global lineid linehtag linentag linedtag
969 global canvy0 linespc nparents treepending
970 global cflist treediffs currentid sha1entry
971 global commentend seenfile numcommits idtags
972 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
974 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
975 -tags secsel -fill [$canv cget -selectbackground]]
978 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
979 -tags secsel -fill [$canv2 cget -selectbackground]]
982 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
983 -tags secsel -fill [$canv3 cget -selectbackground]]
985 set y [expr {$canvy0 + $l * $linespc}]
986 set ymax [lindex [$canv cget -scrollregion] 3]
987 set ytop [expr {$y - $linespc - 1}]
988 set ybot [expr {$y + $linespc + 1}]
989 set wnow [$canv yview]
990 set wtop [expr [lindex $wnow 0] * $ymax]
991 set wbot [expr [lindex $wnow 1] * $ymax]
992 set wh [expr {$wbot - $wtop}]
996 set newtop [expr {$y - $wh / 2.0}]
999 if {$newtop > $wtop - $linespc} {
1000 set newtop [expr {$wtop - $linespc}]
1003 } elseif {$ybot > $wbot} {
1004 if {$ytop > $wbot} {
1005 set newtop [expr {$y - $wh / 2.0}]
1007 set newtop [expr {$ybot - $wh}]
1008 if {$newtop < $wtop + $linespc} {
1009 set newtop [expr {$wtop + $linespc}]
1013 if {$newtop != $wtop} {
1017 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1023 $sha1entry delete 0 end
1024 $sha1entry insert 0 $id
1025 $sha1entry selection from 0
1026 $sha1entry selection to end
1028 $ctext conf -state normal
1029 $ctext delete 0.0 end
1030 set info $commitinfo($id)
1031 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1032 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1033 if {[info exists idtags($id)]} {
1034 $ctext insert end "Tags:"
1035 foreach tag $idtags($id) {
1036 $ctext insert end " $tag"
1038 $ctext insert end "\n"
1040 $ctext insert end "\n"
1041 $ctext insert end [lindex $info 5]
1042 $ctext insert end "\n"
1043 $ctext tag delete Comments
1044 $ctext tag remove found 1.0 end
1045 $ctext conf -state disabled
1046 set commentend [$ctext index "end - 1c"]
1048 $cflist delete 0 end
1049 if {$nparents($id) == 1} {
1050 if {![info exists treediffs($id)]} {
1051 if {![info exists treepending]} {
1058 catch {unset seenfile}
1061 proc selnextline {dir} {
1063 if {![info exists selectedline]} return
1064 set l [expr $selectedline + $dir]
1069 proc addtocflist {id} {
1070 global currentid treediffs cflist treepending
1071 if {$id != $currentid} {
1072 gettreediffs $currentid
1075 $cflist insert end "All files"
1076 foreach f $treediffs($currentid) {
1077 $cflist insert end $f
1082 proc gettreediffs {id} {
1083 global treediffs parents treepending
1085 set treediffs($id) {}
1086 set p [lindex $parents($id) 0]
1087 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1088 fconfigure $gdtf -blocking 0
1089 fileevent $gdtf readable "gettreediffline $gdtf $id"
1092 proc gettreediffline {gdtf id} {
1093 global treediffs treepending
1094 set n [gets $gdtf line]
1096 if {![eof $gdtf]} return
1102 set file [lindex $line 5]
1103 lappend treediffs($id) $file
1106 proc getblobdiffs {id} {
1107 global parents diffopts blobdifffd env curdifftag curtagstart
1108 global diffindex difffilestart
1109 set p [lindex $parents($id) 0]
1110 set env(GIT_DIFF_OPTS) $diffopts
1111 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1112 puts "error getting diffs: $err"
1115 fconfigure $bdf -blocking 0
1116 set blobdifffd($id) $bdf
1117 set curdifftag Comments
1120 catch {unset difffilestart}
1121 fileevent $bdf readable "getblobdiffline $bdf $id"
1124 proc getblobdiffline {bdf id} {
1125 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1126 global diffnexthead diffnextnote diffindex difffilestart
1127 set n [gets $bdf line]
1131 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1132 $ctext tag add $curdifftag $curtagstart end
1133 set seenfile($curdifftag) 1
1138 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1141 $ctext conf -state normal
1142 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1143 # start of a new file
1144 $ctext insert end "\n"
1145 $ctext tag add $curdifftag $curtagstart end
1146 set seenfile($curdifftag) 1
1147 set curtagstart [$ctext index "end - 1c"]
1149 if {[info exists diffnexthead]} {
1150 set fname $diffnexthead
1151 set header "$diffnexthead ($diffnextnote)"
1154 set difffilestart($diffindex) [$ctext index "end - 1c"]
1156 set curdifftag "f:$fname"
1157 $ctext tag delete $curdifftag
1158 set l [expr {(78 - [string length $header]) / 2}]
1159 set pad [string range "----------------------------------------" 1 $l]
1160 $ctext insert end "$pad $header $pad\n" filesep
1161 } elseif {[string range $line 0 2] == "+++"} {
1162 # no need to do anything with this
1163 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1164 set diffnexthead $fn
1165 set diffnextnote "created, mode $m"
1166 } elseif {[string range $line 0 8] == "Deleted: "} {
1167 set diffnexthead [string range $line 9 end]
1168 set diffnextnote "deleted"
1169 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1170 # save the filename in case the next thing is "new file mode ..."
1171 set diffnexthead $fn
1172 set diffnextnote "modified"
1173 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1174 set diffnextnote "new file, mode $m"
1175 } elseif {[string range $line 0 11] == "deleted file"} {
1176 set diffnextnote "deleted"
1177 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1178 $line match f1l f1c f2l f2c rest]} {
1179 $ctext insert end "\t" hunksep
1180 $ctext insert end " $f1l " d0 " $f2l " d1
1181 $ctext insert end " $rest \n" hunksep
1183 set x [string range $line 0 0]
1184 if {$x == "-" || $x == "+"} {
1185 set tag [expr {$x == "+"}]
1186 set line [string range $line 1 end]
1187 $ctext insert end "$line\n" d$tag
1188 } elseif {$x == " "} {
1189 set line [string range $line 1 end]
1190 $ctext insert end "$line\n"
1191 } elseif {$x == "\\"} {
1192 # e.g. "\ No newline at end of file"
1193 $ctext insert end "$line\n" filesep
1195 # Something else we don't recognize
1196 if {$curdifftag != "Comments"} {
1197 $ctext insert end "\n"
1198 $ctext tag add $curdifftag $curtagstart end
1199 set seenfile($curdifftag) 1
1200 set curtagstart [$ctext index "end - 1c"]
1201 set curdifftag Comments
1203 $ctext insert end "$line\n" filesep
1206 $ctext conf -state disabled
1210 global difffilestart ctext
1211 set here [$ctext index @0,0]
1212 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1213 if {[$ctext compare $difffilestart($i) > $here]} {
1214 $ctext yview $difffilestart($i)
1220 proc listboxsel {} {
1221 global ctext cflist currentid treediffs seenfile
1222 if {![info exists currentid]} return
1223 set sel [$cflist curselection]
1224 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1226 $ctext tag conf Comments -elide 0
1227 foreach f $treediffs($currentid) {
1228 if [info exists seenfile(f:$f)] {
1229 $ctext tag conf "f:$f" -elide 0
1233 # just show selected files
1234 $ctext tag conf Comments -elide 1
1236 foreach f $treediffs($currentid) {
1237 set elide [expr {[lsearch -exact $sel $i] < 0}]
1238 if [info exists seenfile(f:$f)] {
1239 $ctext tag conf "f:$f" -elide $elide
1247 global linespc charspc canvx0 canvy0 mainfont
1248 set linespc [font metrics $mainfont -linespace]
1249 set charspc [font measure $mainfont "m"]
1250 set canvy0 [expr 3 + 0.5 * $linespc]
1251 set canvx0 [expr 3 + 0.5 * $linespc]
1255 global selectedline stopped redisplaying phase
1256 if {$stopped > 1} return
1257 if {$phase == "getcommits"} return
1259 if {$phase == "drawgraph"} {
1266 proc incrfont {inc} {
1267 global mainfont namefont textfont selectedline ctext canv phase
1268 global stopped entries
1270 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1271 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1272 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1274 $ctext conf -font $textfont
1275 $ctext tag conf filesep -font [concat $textfont bold]
1276 foreach e $entries {
1277 $e conf -font $mainfont
1279 if {$phase == "getcommits"} {
1280 $canv itemconf textitems -font $mainfont
1285 proc sha1change {n1 n2 op} {
1286 global sha1string currentid sha1but
1287 if {$sha1string == {}
1288 || ([info exists currentid] && $sha1string == $currentid)} {
1293 if {[$sha1but cget -state] == $state} return
1294 if {$state == "normal"} {
1295 $sha1but conf -state normal -relief raised -text "Goto: "
1297 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1301 proc gotocommit {} {
1302 global sha1string currentid idline tagids
1303 if {$sha1string == {}
1304 || ([info exists currentid] && $sha1string == $currentid)} return
1305 if {[info exists tagids($sha1string)]} {
1306 set id $tagids($sha1string)
1308 set id [string tolower $sha1string]
1310 if {[info exists idline($id)]} {
1311 selectline $idline($id)
1314 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1319 error_popup "$type $sha1string is not known"
1331 set diffopts "-U 5 -p"
1333 set mainfont {Helvetica 9}
1334 set textfont {Courier 9}
1336 set colors {green red blue magenta darkgrey brown orange}
1337 set colorbycommitter false
1339 catch {source ~/.gitk}
1341 set namefont $mainfont
1343 lappend namefont bold
1348 switch -regexp -- $arg {
1350 "^-b" { set boldnames 1 }
1351 "^-c" { set colorbycommitter 1 }
1352 "^-d" { set datemode 1 }
1354 lappend revtreeargs $arg
1365 getcommits $revtreeargs