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.17 $
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"
261 bind . <Control-q> doquit
262 bind . <Control-f> dofind
263 bind . <Control-g> findnext
264 bind . <Control-r> findprev
265 bind . <Control-equal> {incrfont 1}
266 bind . <Control-KP_Add> {incrfont 1}
267 bind . <Control-minus> {incrfont -1}
268 bind . <Control-KP_Subtract> {incrfont -1}
269 bind $cflist <<ListboxSelect>> listboxsel
270 bind . <Destroy> {savestuff %W}
271 bind . <Button-1> "click %W"
272 bind $fstring <Key-Return> dofind
275 # when we make a key binding for the toplevel, make sure
276 # it doesn't get triggered when that key is pressed in the
277 # find string entry widget.
278 proc bindkey {ev script} {
281 set escript [bind Entry $ev]
282 if {$escript == {}} {
283 set escript [bind Entry <Key>]
285 bind $fstring $ev "$escript; break"
288 # set the focus back to the toplevel for any click outside
289 # the find string entry widget
292 if {$w != $fstring} {
298 global canv canv2 canv3 ctext cflist mainfont textfont
300 if {$stuffsaved} return
301 if {![winfo viewable .]} return
303 set f [open "~/.gitk-new" w]
304 puts $f "set mainfont {$mainfont}"
305 puts $f "set textfont {$textfont}"
306 puts $f "set geometry(width) [winfo width .ctop]"
307 puts $f "set geometry(height) [winfo height .ctop]"
308 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
309 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
310 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
311 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
312 set wid [expr {([winfo width $ctext] - 8) \
313 / [font measure $textfont "0"]}]
314 puts $f "set geometry(ctextw) $wid"
315 set wid [expr {([winfo width $cflist] - 11) \
316 / [font measure [$cflist cget -font] "0"]}]
317 puts $f "set geometry(cflistw) $wid"
319 file rename -force "~/.gitk-new" "~/.gitk"
324 proc resizeclistpanes {win w} {
326 if [info exists oldwidth($win)] {
327 set s0 [$win sash coord 0]
328 set s1 [$win sash coord 1]
330 set sash0 [expr {int($w/2 - 2)}]
331 set sash1 [expr {int($w*5/6 - 2)}]
333 set factor [expr {1.0 * $w / $oldwidth($win)}]
334 set sash0 [expr {int($factor * [lindex $s0 0])}]
335 set sash1 [expr {int($factor * [lindex $s1 0])}]
339 if {$sash1 < $sash0 + 20} {
340 set sash1 [expr $sash0 + 20]
342 if {$sash1 > $w - 10} {
343 set sash1 [expr $w - 10]
344 if {$sash0 > $sash1 - 20} {
345 set sash0 [expr $sash1 - 20]
349 $win sash place 0 $sash0 [lindex $s0 1]
350 $win sash place 1 $sash1 [lindex $s1 1]
352 set oldwidth($win) $w
355 proc resizecdetpanes {win w} {
357 if [info exists oldwidth($win)] {
358 set s0 [$win sash coord 0]
360 set sash0 [expr {int($w*3/4 - 2)}]
362 set factor [expr {1.0 * $w / $oldwidth($win)}]
363 set sash0 [expr {int($factor * [lindex $s0 0])}]
367 if {$sash0 > $w - 15} {
368 set sash0 [expr $w - 15]
371 $win sash place 0 $sash0 [lindex $s0 1]
373 set oldwidth($win) $w
377 global canv canv2 canv3
383 proc bindall {event action} {
384 global canv canv2 canv3
385 bind $canv $event $action
386 bind $canv2 $event $action
387 bind $canv3 $event $action
392 if {[winfo exists $w]} {
397 wm title $w "About gitk"
401 Copyright © 2005 Paul Mackerras
403 Use and redistribute under the terms of the GNU General Public License
405 (CVS $Revision: 1.17 $)} \
406 -justify center -aspect 400
407 pack $w.m -side top -fill x -padx 20 -pady 20
408 button $w.ok -text Close -command "destroy $w"
409 pack $w.ok -side bottom
412 proc truncatetofit {str width font} {
413 if {[font measure $font $str] <= $width} {
417 set bad [string length $str]
419 while {$best < $bad - 1} {
420 set try [expr {int(($best + $bad) / 2)}]
421 set tmp "[string range $str 0 [expr $try-1]]..."
422 if {[font measure $font $tmp] <= $width} {
431 proc assigncolor {id} {
432 global commitinfo colormap commcolors colors nextcolor
433 global colorbycommitter
434 global parents nparents children nchildren
435 if [info exists colormap($id)] return
436 set ncolors [llength $colors]
437 if {$colorbycommitter} {
438 if {![info exists commitinfo($id)]} {
441 set comm [lindex $commitinfo($id) 3]
442 if {![info exists commcolors($comm)]} {
443 set commcolors($comm) [lindex $colors $nextcolor]
444 if {[incr nextcolor] >= $ncolors} {
448 set colormap($id) $commcolors($comm)
450 if {$nparents($id) == 1 && $nchildren($id) == 1} {
451 set child [lindex $children($id) 0]
452 if {[info exists colormap($child)]
453 && $nparents($child) == 1} {
454 set colormap($id) $colormap($child)
459 foreach child $children($id) {
460 if {[info exists colormap($child)]
461 && [lsearch -exact $badcolors $colormap($child)] < 0} {
462 lappend badcolors $colormap($child)
464 if {[info exists parents($child)]} {
465 foreach p $parents($child) {
466 if {[info exists colormap($p)]
467 && [lsearch -exact $badcolors $colormap($p)] < 0} {
468 lappend badcolors $colormap($p)
473 if {[llength $badcolors] >= $ncolors} {
476 for {set i 0} {$i <= $ncolors} {incr i} {
477 set c [lindex $colors $nextcolor]
478 if {[incr nextcolor] >= $ncolors} {
481 if {[lsearch -exact $badcolors $c]} break
488 global parents children nparents nchildren commits
489 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
490 global datemode cdate
491 global lineid linehtag linentag linedtag commitinfo
492 global nextcolor colormap numcommits
493 global stopped phase redisplaying selectedline
497 foreach id [array names nchildren] {
498 if {$nchildren($id) == 0} {
501 set ncleft($id) $nchildren($id)
502 if {![info exists nparents($id)]} {
507 error_popup "Gitk: ERROR: No starting commits found"
516 set level [expr [llength $todo] - 1]
522 set lthickness [expr {($linespc / 9) + 1}]
525 allcanvs conf -scrollregion \
526 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
531 set nlines [llength $todo]
532 set id [lindex $todo $level]
533 set lineid($lineno) $id
535 if {[info exists parents($id)]} {
536 foreach p $parents($id) {
538 if {![info exists commitinfo($p)]} {
540 if {![info exists commitinfo($p)]} continue
542 lappend actualparents $p
545 if {![info exists commitinfo($id)]} {
547 if {![info exists commitinfo($id)]} {
548 set commitinfo($id) {"No commit information available"}
551 set x [expr $canvx0 + $level * $linespc]
552 set y2 [expr $canvy + $linespc]
553 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
554 set t [$canv create line $x $linestarty($level) $x $canvy \
555 -width $lthickness -fill $colormap($id)]
558 set linestarty($level) $canvy
559 set ofill [expr {[info exists parents($id)]? "blue": "white"}]
560 set orad [expr {$linespc / 3}]
561 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
562 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
563 -fill $ofill -outline black -width 1]
565 set xt [expr $canvx0 + $nlines * $linespc]
566 set headline [lindex $commitinfo($id) 0]
567 set name [lindex $commitinfo($id) 1]
568 set date [lindex $commitinfo($id) 2]
569 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
570 -text $headline -font $mainfont ]
571 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
572 -text $name -font $namefont]
573 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
574 -text $date -font $mainfont]
575 if {!$datemode && [llength $actualparents] == 1} {
576 set p [lindex $actualparents 0]
577 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
579 set todo [lreplace $todo $level $level $p]
587 for {set i 0} {$i < $nlines} {incr i} {
588 if {[lindex $todo $i] == {}} continue
589 if {[info exists linestarty($i)]} {
590 set oldstarty($i) $linestarty($i)
594 lappend lines [list $i [lindex $todo $i]]
597 if {$nullentry >= 0} {
598 set todo [lreplace $todo $nullentry $nullentry]
599 if {$nullentry < $level} {
604 set todo [lreplace $todo $level $level]
605 if {$nullentry > $level} {
609 foreach p $actualparents {
610 set k [lsearch -exact $todo $p]
613 set todo [linsert $todo $i $p]
614 if {$nullentry >= $i} {
618 lappend lines [list $oldlevel $p]
621 # choose which one to do next time around
622 set todol [llength $todo]
625 for {set k $todol} {[incr k -1] >= 0} {} {
626 set p [lindex $todo $k]
627 if {$p == {}} continue
628 if {$ncleft($p) == 0} {
630 if {$latest == {} || $cdate($p) > $latest} {
632 set latest $cdate($p)
642 puts "ERROR: none of the pending commits can be done yet:"
650 # If we are reducing, put in a null entry
651 if {$todol < $nlines} {
652 if {$nullentry >= 0} {
655 && [lindex $oldtodo $i] == [lindex $todo $i]} {
668 set todo [linsert $todo $nullentry {}]
679 set dst [lindex $l 1]
680 set j [lsearch -exact $todo $dst]
682 if {[info exists oldstarty($i)]} {
683 set linestarty($i) $oldstarty($i)
687 set xi [expr {$canvx0 + $i * $linespc}]
688 set xj [expr {$canvx0 + $j * $linespc}]
690 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
691 lappend coords $xi $oldstarty($i)
693 lappend coords $xi $canvy
695 lappend coords [expr $xj + $linespc] $canvy
696 } elseif {$j > $i + 1} {
697 lappend coords [expr $xj - $linespc] $canvy
699 lappend coords $xj $y2
700 set t [$canv create line $coords -width $lthickness \
701 -fill $colormap($dst)]
703 if {![info exists linestarty($j)]} {
704 set linestarty($j) $y2
710 if {$stopped == 0 && [info exists selectedline]} {
711 selectline $selectedline
722 proc findmatches {f} {
723 global findtype foundstring foundstrlen
724 if {$findtype == "Regexp"} {
725 set matches [regexp -indices -all -inline $foundstring $f]
727 if {$findtype == "IgnCase"} {
728 set str [string tolower $f]
734 while {[set j [string first $foundstring $str $i]] >= 0} {
735 lappend matches [list $j [expr $j+$foundstrlen-1]]
736 set i [expr $j + $foundstrlen]
743 global findtype findloc findstring markedmatches commitinfo
744 global numcommits lineid linehtag linentag linedtag
745 global mainfont namefont canv canv2 canv3 selectedline
746 global matchinglines foundstring foundstrlen
750 set fldtypes {Headline Author Date Committer CDate Comment}
751 if {$findtype == "IgnCase"} {
752 set foundstring [string tolower $findstring]
754 set foundstring $findstring
756 set foundstrlen [string length $findstring]
757 if {$foundstrlen == 0} return
758 if {![info exists selectedline]} {
761 set oldsel $selectedline
764 for {set l 0} {$l < $numcommits} {incr l} {
766 set info $commitinfo($id)
768 foreach f $info ty $fldtypes {
769 if {$findloc != "All fields" && $findloc != $ty} {
772 set matches [findmatches $f]
773 if {$matches == {}} continue
775 if {$ty == "Headline"} {
776 markmatches $canv $l $f $linehtag($l) $matches $mainfont
777 } elseif {$ty == "Author"} {
778 markmatches $canv2 $l $f $linentag($l) $matches $namefont
779 } elseif {$ty == "Date"} {
780 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
784 lappend matchinglines $l
785 if {!$didsel && $l > $oldsel} {
791 if {$matchinglines == {}} {
793 } elseif {!$didsel} {
794 findselectline [lindex $matchinglines 0]
798 proc findselectline {l} {
799 global findloc commentend ctext
801 if {$findloc == "All fields" || $findloc == "Comments"} {
802 # highlight the matches in the comments
803 set f [$ctext get 1.0 $commentend]
804 set matches [findmatches $f]
805 foreach match $matches {
806 set start [lindex $match 0]
807 set end [expr [lindex $match 1] + 1]
808 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
814 global matchinglines selectedline
815 if {![info exists matchinglines]} {
819 if {![info exists selectedline]} return
820 foreach l $matchinglines {
821 if {$l > $selectedline} {
830 global matchinglines selectedline
831 if {![info exists matchinglines]} {
835 if {![info exists selectedline]} return
837 foreach l $matchinglines {
838 if {$l >= $selectedline} break
848 proc markmatches {canv l str tag matches font} {
849 set bbox [$canv bbox $tag]
850 set x0 [lindex $bbox 0]
851 set y0 [lindex $bbox 1]
852 set y1 [lindex $bbox 3]
853 foreach match $matches {
854 set start [lindex $match 0]
855 set end [lindex $match 1]
856 if {$start > $end} continue
857 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
858 set xlen [font measure $font [string range $str 0 [expr $end]]]
859 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
860 -outline {} -tags matches -fill yellow]
865 proc unmarkmatches {} {
867 allcanvs delete matches
868 catch {unset matchinglines}
871 proc selcanvline {x y} {
872 global canv canvy0 ctext linespc selectedline
873 global lineid linehtag linentag linedtag
874 set ymax [lindex [$canv cget -scrollregion] 3]
875 set yfrac [lindex [$canv yview] 0]
876 set y [expr {$y + $yfrac * $ymax}]
877 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
881 if {[info exists selectedline] && $selectedline == $l} return
886 proc selectline {l} {
887 global canv canv2 canv3 ctext commitinfo selectedline
888 global lineid linehtag linentag linedtag
889 global canvy0 linespc nparents treepending
890 global cflist treediffs currentid sha1entry
891 global commentend seenfile numcommits
892 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
894 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
895 -tags secsel -fill [$canv cget -selectbackground]]
898 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
899 -tags secsel -fill [$canv2 cget -selectbackground]]
902 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
903 -tags secsel -fill [$canv3 cget -selectbackground]]
905 set y [expr {$canvy0 + $l * $linespc}]
906 set ymax [lindex [$canv cget -scrollregion] 3]
907 set ytop [expr {$y - $linespc - 1}]
908 set ybot [expr {$y + $linespc + 1}]
909 set wnow [$canv yview]
910 set wtop [expr [lindex $wnow 0] * $ymax]
911 set wbot [expr [lindex $wnow 1] * $ymax]
912 set wh [expr {$wbot - $wtop}]
916 set newtop [expr {$y - $wh / 2.0}]
919 if {$newtop > $wtop - $linespc} {
920 set newtop [expr {$wtop - $linespc}]
923 } elseif {$ybot > $wbot} {
925 set newtop [expr {$y - $wh / 2.0}]
927 set newtop [expr {$ybot - $wh}]
928 if {$newtop < $wtop + $linespc} {
929 set newtop [expr {$wtop + $linespc}]
933 if {$newtop != $wtop} {
937 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
942 $sha1entry conf -state normal
943 $sha1entry delete 0 end
944 $sha1entry insert 0 $id
945 $sha1entry selection from 0
946 $sha1entry selection to end
947 $sha1entry conf -state readonly
949 $ctext conf -state normal
950 $ctext delete 0.0 end
951 set info $commitinfo($id)
952 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
953 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
954 $ctext insert end "\n"
955 $ctext insert end [lindex $info 5]
956 $ctext insert end "\n"
957 $ctext tag delete Comments
958 $ctext tag remove found 1.0 end
959 $ctext conf -state disabled
960 set commentend [$ctext index "end - 1c"]
964 if {$nparents($id) == 1} {
965 if {![info exists treediffs($id)]} {
966 if {![info exists treepending]} {
973 catch {unset seenfile}
976 proc selnextline {dir} {
978 if {![info exists selectedline]} return
979 set l [expr $selectedline + $dir]
984 proc addtocflist {id} {
985 global currentid treediffs cflist treepending
986 if {$id != $currentid} {
987 gettreediffs $currentid
990 $cflist insert end "All files"
991 foreach f $treediffs($currentid) {
992 $cflist insert end $f
997 proc gettreediffs {id} {
998 global treediffs parents treepending
1000 set treediffs($id) {}
1001 set p [lindex $parents($id) 0]
1002 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1003 fconfigure $gdtf -blocking 0
1004 fileevent $gdtf readable "gettreediffline $gdtf $id"
1007 proc gettreediffline {gdtf id} {
1008 global treediffs treepending
1009 set n [gets $gdtf line]
1011 if {![eof $gdtf]} return
1017 set type [lindex $line 1]
1018 set file [lindex $line 3]
1019 if {$type == "blob"} {
1020 lappend treediffs($id) $file
1024 proc getblobdiffs {id} {
1025 global parents diffopts blobdifffd env curdifftag curtagstart
1026 global diffindex difffilestart
1027 set p [lindex $parents($id) 0]
1028 set env(GIT_DIFF_OPTS) $diffopts
1029 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1030 puts "error getting diffs: $err"
1033 fconfigure $bdf -blocking 0
1034 set blobdifffd($id) $bdf
1035 set curdifftag Comments
1038 catch {unset difffilestart}
1039 fileevent $bdf readable "getblobdiffline $bdf $id"
1042 proc getblobdiffline {bdf id} {
1043 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1044 global diffnexthead diffnextnote diffindex difffilestart
1045 set n [gets $bdf line]
1049 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1050 $ctext tag add $curdifftag $curtagstart end
1051 set seenfile($curdifftag) 1
1056 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1059 $ctext conf -state normal
1060 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1061 # start of a new file
1062 $ctext insert end "\n"
1063 $ctext tag add $curdifftag $curtagstart end
1064 set seenfile($curdifftag) 1
1065 set curtagstart [$ctext index "end - 1c"]
1067 if {[info exists diffnexthead]} {
1068 set fname $diffnexthead
1069 set header "$diffnexthead ($diffnextnote)"
1072 set difffilestart($diffindex) [$ctext index "end - 1c"]
1074 set curdifftag "f:$fname"
1075 $ctext tag delete $curdifftag
1076 set l [expr {(78 - [string length $header]) / 2}]
1077 set pad [string range "----------------------------------------" 1 $l]
1078 $ctext insert end "$pad $header $pad\n" filesep
1079 } elseif {[string range $line 0 2] == "+++"} {
1080 # no need to do anything with this
1081 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1082 set diffnexthead $fn
1083 set diffnextnote "created, mode $m"
1084 } elseif {[string range $line 0 8] == "Deleted: "} {
1085 set diffnexthead [string range $line 9 end]
1086 set diffnextnote "deleted"
1087 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1088 # save the filename in case the next thing is "new file mode ..."
1089 set diffnexthead $fn
1090 set diffnextnote "modified"
1091 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1092 set diffnextnote "new file, mode $m"
1093 } elseif {[string range $line 0 11] == "deleted file"} {
1094 set diffnextnote "deleted"
1095 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1096 $line match f1l f1c f2l f2c rest]} {
1097 $ctext insert end "\t" hunksep
1098 $ctext insert end " $f1l " d0 " $f2l " d1
1099 $ctext insert end " $rest \n" hunksep
1101 set x [string range $line 0 0]
1102 if {$x == "-" || $x == "+"} {
1103 set tag [expr {$x == "+"}]
1104 set line [string range $line 1 end]
1105 $ctext insert end "$line\n" d$tag
1106 } elseif {$x == " "} {
1107 set line [string range $line 1 end]
1108 $ctext insert end "$line\n"
1109 } elseif {$x == "\\"} {
1110 # e.g. "\ No newline at end of file"
1111 $ctext insert end "$line\n" filesep
1113 # Something else we don't recognize
1114 if {$curdifftag != "Comments"} {
1115 $ctext insert end "\n"
1116 $ctext tag add $curdifftag $curtagstart end
1117 set seenfile($curdifftag) 1
1118 set curtagstart [$ctext index "end - 1c"]
1119 set curdifftag Comments
1121 $ctext insert end "$line\n" filesep
1124 $ctext conf -state disabled
1128 global difffilestart ctext
1129 set here [$ctext index @0,0]
1130 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1131 if {[$ctext compare $difffilestart($i) > $here]} {
1132 $ctext yview $difffilestart($i)
1138 proc listboxsel {} {
1139 global ctext cflist currentid treediffs seenfile
1140 if {![info exists currentid]} return
1141 set sel [$cflist curselection]
1142 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1144 $ctext tag conf Comments -elide 0
1145 foreach f $treediffs($currentid) {
1146 if [info exists seenfile(f:$f)] {
1147 $ctext tag conf "f:$f" -elide 0
1151 # just show selected files
1152 $ctext tag conf Comments -elide 1
1154 foreach f $treediffs($currentid) {
1155 set elide [expr {[lsearch -exact $sel $i] < 0}]
1156 if [info exists seenfile(f:$f)] {
1157 $ctext tag conf "f:$f" -elide $elide
1165 global linespc charspc canvx0 canvy0 mainfont
1166 set linespc [font metrics $mainfont -linespace]
1167 set charspc [font measure $mainfont "m"]
1168 set canvy0 [expr 3 + 0.5 * $linespc]
1169 set canvx0 [expr 3 + 0.5 * $linespc]
1173 global selectedline stopped redisplaying phase
1174 if {$stopped > 1} return
1175 if {$phase == "getcommits"} return
1177 if {$phase == "drawgraph"} {
1184 proc incrfont {inc} {
1185 global mainfont namefont textfont selectedline ctext canv phase
1188 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1189 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1190 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1192 $ctext conf -font $textfont
1193 $ctext tag conf filesep -font [concat $textfont bold]
1194 if {$phase == "getcommits"} {
1195 $canv itemconf textitems -font $mainfont
1209 set diffopts "-U 5 -p"
1211 set mainfont {Helvetica 9}
1212 set textfont {Courier 9}
1214 set colors {green red blue magenta darkgrey brown orange}
1215 set colorbycommitter false
1217 catch {source ~/.gitk}
1219 set namefont $mainfont
1221 lappend namefont bold
1226 switch -regexp -- $arg {
1228 "^-b" { set boldnames 1 }
1229 "^-c" { set colorbycommitter 1 }
1230 "^-d" { set datemode 1 }
1232 puts stderr "unrecognized option $arg"
1236 lappend revtreeargs $arg
1246 getcommits $revtreeargs