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