1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "${1+$@}"
45
# 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.
910
set datemode 0
11set boldnames 0
12set revtreeargs {}
1314
foreach arg $argv {
15switch -regexp -- $arg {
16"^$" { }
17"^-d" { set datemode 1 }
18"^-b" { set boldnames 1 }
19"^-.*" {
20puts stderr "unrecognized option $arg"
21exit 1
22}
23default {
24lappend revtreeargs $arg
25}
26}
27}
2829
proc getcommits {rargs} {
30global commits parents cdate nparents children nchildren
31if {$rargs == {}} {
32set rargs HEAD
33}
34set commits {}
35foreach c [split [eval exec git-rev-tree $rargs] "\n"] {
36set i 0
37set cid {}
38foreach f $c {
39if {$i == 0} {
40set d $f
41} else {
42set id [lindex [split $f :] 0]
43if {![info exists nchildren($id)]} {
44set children($id) {}
45set nchildren($id) 0
46}
47if {$i == 1} {
48set cid $id
49lappend commits $id
50set parents($id) {}
51set cdate($id) $d
52set nparents($id) 0
53} else {
54lappend parents($cid) $id
55incr nparents($cid)
56incr nchildren($id)
57lappend children($id) $cid
58}
59}
60incr i
61}
62}
63}
6465
proc readcommit {id} {
66global commitinfo
67set inhdr 1
68set comment {}
69set headline {}
70set auname {}
71set audate {}
72set comname {}
73set comdate {}
74foreach line [split [exec git-cat-file commit $id] "\n"] {
75if {$inhdr} {
76if {$line == {}} {
77set inhdr 0
78} else {
79set tag [lindex $line 0]
80if {$tag == "author"} {
81set x [expr {[llength $line] - 2}]
82set audate [lindex $line $x]
83set auname [lrange $line 1 [expr {$x - 1}]]
84} elseif {$tag == "committer"} {
85set x [expr {[llength $line] - 2}]
86set comdate [lindex $line $x]
87set comname [lrange $line 1 [expr {$x - 1}]]
88}
89}
90} else {
91if {$comment == {}} {
92set headline $line
93} else {
94append comment "\n"
95}
96append comment $line
97}
98}
99if {$audate != {}} {
100set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
101}
102if {$comdate != {}} {
103set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
104}
105set commitinfo($id) [list $comment $auname $audate $comname $comdate]
106return [list $headline $auname $audate]
107}
108109
proc makewindow {} {
110global canv linespc charspc ctext
111frame .clist
112set canv .clist.canv
113canvas $canv -height [expr 30 * $linespc + 4] -width [expr 90 * $charspc] \
114-bg white -relief sunk -bd 1 \
115-yscrollincr $linespc -yscrollcommand ".clist.csb set"
116scrollbar .clist.csb -command "$canv yview" -highlightthickness 0
117pack .clist.csb -side right -fill y
118pack $canv -side bottom -fill both -expand 1
119pack .clist -side top -fill both -expand 1
120set ctext .ctext
121text $ctext -bg white
122pack $ctext -side top -fill x -expand 1
123124
bind $canv <1> {selcanvline %x %y}
125bind $canv <B1-Motion> {selcanvline %x %y}
126bind $canv <ButtonRelease-4> "$canv yview scroll -5 u"
127bind $canv <ButtonRelease-5> "$canv yview scroll 5 u"
128bind $canv <2> "$canv scan mark 0 %y"
129bind $canv <B2-Motion> "$canv scan dragto 0 %y"
130bind . <Key-Prior> "$canv yview scroll -1 p"
131bind . <Key-Next> "$canv yview scroll 1 p"
132bind . <Key-Delete> "$canv yview scroll -1 p"
133bind . <Key-BackSpace> "$canv yview scroll -1 p"
134bind . <Key-space> "$canv yview scroll 1 p"
135bind . <Key-Up> "$canv yview scroll -1 u"
136bind . <Key-Down> "$canv yview scroll 1 u"
137bind . Q "set stopped 1; destroy ."
138}
139140
proc truncatetofit {str width font} {
141if {[font measure $font $str] <= $width} {
142return $str
143}
144set best 0
145set bad [string length $str]
146set tmp $str
147while {$best < $bad - 1} {
148set try [expr {int(($best + $bad) / 2)}]
149set tmp "[string range $str 0 [expr $try-1]]..."
150if {[font measure $font $tmp] <= $width} {
151set best $try
152} else {
153set bad $try
154}
155}
156return $tmp
157}
158159
proc drawgraph {start} {
160global parents children nparents nchildren commits
161global canv mainfont namefont canvx0 canvy0 linespc namex datex
162global datemode cdate
163global lineid linehtag linentag linedtag
164165
set colors {green red blue magenta darkgrey brown orange}
166set ncolors [llength $colors]
167set nextcolor 0
168set colormap($start) [lindex $colors 0]
169foreach id $commits {
170set ncleft($id) $nchildren($id)
171}
172set todo [list $start]
173set level 0
174set canvy $canvy0
175set linestarty(0) $canvy
176set nullentry -1
177set lineno -1
178while 1 {
179incr lineno
180set nlines [llength $todo]
181set id [lindex $todo $level]
182set lineid($lineno) $id
183foreach p $parents($id) {
184incr ncleft($p) -1
185}
186set cinfo [readcommit $id]
187set x [expr $canvx0 + $level * $linespc]
188set y2 [expr $canvy + $linespc]
189if {$linestarty($level) < $canvy} {
190set t [$canv create line $x $linestarty($level) $x $canvy \
191-width 2 -fill $colormap($id)]
192$canv lower $t
193set linestarty($level) $canvy
194}
195set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
196[expr $x + 3] [expr $canvy + 3] \
197-fill blue -outline black -width 1]
198$canv raise $t
199set xt [expr $canvx0 + $nlines * $linespc]
200set headline [lindex $cinfo 0]
201set name [lindex $cinfo 1]
202set date [lindex $cinfo 2]
203set headline [truncatetofit $headline [expr $namex-$xt-$linespc] \
204$mainfont]
205set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
206-text $headline -font $mainfont ]
207set name [truncatetofit $name [expr $datex-$namex-$linespc] $namefont]
208set linentag($lineno) [$canv create text $namex $canvy -anchor w \
209-text $name -font $namefont]
210set linedtag($lineno) [$canv create text $datex $canvy -anchor w \
211-text $date -font $mainfont]
212if {!$datemode && $nparents($id) == 1} {
213set p [lindex $parents($id) 0]
214if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
215set todo [lreplace $todo $level $level $p]
216set colormap($p) $colormap($id)
217set canvy $y2
218$canv conf -scrollregion [list 0 0 0 $canvy]
219update
220continue
221}
222}
223224
set oldtodo $todo
225set oldlevel $level
226set lines {}
227for {set i 0} {$i < $nlines} {incr i} {
228if {[lindex $todo $i] == {}} continue
229set oldstarty($i) $linestarty($i)
230if {$i != $level} {
231lappend lines [list $i [lindex $todo $i]]
232}
233}
234unset linestarty
235if {$nullentry >= 0} {
236set todo [lreplace $todo $nullentry $nullentry]
237if {$nullentry < $level} {
238incr level -1
239}
240}
241242
set badcolors [list $colormap($id)]
243foreach p $parents($id) {
244if {[info exists colormap($p)]} {
245lappend badcolors $colormap($p)
246}
247}
248set todo [lreplace $todo $level $level]
249if {$nullentry > $level} {
250incr nullentry -1
251}
252set i $level
253foreach p $parents($id) {
254set k [lsearch -exact $todo $p]
255if {$k < 0} {
256set todo [linsert $todo $i $p]
257if {$nullentry >= $i} {
258incr nullentry
259}
260if {$nparents($id) == 1 && $nparents($p) == 1
261&& $nchildren($p) == 1} {
262set colormap($p) $colormap($id)
263} else {
264for {set j 0} {$j <= $ncolors} {incr j} {
265if {[incr nextcolor] >= $ncolors} {
266set nextcolor 0
267}
268set c [lindex $colors $nextcolor]
269# make sure the incoming and outgoing colors differ
270if {[lsearch -exact $badcolors $c] < 0} break
271}
272set colormap($p) $c
273lappend badcolors $c
274}
275}
276lappend lines [list $oldlevel $p]
277}
278279
# choose which one to do next time around
280set todol [llength $todo]
281set level -1
282set latest {}
283for {set k $todol} {[incr k -1] >= 0} {} {
284set p [lindex $todo $k]
285if {$p == {}} continue
286if {$ncleft($p) == 0} {
287if {$datemode} {
288if {$latest == {} || $cdate($p) > $latest} {
289set level $k
290set latest $cdate($p)
291}
292} else {
293set level $k
294break
295}
296}
297}
298if {$level < 0} {
299if {$todo != {}} {
300puts "ERROR: none of the pending commits can be done yet:"
301foreach p $todo {
302puts " $p"
303}
304}
305break
306}
307308
# If we are reducing, put in a null entry
309if {$todol < $nlines} {
310if {$nullentry >= 0} {
311set i $nullentry
312while {$i < $todol
313&& [lindex $oldtodo $i] == [lindex $todo $i]} {
314incr i
315}
316} else {
317set i $oldlevel
318if {$level >= $i} {
319incr i
320}
321}
322if {$i >= $todol} {
323set nullentry -1
324} else {
325set nullentry $i
326set todo [linsert $todo $nullentry {}]
327if {$level >= $i} {
328incr level
329}
330}
331} else {
332set nullentry -1
333}
334335
foreach l $lines {
336set i [lindex $l 0]
337set dst [lindex $l 1]
338set j [lsearch -exact $todo $dst]
339if {$i == $j} {
340set linestarty($i) $oldstarty($i)
341continue
342}
343set xi [expr {$canvx0 + $i * $linespc}]
344set xj [expr {$canvx0 + $j * $linespc}]
345set coords {}
346if {$oldstarty($i) < $canvy} {
347lappend coords $xi $oldstarty($i)
348}
349lappend coords $xi $canvy
350if {$j < $i - 1} {
351lappend coords [expr $xj + $linespc] $canvy
352} elseif {$j > $i + 1} {
353lappend coords [expr $xj - $linespc] $canvy
354}
355lappend coords $xj $y2
356set t [$canv create line $coords -width 2 -fill $colormap($dst)]
357$canv lower $t
358if {![info exists linestarty($j)]} {
359set linestarty($j) $y2
360}
361}
362set canvy $y2
363$canv conf -scrollregion [list 0 0 0 $canvy]
364update
365}
366}
367368
proc selcanvline {x y} {
369global canv canvy0 ctext linespc selectedline
370global lineid linehtag linentag linedtag commitinfo
371set ymax [lindex [$canv cget -scrollregion] 3]
372set yfrac [lindex [$canv yview] 0]
373set y [expr {$y + $yfrac * $ymax}]
374set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
375if {$l < 0} {
376set l 0
377}
378if {[info exists selectedline] && $selectedline == $l} return
379if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
380$canv select clear
381$canv select from $linehtag($l) 0
382$canv select to $linehtag($l) end
383set id $lineid($l)
384$ctext delete 0.0 end
385set info $commitinfo($id)
386$ctext insert end "Author: [lindex $info 1] \t[lindex $info 2]\n"
387$ctext insert end "Committer: [lindex $info 3] \t[lindex $info 4]\n"
388$ctext insert end "\n"
389$ctext insert end [lindex $info 0]
390}
391392
getcommits $revtreeargs
393394
set mainfont {Helvetica 9}
395set namefont $mainfont
396if {$boldnames} {
397lappend namefont bold
398}
399set linespc [font metrics $mainfont -linespace]
400set charspc [font measure $mainfont "m"]
401402
set canvy0 [expr 3 + 0.5 * $linespc]
403set canvx0 [expr 3 + 0.5 * $linespc]
404set namex [expr 45 * $charspc]
405set datex [expr 75 * $charspc]
406407
makewindow
408409
set start {}
410foreach id $commits {
411if {$nchildren($id) == 0} {
412set start $id
413break
414}
415}
416if {$start != {}} {
417drawgraph $start
418}