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.21 $
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-list 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]
133 global tagids idtags headids idheads
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
160 set heads [glob -nocomplain -types f .git/refs/heads/*]
164 set line [read $fd 40]
165 if {[regexp {^[0-9a-f]{40}} $line id]} {
166 set head [file tail $f]
167 set headids($head) $line
168 lappend idheads($line) $head
175 proc error_popup msg {
179 message $w.m -text $msg -justify center -aspect 400
180 pack $w.m -side top -fill x -padx 20 -pady 20
181 button $w.ok -text OK -command "destroy $w"
182 pack $w.ok -side bottom -fill x
183 bind $w <Visibility> "grab $w; focus $w"
188 global canv canv2 canv3 linespc charspc ctext cflist textfont
189 global findtype findloc findstring fstring geometry
190 global entries sha1entry sha1string sha1but
193 .bar add cascade -label "File" -menu .bar.file
195 .bar.file add command -label "Quit" -command doquit
197 .bar add cascade -label "Help" -menu .bar.help
198 .bar.help add command -label "About gitk" -command about
199 . configure -menu .bar
201 if {![info exists geometry(canv1)]} {
202 set geometry(canv1) [expr 45 * $charspc]
203 set geometry(canv2) [expr 30 * $charspc]
204 set geometry(canv3) [expr 15 * $charspc]
205 set geometry(canvh) [expr 25 * $linespc + 4]
206 set geometry(ctextw) 80
207 set geometry(ctexth) 30
208 set geometry(cflistw) 30
210 panedwindow .ctop -orient vertical
211 if {[info exists geometry(width)]} {
212 .ctop conf -width $geometry(width) -height $geometry(height)
213 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
214 set geometry(ctexth) [expr {($texth - 8) /
215 [font metrics $textfont -linespace]}]
219 pack .ctop.top.bar -side bottom -fill x
220 set cscroll .ctop.top.csb
221 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
222 pack $cscroll -side right -fill y
223 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
224 pack .ctop.top.clist -side top -fill both -expand 1
226 set canv .ctop.top.clist.canv
227 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
229 -yscrollincr $linespc -yscrollcommand "$cscroll set"
230 .ctop.top.clist add $canv
231 set canv2 .ctop.top.clist.canv2
232 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
233 -bg white -bd 0 -yscrollincr $linespc
234 .ctop.top.clist add $canv2
235 set canv3 .ctop.top.clist.canv3
236 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
237 -bg white -bd 0 -yscrollincr $linespc
238 .ctop.top.clist add $canv3
239 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
241 set sha1entry .ctop.top.bar.sha1
242 set entries $sha1entry
243 set sha1but .ctop.top.bar.sha1label
244 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
245 -command gotocommit -width 8
246 $sha1but conf -disabledforeground [$sha1but cget -foreground]
247 pack .ctop.top.bar.sha1label -side left
248 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
249 trace add variable sha1string write sha1change
250 pack $sha1entry -side left -pady 2
251 button .ctop.top.bar.findbut -text "Find" -command dofind
252 pack .ctop.top.bar.findbut -side left
254 set fstring .ctop.top.bar.findstring
255 lappend entries $fstring
256 entry $fstring -width 30 -font $textfont -textvariable findstring
257 pack $fstring -side left -expand 1 -fill x
259 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
260 set findloc "All fields"
261 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
262 Comments Author Committer
263 pack .ctop.top.bar.findloc -side right
264 pack .ctop.top.bar.findtype -side right
266 panedwindow .ctop.cdet -orient horizontal
268 frame .ctop.cdet.left
269 set ctext .ctop.cdet.left.ctext
270 text $ctext -bg white -state disabled -font $textfont \
271 -width $geometry(ctextw) -height $geometry(ctexth) \
272 -yscrollcommand ".ctop.cdet.left.sb set"
273 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
274 pack .ctop.cdet.left.sb -side right -fill y
275 pack $ctext -side left -fill both -expand 1
276 .ctop.cdet add .ctop.cdet.left
278 $ctext tag conf filesep -font [concat $textfont bold]
279 $ctext tag conf hunksep -back blue -fore white
280 $ctext tag conf d0 -back "#ff8080"
281 $ctext tag conf d1 -back green
282 $ctext tag conf found -back yellow
284 frame .ctop.cdet.right
285 set cflist .ctop.cdet.right.cfiles
286 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
287 -yscrollcommand ".ctop.cdet.right.sb set"
288 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
289 pack .ctop.cdet.right.sb -side right -fill y
290 pack $cflist -side left -fill both -expand 1
291 .ctop.cdet add .ctop.cdet.right
292 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
294 pack .ctop -side top -fill both -expand 1
296 bindall <1> {selcanvline %x %y}
297 bindall <B1-Motion> {selcanvline %x %y}
298 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
299 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
300 bindall <2> "allcanvs scan mark 0 %y"
301 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
302 bind . <Key-Up> "selnextline -1"
303 bind . <Key-Down> "selnextline 1"
304 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
305 bind . <Key-Next> "allcanvs yview scroll 1 pages"
306 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
307 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
308 bindkey <Key-space> "$ctext yview scroll 1 pages"
309 bindkey p "selnextline -1"
310 bindkey n "selnextline 1"
311 bindkey b "$ctext yview scroll -1 pages"
312 bindkey d "$ctext yview scroll 18 units"
313 bindkey u "$ctext yview scroll -18 units"
317 bind . <Control-q> doquit
318 bind . <Control-f> dofind
319 bind . <Control-g> findnext
320 bind . <Control-r> findprev
321 bind . <Control-equal> {incrfont 1}
322 bind . <Control-KP_Add> {incrfont 1}
323 bind . <Control-minus> {incrfont -1}
324 bind . <Control-KP_Subtract> {incrfont -1}
325 bind $cflist <<ListboxSelect>> listboxsel
326 bind . <Destroy> {savestuff %W}
327 bind . <Button-1> "click %W"
328 bind $fstring <Key-Return> dofind
329 bind $sha1entry <Key-Return> gotocommit
332 # when we make a key binding for the toplevel, make sure
333 # it doesn't get triggered when that key is pressed in the
334 # find string entry widget.
335 proc bindkey {ev script} {
338 set escript [bind Entry $ev]
339 if {$escript == {}} {
340 set escript [bind Entry <Key>]
343 bind $e $ev "$escript; break"
347 # set the focus back to the toplevel for any click outside
358 global canv canv2 canv3 ctext cflist mainfont textfont
360 if {$stuffsaved} return
361 if {![winfo viewable .]} return
363 set f [open "~/.gitk-new" w]
364 puts $f "set mainfont {$mainfont}"
365 puts $f "set textfont {$textfont}"
366 puts $f "set geometry(width) [winfo width .ctop]"
367 puts $f "set geometry(height) [winfo height .ctop]"
368 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
369 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
370 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
371 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
372 set wid [expr {([winfo width $ctext] - 8) \
373 / [font measure $textfont "0"]}]
374 puts $f "set geometry(ctextw) $wid"
375 set wid [expr {([winfo width $cflist] - 11) \
376 / [font measure [$cflist cget -font] "0"]}]
377 puts $f "set geometry(cflistw) $wid"
379 file rename -force "~/.gitk-new" "~/.gitk"
384 proc resizeclistpanes {win w} {
386 if [info exists oldwidth($win)] {
387 set s0 [$win sash coord 0]
388 set s1 [$win sash coord 1]
390 set sash0 [expr {int($w/2 - 2)}]
391 set sash1 [expr {int($w*5/6 - 2)}]
393 set factor [expr {1.0 * $w / $oldwidth($win)}]
394 set sash0 [expr {int($factor * [lindex $s0 0])}]
395 set sash1 [expr {int($factor * [lindex $s1 0])}]
399 if {$sash1 < $sash0 + 20} {
400 set sash1 [expr $sash0 + 20]
402 if {$sash1 > $w - 10} {
403 set sash1 [expr $w - 10]
404 if {$sash0 > $sash1 - 20} {
405 set sash0 [expr $sash1 - 20]
409 $win sash place 0 $sash0 [lindex $s0 1]
410 $win sash place 1 $sash1 [lindex $s1 1]
412 set oldwidth($win) $w
415 proc resizecdetpanes {win w} {
417 if [info exists oldwidth($win)] {
418 set s0 [$win sash coord 0]
420 set sash0 [expr {int($w*3/4 - 2)}]
422 set factor [expr {1.0 * $w / $oldwidth($win)}]
423 set sash0 [expr {int($factor * [lindex $s0 0])}]
427 if {$sash0 > $w - 15} {
428 set sash0 [expr $w - 15]
431 $win sash place 0 $sash0 [lindex $s0 1]
433 set oldwidth($win) $w
437 global canv canv2 canv3
443 proc bindall {event action} {
444 global canv canv2 canv3
445 bind $canv $event $action
446 bind $canv2 $event $action
447 bind $canv3 $event $action
452 if {[winfo exists $w]} {
457 wm title $w "About gitk"
461 Copyright © 2005 Paul Mackerras
463 Use and redistribute under the terms of the GNU General Public License
465 (CVS $Revision: 1.21 $)} \
466 -justify center -aspect 400
467 pack $w.m -side top -fill x -padx 20 -pady 20
468 button $w.ok -text Close -command "destroy $w"
469 pack $w.ok -side bottom
472 proc truncatetofit {str width font} {
473 if {[font measure $font $str] <= $width} {
477 set bad [string length $str]
479 while {$best < $bad - 1} {
480 set try [expr {int(($best + $bad) / 2)}]
481 set tmp "[string range $str 0 [expr $try-1]]..."
482 if {[font measure $font $tmp] <= $width} {
491 proc assigncolor {id} {
492 global commitinfo colormap commcolors colors nextcolor
493 global colorbycommitter
494 global parents nparents children nchildren
495 if [info exists colormap($id)] return
496 set ncolors [llength $colors]
497 if {$colorbycommitter} {
498 if {![info exists commitinfo($id)]} {
501 set comm [lindex $commitinfo($id) 3]
502 if {![info exists commcolors($comm)]} {
503 set commcolors($comm) [lindex $colors $nextcolor]
504 if {[incr nextcolor] >= $ncolors} {
508 set colormap($id) $commcolors($comm)
510 if {$nparents($id) == 1 && $nchildren($id) == 1} {
511 set child [lindex $children($id) 0]
512 if {[info exists colormap($child)]
513 && $nparents($child) == 1} {
514 set colormap($id) $colormap($child)
519 foreach child $children($id) {
520 if {[info exists colormap($child)]
521 && [lsearch -exact $badcolors $colormap($child)] < 0} {
522 lappend badcolors $colormap($child)
524 if {[info exists parents($child)]} {
525 foreach p $parents($child) {
526 if {[info exists colormap($p)]
527 && [lsearch -exact $badcolors $colormap($p)] < 0} {
528 lappend badcolors $colormap($p)
533 if {[llength $badcolors] >= $ncolors} {
536 for {set i 0} {$i <= $ncolors} {incr i} {
537 set c [lindex $colors $nextcolor]
538 if {[incr nextcolor] >= $ncolors} {
541 if {[lsearch -exact $badcolors $c]} break
548 global parents children nparents nchildren commits
549 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
550 global datemode cdate
551 global lineid linehtag linentag linedtag commitinfo
552 global nextcolor colormap numcommits
553 global stopped phase redisplaying selectedline idtags idline
558 foreach id [array names nchildren] {
559 if {$nchildren($id) == 0} {
562 set ncleft($id) $nchildren($id)
563 if {![info exists nparents($id)]} {
568 error_popup "Gitk: ERROR: No starting commits found"
577 set level [expr [llength $todo] - 1]
583 set lthickness [expr {($linespc / 9) + 1}]
586 allcanvs conf -scrollregion \
587 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
592 set nlines [llength $todo]
593 set id [lindex $todo $level]
594 set lineid($lineno) $id
595 set idline($id) $lineno
598 if {[info exists parents($id)]} {
599 foreach p $parents($id) {
600 if {[info exists ncleft($p)]} {
602 if {![info exists commitinfo($p)]} {
604 if {![info exists commitinfo($p)]} continue
606 lappend actualparents $p
611 if {![info exists commitinfo($id)]} {
613 if {![info exists commitinfo($id)]} {
614 set commitinfo($id) {"No commit information available"}
617 set x [expr $canvx0 + $level * $linespc]
618 set y2 [expr $canvy + $linespc]
619 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
620 set t [$canv create line $x $linestarty($level) $x $canvy \
621 -width $lthickness -fill $colormap($id)]
624 set linestarty($level) $canvy
625 set orad [expr {$linespc / 3}]
626 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
627 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
628 -fill $ofill -outline black -width 1]
630 set xt [expr $canvx0 + $nlines * $linespc]
631 if {$nparents($id) > 2} {
632 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
636 if {[info exists idtags($id)]} {
637 set marks $idtags($id)
638 set ntags [llength $marks]
640 if {[info exists idheads($id)]} {
641 set marks [concat $marks $idheads($id)]
644 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
645 set yt [expr $canvy - 0.5 * $linespc]
646 set yb [expr $yt + $linespc - 1]
650 set wid [font measure $mainfont $tag]
653 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
655 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \
656 -width $lthickness -fill black]
658 foreach tag $marks x $xvals wid $wvals {
659 set xl [expr $x + $delta]
660 set xr [expr $x + $delta + $wid + $lthickness]
661 if {[incr ntags -1] >= 0} {
663 $canv create polygon $x [expr $yt + $delta] $xl $yt\
664 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
665 -width 1 -outline black -fill yellow
668 set xl [expr $xl - $delta/2]
669 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
670 -width 1 -outline black -fill green
672 $canv create text $xl $canvy -anchor w -text $tag \
676 set headline [lindex $commitinfo($id) 0]
677 set name [lindex $commitinfo($id) 1]
678 set date [lindex $commitinfo($id) 2]
679 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
680 -text $headline -font $mainfont ]
681 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
682 -text $name -font $namefont]
683 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
684 -text $date -font $mainfont]
685 if {!$datemode && [llength $actualparents] == 1} {
686 set p [lindex $actualparents 0]
687 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
689 set todo [lreplace $todo $level $level $p]
697 for {set i 0} {$i < $nlines} {incr i} {
698 if {[lindex $todo $i] == {}} continue
699 if {[info exists linestarty($i)]} {
700 set oldstarty($i) $linestarty($i)
704 lappend lines [list $i [lindex $todo $i]]
707 if {$nullentry >= 0} {
708 set todo [lreplace $todo $nullentry $nullentry]
709 if {$nullentry < $level} {
714 set todo [lreplace $todo $level $level]
715 if {$nullentry > $level} {
719 foreach p $actualparents {
720 set k [lsearch -exact $todo $p]
723 set todo [linsert $todo $i $p]
724 if {$nullentry >= $i} {
729 lappend lines [list $oldlevel $p]
732 # choose which one to do next time around
733 set todol [llength $todo]
736 for {set k $todol} {[incr k -1] >= 0} {} {
737 set p [lindex $todo $k]
738 if {$p == {}} continue
739 if {$ncleft($p) == 0} {
741 if {$latest == {} || $cdate($p) > $latest} {
743 set latest $cdate($p)
753 puts "ERROR: none of the pending commits can be done yet:"
761 # If we are reducing, put in a null entry
762 if {$todol < $nlines} {
763 if {$nullentry >= 0} {
766 && [lindex $oldtodo $i] == [lindex $todo $i]} {
779 set todo [linsert $todo $nullentry {}]
790 set dst [lindex $l 1]
791 set j [lsearch -exact $todo $dst]
793 if {[info exists oldstarty($i)]} {
794 set linestarty($i) $oldstarty($i)
798 set xi [expr {$canvx0 + $i * $linespc}]
799 set xj [expr {$canvx0 + $j * $linespc}]
801 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
802 lappend coords $xi $oldstarty($i)
804 lappend coords $xi $canvy
806 lappend coords [expr $xj + $linespc] $canvy
807 } elseif {$j > $i + 1} {
808 lappend coords [expr $xj - $linespc] $canvy
810 lappend coords $xj $y2
811 set t [$canv create line $coords -width $lthickness \
812 -fill $colormap($dst)]
814 if {![info exists linestarty($j)]} {
815 set linestarty($j) $y2
821 if {$stopped == 0 && [info exists selectedline]} {
822 selectline $selectedline
833 proc findmatches {f} {
834 global findtype foundstring foundstrlen
835 if {$findtype == "Regexp"} {
836 set matches [regexp -indices -all -inline $foundstring $f]
838 if {$findtype == "IgnCase"} {
839 set str [string tolower $f]
845 while {[set j [string first $foundstring $str $i]] >= 0} {
846 lappend matches [list $j [expr $j+$foundstrlen-1]]
847 set i [expr $j + $foundstrlen]
854 global findtype findloc findstring markedmatches commitinfo
855 global numcommits lineid linehtag linentag linedtag
856 global mainfont namefont canv canv2 canv3 selectedline
857 global matchinglines foundstring foundstrlen idtags
861 set fldtypes {Headline Author Date Committer CDate Comment}
862 if {$findtype == "IgnCase"} {
863 set foundstring [string tolower $findstring]
865 set foundstring $findstring
867 set foundstrlen [string length $findstring]
868 if {$foundstrlen == 0} return
869 if {![info exists selectedline]} {
872 set oldsel $selectedline
875 for {set l 0} {$l < $numcommits} {incr l} {
877 set info $commitinfo($id)
879 foreach f $info ty $fldtypes {
880 if {$findloc != "All fields" && $findloc != $ty} {
883 set matches [findmatches $f]
884 if {$matches == {}} continue
886 if {$ty == "Headline"} {
887 markmatches $canv $l $f $linehtag($l) $matches $mainfont
888 } elseif {$ty == "Author"} {
889 markmatches $canv2 $l $f $linentag($l) $matches $namefont
890 } elseif {$ty == "Date"} {
891 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
895 lappend matchinglines $l
896 if {!$didsel && $l > $oldsel} {
902 if {$matchinglines == {}} {
904 } elseif {!$didsel} {
905 findselectline [lindex $matchinglines 0]
909 proc findselectline {l} {
910 global findloc commentend ctext
912 if {$findloc == "All fields" || $findloc == "Comments"} {
913 # highlight the matches in the comments
914 set f [$ctext get 1.0 $commentend]
915 set matches [findmatches $f]
916 foreach match $matches {
917 set start [lindex $match 0]
918 set end [expr [lindex $match 1] + 1]
919 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
925 global matchinglines selectedline
926 if {![info exists matchinglines]} {
930 if {![info exists selectedline]} return
931 foreach l $matchinglines {
932 if {$l > $selectedline} {
941 global matchinglines selectedline
942 if {![info exists matchinglines]} {
946 if {![info exists selectedline]} return
948 foreach l $matchinglines {
949 if {$l >= $selectedline} break
959 proc markmatches {canv l str tag matches font} {
960 set bbox [$canv bbox $tag]
961 set x0 [lindex $bbox 0]
962 set y0 [lindex $bbox 1]
963 set y1 [lindex $bbox 3]
964 foreach match $matches {
965 set start [lindex $match 0]
966 set end [lindex $match 1]
967 if {$start > $end} continue
968 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
969 set xlen [font measure $font [string range $str 0 [expr $end]]]
970 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
971 -outline {} -tags matches -fill yellow]
976 proc unmarkmatches {} {
978 allcanvs delete matches
979 catch {unset matchinglines}
982 proc selcanvline {x y} {
983 global canv canvy0 ctext linespc selectedline
984 global lineid linehtag linentag linedtag
985 set ymax [lindex [$canv cget -scrollregion] 3]
986 if {$ymax == {}} return
987 set yfrac [lindex [$canv yview] 0]
988 set y [expr {$y + $yfrac * $ymax}]
989 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
993 if {[info exists selectedline] && $selectedline == $l} return
998 proc selectline {l} {
999 global canv canv2 canv3 ctext commitinfo selectedline
1000 global lineid linehtag linentag linedtag
1001 global canvy0 linespc nparents treepending
1002 global cflist treediffs currentid sha1entry
1003 global commentend seenfile numcommits idtags
1004 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1006 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1007 -tags secsel -fill [$canv cget -selectbackground]]
1009 $canv2 delete secsel
1010 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1011 -tags secsel -fill [$canv2 cget -selectbackground]]
1013 $canv3 delete secsel
1014 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1015 -tags secsel -fill [$canv3 cget -selectbackground]]
1017 set y [expr {$canvy0 + $l * $linespc}]
1018 set ymax [lindex [$canv cget -scrollregion] 3]
1019 set ytop [expr {$y - $linespc - 1}]
1020 set ybot [expr {$y + $linespc + 1}]
1021 set wnow [$canv yview]
1022 set wtop [expr [lindex $wnow 0] * $ymax]
1023 set wbot [expr [lindex $wnow 1] * $ymax]
1024 set wh [expr {$wbot - $wtop}]
1026 if {$ytop < $wtop} {
1027 if {$ybot < $wtop} {
1028 set newtop [expr {$y - $wh / 2.0}]
1031 if {$newtop > $wtop - $linespc} {
1032 set newtop [expr {$wtop - $linespc}]
1035 } elseif {$ybot > $wbot} {
1036 if {$ytop > $wbot} {
1037 set newtop [expr {$y - $wh / 2.0}]
1039 set newtop [expr {$ybot - $wh}]
1040 if {$newtop < $wtop + $linespc} {
1041 set newtop [expr {$wtop + $linespc}]
1045 if {$newtop != $wtop} {
1049 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1055 $sha1entry delete 0 end
1056 $sha1entry insert 0 $id
1057 $sha1entry selection from 0
1058 $sha1entry selection to end
1060 $ctext conf -state normal
1061 $ctext delete 0.0 end
1062 set info $commitinfo($id)
1063 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1064 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1065 if {[info exists idtags($id)]} {
1066 $ctext insert end "Tags:"
1067 foreach tag $idtags($id) {
1068 $ctext insert end " $tag"
1070 $ctext insert end "\n"
1072 $ctext insert end "\n"
1073 $ctext insert end [lindex $info 5]
1074 $ctext insert end "\n"
1075 $ctext tag delete Comments
1076 $ctext tag remove found 1.0 end
1077 $ctext conf -state disabled
1078 set commentend [$ctext index "end - 1c"]
1080 $cflist delete 0 end
1081 if {$nparents($id) == 1} {
1082 if {![info exists treediffs($id)]} {
1083 if {![info exists treepending]} {
1090 catch {unset seenfile}
1093 proc selnextline {dir} {
1095 if {![info exists selectedline]} return
1096 set l [expr $selectedline + $dir]
1101 proc addtocflist {id} {
1102 global currentid treediffs cflist treepending
1103 if {$id != $currentid} {
1104 gettreediffs $currentid
1107 $cflist insert end "All files"
1108 foreach f $treediffs($currentid) {
1109 $cflist insert end $f
1114 proc gettreediffs {id} {
1115 global treediffs parents treepending
1117 set treediffs($id) {}
1118 set p [lindex $parents($id) 0]
1119 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1120 fconfigure $gdtf -blocking 0
1121 fileevent $gdtf readable "gettreediffline $gdtf $id"
1124 proc gettreediffline {gdtf id} {
1125 global treediffs treepending
1126 set n [gets $gdtf line]
1128 if {![eof $gdtf]} return
1134 set file [lindex $line 5]
1135 lappend treediffs($id) $file
1138 proc getblobdiffs {id} {
1139 global parents diffopts blobdifffd env curdifftag curtagstart
1140 global diffindex difffilestart
1141 set p [lindex $parents($id) 0]
1142 set env(GIT_DIFF_OPTS) $diffopts
1143 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1144 puts "error getting diffs: $err"
1147 fconfigure $bdf -blocking 0
1148 set blobdifffd($id) $bdf
1149 set curdifftag Comments
1152 catch {unset difffilestart}
1153 fileevent $bdf readable "getblobdiffline $bdf $id"
1156 proc getblobdiffline {bdf id} {
1157 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1158 global diffnexthead diffnextnote diffindex difffilestart
1159 set n [gets $bdf line]
1163 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1164 $ctext tag add $curdifftag $curtagstart end
1165 set seenfile($curdifftag) 1
1170 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1173 $ctext conf -state normal
1174 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1175 # start of a new file
1176 $ctext insert end "\n"
1177 $ctext tag add $curdifftag $curtagstart end
1178 set seenfile($curdifftag) 1
1179 set curtagstart [$ctext index "end - 1c"]
1181 if {[info exists diffnexthead]} {
1182 set fname $diffnexthead
1183 set header "$diffnexthead ($diffnextnote)"
1186 set difffilestart($diffindex) [$ctext index "end - 1c"]
1188 set curdifftag "f:$fname"
1189 $ctext tag delete $curdifftag
1190 set l [expr {(78 - [string length $header]) / 2}]
1191 set pad [string range "----------------------------------------" 1 $l]
1192 $ctext insert end "$pad $header $pad\n" filesep
1193 } elseif {[string range $line 0 2] == "+++"} {
1194 # no need to do anything with this
1195 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1196 set diffnexthead $fn
1197 set diffnextnote "created, mode $m"
1198 } elseif {[string range $line 0 8] == "Deleted: "} {
1199 set diffnexthead [string range $line 9 end]
1200 set diffnextnote "deleted"
1201 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1202 # save the filename in case the next thing is "new file mode ..."
1203 set diffnexthead $fn
1204 set diffnextnote "modified"
1205 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1206 set diffnextnote "new file, mode $m"
1207 } elseif {[string range $line 0 11] == "deleted file"} {
1208 set diffnextnote "deleted"
1209 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1210 $line match f1l f1c f2l f2c rest]} {
1211 $ctext insert end "\t" hunksep
1212 $ctext insert end " $f1l " d0 " $f2l " d1
1213 $ctext insert end " $rest \n" hunksep
1215 set x [string range $line 0 0]
1216 if {$x == "-" || $x == "+"} {
1217 set tag [expr {$x == "+"}]
1218 set line [string range $line 1 end]
1219 $ctext insert end "$line\n" d$tag
1220 } elseif {$x == " "} {
1221 set line [string range $line 1 end]
1222 $ctext insert end "$line\n"
1223 } elseif {$x == "\\"} {
1224 # e.g. "\ No newline at end of file"
1225 $ctext insert end "$line\n" filesep
1227 # Something else we don't recognize
1228 if {$curdifftag != "Comments"} {
1229 $ctext insert end "\n"
1230 $ctext tag add $curdifftag $curtagstart end
1231 set seenfile($curdifftag) 1
1232 set curtagstart [$ctext index "end - 1c"]
1233 set curdifftag Comments
1235 $ctext insert end "$line\n" filesep
1238 $ctext conf -state disabled
1242 global difffilestart ctext
1243 set here [$ctext index @0,0]
1244 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1245 if {[$ctext compare $difffilestart($i) > $here]} {
1246 $ctext yview $difffilestart($i)
1252 proc listboxsel {} {
1253 global ctext cflist currentid treediffs seenfile
1254 if {![info exists currentid]} return
1255 set sel [$cflist curselection]
1256 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1258 $ctext tag conf Comments -elide 0
1259 foreach f $treediffs($currentid) {
1260 if [info exists seenfile(f:$f)] {
1261 $ctext tag conf "f:$f" -elide 0
1265 # just show selected files
1266 $ctext tag conf Comments -elide 1
1268 foreach f $treediffs($currentid) {
1269 set elide [expr {[lsearch -exact $sel $i] < 0}]
1270 if [info exists seenfile(f:$f)] {
1271 $ctext tag conf "f:$f" -elide $elide
1279 global linespc charspc canvx0 canvy0 mainfont
1280 set linespc [font metrics $mainfont -linespace]
1281 set charspc [font measure $mainfont "m"]
1282 set canvy0 [expr 3 + 0.5 * $linespc]
1283 set canvx0 [expr 3 + 0.5 * $linespc]
1287 global selectedline stopped redisplaying phase
1288 if {$stopped > 1} return
1289 if {$phase == "getcommits"} return
1291 if {$phase == "drawgraph"} {
1298 proc incrfont {inc} {
1299 global mainfont namefont textfont selectedline ctext canv phase
1300 global stopped entries
1302 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1303 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1304 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1306 $ctext conf -font $textfont
1307 $ctext tag conf filesep -font [concat $textfont bold]
1308 foreach e $entries {
1309 $e conf -font $mainfont
1311 if {$phase == "getcommits"} {
1312 $canv itemconf textitems -font $mainfont
1317 proc sha1change {n1 n2 op} {
1318 global sha1string currentid sha1but
1319 if {$sha1string == {}
1320 || ([info exists currentid] && $sha1string == $currentid)} {
1325 if {[$sha1but cget -state] == $state} return
1326 if {$state == "normal"} {
1327 $sha1but conf -state normal -relief raised -text "Goto: "
1329 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1333 proc gotocommit {} {
1334 global sha1string currentid idline tagids
1335 if {$sha1string == {}
1336 || ([info exists currentid] && $sha1string == $currentid)} return
1337 if {[info exists tagids($sha1string)]} {
1338 set id $tagids($sha1string)
1340 set id [string tolower $sha1string]
1342 if {[info exists idline($id)]} {
1343 selectline $idline($id)
1346 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1351 error_popup "$type $sha1string is not known"
1363 set diffopts "-U 5 -p"
1365 set mainfont {Helvetica 9}
1366 set textfont {Courier 9}
1368 set colors {green red blue magenta darkgrey brown orange}
1369 set colorbycommitter 0
1371 catch {source ~/.gitk}
1373 set namefont $mainfont
1375 lappend namefont bold
1380 switch -regexp -- $arg {
1382 "^-b" { set boldnames 1 }
1383 "^-c" { set colorbycommitter 1 }
1384 "^-d" { set datemode 1 }
1386 lappend revtreeargs $arg
1397 getcommits $revtreeargs