132afd8fef472892507db9a920d9da7ebf154ed8
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec 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.6 $
11
12set datemode 0
13set boldnames 0
14set revtreeargs {}
15set diffopts "-U 5 -p"
16
17set mainfont {Helvetica 9}
18set namefont $mainfont
19set textfont {Courier 9}
20if {$boldnames} {
21 lappend namefont bold
22}
23
24set colors {green red blue magenta darkgrey brown orange}
25set colorbycommitter false
26
27catch {source ~/.gitk}
28
29foreach arg $argv {
30 switch -regexp -- $arg {
31 "^$" { }
32 "^-b" { set boldnames 1 }
33 "^-c" { set colorbycommitter 1 }
34 "^-d" { set datemode 1 }
35 "^-.*" {
36 puts stderr "unrecognized option $arg"
37 exit 1
38 }
39 default {
40 lappend revtreeargs $arg
41 }
42 }
43}
44
45proc getcommits {rargs} {
46 global commits parents cdate nparents children nchildren
47 if {$rargs == {}} {
48 set rargs HEAD
49 }
50 set commits {}
51 foreach c [split [eval exec git-rev-tree $rargs] "\n"] {
52 set i 0
53 set cid {}
54 foreach f $c {
55 if {$i == 0} {
56 set d $f
57 } else {
58 set id [lindex [split $f :] 0]
59 if {![info exists nchildren($id)]} {
60 set children($id) {}
61 set nchildren($id) 0
62 }
63 if {$i == 1} {
64 set cid $id
65 lappend commits $id
66 set parents($id) {}
67 set cdate($id) $d
68 set nparents($id) 0
69 } else {
70 lappend parents($cid) $id
71 incr nparents($cid)
72 incr nchildren($id)
73 lappend children($id) $cid
74 }
75 }
76 incr i
77 }
78 }
79}
80
81proc readcommit {id} {
82 global commitinfo
83 set inhdr 1
84 set comment {}
85 set headline {}
86 set auname {}
87 set audate {}
88 set comname {}
89 set comdate {}
90 foreach line [split [exec git-cat-file commit $id] "\n"] {
91 if {$inhdr} {
92 if {$line == {}} {
93 set inhdr 0
94 } else {
95 set tag [lindex $line 0]
96 if {$tag == "author"} {
97 set x [expr {[llength $line] - 2}]
98 set audate [lindex $line $x]
99 set auname [lrange $line 1 [expr {$x - 1}]]
100 } elseif {$tag == "committer"} {
101 set x [expr {[llength $line] - 2}]
102 set comdate [lindex $line $x]
103 set comname [lrange $line 1 [expr {$x - 1}]]
104 }
105 }
106 } else {
107 if {$comment == {}} {
108 set headline $line
109 } else {
110 append comment "\n"
111 }
112 append comment $line
113 }
114 }
115 if {$audate != {}} {
116 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
117 }
118 if {$comdate != {}} {
119 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
120 }
121 set commitinfo($id) [list $headline $auname $audate \
122 $comname $comdate $comment]
123}
124
125proc makewindow {} {
126 global canv canv2 canv3 linespc charspc ctext cflist textfont
127 panedwindow .ctop -orient vertical
128 panedwindow .ctop.clist -orient horizontal -sashpad 0 -handlesize 4
129 .ctop add .ctop.clist
130 set canv .ctop.clist.canv
131 set cscroll .ctop.clist.dates.csb
132 set height [expr 25 * $linespc + 4]
133 canvas $canv -height $height -width [expr 45 * $charspc] \
134 -bg white -bd 0 \
135 -yscrollincr $linespc -yscrollcommand "$cscroll set"
136 .ctop.clist add $canv
137 set canv2 .ctop.clist.canv2
138 canvas $canv2 -height $height -width [expr 30 * $charspc] \
139 -bg white -bd 0 -yscrollincr $linespc
140 .ctop.clist add $canv2
141 frame .ctop.clist.dates
142 .ctop.clist add .ctop.clist.dates
143 set canv3 .ctop.clist.dates.canv3
144 canvas $canv3 -height $height -width [expr 15 * $charspc] \
145 -bg white -bd 0 -yscrollincr $linespc
146 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
147 pack .ctop.clist.dates.csb -side right -fill y
148 pack $canv3 -side left -fill both -expand 1
149
150 panedwindow .ctop.cdet -orient horizontal
151 .ctop add .ctop.cdet
152 frame .ctop.cdet.left
153 set ctext .ctop.cdet.left.ctext
154 text $ctext -bg white -state disabled -font $textfont -height 32 \
155 -yscrollcommand ".ctop.cdet.left.sb set"
156 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
157 pack .ctop.cdet.left.sb -side right -fill y
158 pack $ctext -side left -fill both -expand 1
159 .ctop.cdet add .ctop.cdet.left
160
161 $ctext tag conf filesep -font [concat $textfont bold]
162 $ctext tag conf hunksep -back blue -fore white
163 $ctext tag conf d0 -back "#ff8080"
164 $ctext tag conf d1 -back green
165
166 frame .ctop.cdet.right
167 set cflist .ctop.cdet.right.cfiles
168 listbox $cflist -width 30 -bg white -selectmode extended \
169 -yscrollcommand ".ctop.cdet.right.sb set"
170 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
171 pack .ctop.cdet.right.sb -side right -fill y
172 pack $cflist -side left -fill both -expand 1
173 .ctop.cdet add .ctop.cdet.right
174
175 pack .ctop -side top -fill both -expand 1
176
177 bindall <1> {selcanvline %x %y}
178 bindall <B1-Motion> {selcanvline %x %y}
179 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
180 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
181 bindall <2> "allcanvs scan mark 0 %y"
182 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
183 bind . <Key-Up> "selnextline -1"
184 bind . <Key-Down> "selnextline 1"
185 bind . p "selnextline -1"
186 bind . n "selnextline 1"
187 bind . <Key-Prior> "allcanvs yview scroll -1 p"
188 bind . <Key-Next> "allcanvs yview scroll 1 p"
189 bind . <Key-Delete> "$ctext yview scroll -1 p"
190 bind . <Key-BackSpace> "$ctext yview scroll -1 p"
191 bind . <Key-space> "$ctext yview scroll 1 p"
192 bind . b "$ctext yview scroll -1 p"
193 bind . d "$ctext yview scroll 18 u"
194 bind . u "$ctext yview scroll -18 u"
195 bind . Q "set stopped 1; destroy ."
196 bind $cflist <<ListboxSelect>> listboxsel
197}
198
199proc allcanvs args {
200 global canv canv2 canv3
201 eval $canv $args
202 eval $canv2 $args
203 eval $canv3 $args
204}
205
206proc bindall {event action} {
207 global canv canv2 canv3
208 bind $canv $event $action
209 bind $canv2 $event $action
210 bind $canv3 $event $action
211}
212
213proc truncatetofit {str width font} {
214 if {[font measure $font $str] <= $width} {
215 return $str
216 }
217 set best 0
218 set bad [string length $str]
219 set tmp $str
220 while {$best < $bad - 1} {
221 set try [expr {int(($best + $bad) / 2)}]
222 set tmp "[string range $str 0 [expr $try-1]]..."
223 if {[font measure $font $tmp] <= $width} {
224 set best $try
225 } else {
226 set bad $try
227 }
228 }
229 return $tmp
230}
231
232proc assigncolor {id} {
233 global commitinfo colormap commcolors colors nextcolor
234 global colorbycommitter
235 global parents nparents children nchildren
236 if [info exists colormap($id)] return
237 set ncolors [llength $colors]
238 if {$colorbycommitter} {
239 if {![info exists commitinfo($id)]} {
240 readcommit $id
241 }
242 set comm [lindex $commitinfo($id) 3]
243 if {![info exists commcolors($comm)]} {
244 set commcolors($comm) [lindex $colors $nextcolor]
245 if {[incr nextcolor] >= $ncolors} {
246 set nextcolor 0
247 }
248 }
249 set colormap($id) $commcolors($comm)
250 } else {
251 if {$nparents($id) == 1 && $nchildren($id) == 1} {
252 set child [lindex $children($id) 0]
253 if {[info exists colormap($child)]
254 && $nparents($child) == 1} {
255 set colormap($id) $colormap($child)
256 return
257 }
258 }
259 set badcolors {}
260 foreach child $children($id) {
261 if {[info exists colormap($child)]
262 && [lsearch -exact $badcolors $colormap($child)] < 0} {
263 lappend badcolors $colormap($child)
264 }
265 if {[info exists parents($child)]} {
266 foreach p $parents($child) {
267 if {[info exists colormap($p)]
268 && [lsearch -exact $badcolors $colormap($p)] < 0} {
269 lappend badcolors $colormap($p)
270 }
271 }
272 }
273 }
274 if {[llength $badcolors] >= $ncolors} {
275 set badcolors {}
276 }
277 for {set i 0} {$i <= $ncolors} {incr i} {
278 set c [lindex $colors $nextcolor]
279 if {[incr nextcolor] >= $ncolors} {
280 set nextcolor 0
281 }
282 if {[lsearch -exact $badcolors $c]} break
283 }
284 set colormap($id) $c
285 }
286}
287
288proc drawgraph {start} {
289 global parents children nparents nchildren commits
290 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
291 global datemode cdate
292 global lineid linehtag linentag linedtag commitinfo
293 global nextcolor colormap
294
295 set nextcolor 0
296 assigncolor $start
297 foreach id $commits {
298 set ncleft($id) $nchildren($id)
299 }
300 set todo [list $start]
301 set level 0
302 set y2 $canvy0
303 set linestarty(0) $canvy0
304 set nullentry -1
305 set lineno -1
306 while 1 {
307 set canvy $y2
308 allcanvs conf -scrollregion [list 0 0 0 $canvy]
309 update
310 incr lineno
311 set nlines [llength $todo]
312 set id [lindex $todo $level]
313 set lineid($lineno) $id
314 set actualparents {}
315 foreach p $parents($id) {
316 if {[info exists ncleft($p)]} {
317 incr ncleft($p) -1
318 lappend actualparents $p
319 }
320 }
321 if {![info exists commitinfo($id)]} {
322 readcommit $id
323 }
324 set x [expr $canvx0 + $level * $linespc]
325 set y2 [expr $canvy + $linespc]
326 if {$linestarty($level) < $canvy} {
327 set t [$canv create line $x $linestarty($level) $x $canvy \
328 -width 2 -fill $colormap($id)]
329 $canv lower $t
330 set linestarty($level) $canvy
331 }
332 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
333 [expr $x + 3] [expr $canvy + 3] \
334 -fill blue -outline black -width 1]
335 $canv raise $t
336 set xt [expr $canvx0 + $nlines * $linespc]
337 set headline [lindex $commitinfo($id) 0]
338 set name [lindex $commitinfo($id) 1]
339 set date [lindex $commitinfo($id) 2]
340 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
341 -text $headline -font $mainfont ]
342 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
343 -text $name -font $namefont]
344 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
345 -text $date -font $mainfont]
346 if {!$datemode && [llength $actualparents] == 1} {
347 set p [lindex $actualparents 0]
348 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
349 assigncolor $p
350 set todo [lreplace $todo $level $level $p]
351 continue
352 }
353 }
354
355 set oldtodo $todo
356 set oldlevel $level
357 set lines {}
358 for {set i 0} {$i < $nlines} {incr i} {
359 if {[lindex $todo $i] == {}} continue
360 set oldstarty($i) $linestarty($i)
361 if {$i != $level} {
362 lappend lines [list $i [lindex $todo $i]]
363 }
364 }
365 unset linestarty
366 if {$nullentry >= 0} {
367 set todo [lreplace $todo $nullentry $nullentry]
368 if {$nullentry < $level} {
369 incr level -1
370 }
371 }
372
373 set todo [lreplace $todo $level $level]
374 if {$nullentry > $level} {
375 incr nullentry -1
376 }
377 set i $level
378 foreach p $actualparents {
379 set k [lsearch -exact $todo $p]
380 if {$k < 0} {
381 assigncolor $p
382 set todo [linsert $todo $i $p]
383 if {$nullentry >= $i} {
384 incr nullentry
385 }
386 }
387 lappend lines [list $oldlevel $p]
388 }
389
390 # choose which one to do next time around
391 set todol [llength $todo]
392 set level -1
393 set latest {}
394 for {set k $todol} {[incr k -1] >= 0} {} {
395 set p [lindex $todo $k]
396 if {$p == {}} continue
397 if {$ncleft($p) == 0} {
398 if {$datemode} {
399 if {$latest == {} || $cdate($p) > $latest} {
400 set level $k
401 set latest $cdate($p)
402 }
403 } else {
404 set level $k
405 break
406 }
407 }
408 }
409 if {$level < 0} {
410 if {$todo != {}} {
411 puts "ERROR: none of the pending commits can be done yet:"
412 foreach p $todo {
413 puts " $p"
414 }
415 }
416 break
417 }
418
419 # If we are reducing, put in a null entry
420 if {$todol < $nlines} {
421 if {$nullentry >= 0} {
422 set i $nullentry
423 while {$i < $todol
424 && [lindex $oldtodo $i] == [lindex $todo $i]} {
425 incr i
426 }
427 } else {
428 set i $oldlevel
429 if {$level >= $i} {
430 incr i
431 }
432 }
433 if {$i >= $todol} {
434 set nullentry -1
435 } else {
436 set nullentry $i
437 set todo [linsert $todo $nullentry {}]
438 if {$level >= $i} {
439 incr level
440 }
441 }
442 } else {
443 set nullentry -1
444 }
445
446 foreach l $lines {
447 set i [lindex $l 0]
448 set dst [lindex $l 1]
449 set j [lsearch -exact $todo $dst]
450 if {$i == $j} {
451 set linestarty($i) $oldstarty($i)
452 continue
453 }
454 set xi [expr {$canvx0 + $i * $linespc}]
455 set xj [expr {$canvx0 + $j * $linespc}]
456 set coords {}
457 if {$oldstarty($i) < $canvy} {
458 lappend coords $xi $oldstarty($i)
459 }
460 lappend coords $xi $canvy
461 if {$j < $i - 1} {
462 lappend coords [expr $xj + $linespc] $canvy
463 } elseif {$j > $i + 1} {
464 lappend coords [expr $xj - $linespc] $canvy
465 }
466 lappend coords $xj $y2
467 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
468 $canv lower $t
469 if {![info exists linestarty($j)]} {
470 set linestarty($j) $y2
471 }
472 }
473 }
474}
475
476proc selcanvline {x y} {
477 global canv canvy0 ctext linespc selectedline
478 global lineid linehtag linentag linedtag
479 set ymax [lindex [$canv cget -scrollregion] 3]
480 set yfrac [lindex [$canv yview] 0]
481 set y [expr {$y + $yfrac * $ymax}]
482 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
483 if {$l < 0} {
484 set l 0
485 }
486 if {[info exists selectedline] && $selectedline == $l} return
487 selectline $l
488}
489
490proc selectline {l} {
491 global canv canv2 canv3 ctext commitinfo selectedline
492 global lineid linehtag linentag linedtag
493 global canvy canvy0 linespc nparents treepending
494 global cflist treediffs currentid
495 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
496 $canv delete secsel
497 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
498 -tags secsel -fill [$canv cget -selectbackground]]
499 $canv lower $t
500 $canv2 delete secsel
501 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
502 -tags secsel -fill [$canv2 cget -selectbackground]]
503 $canv2 lower $t
504 $canv3 delete secsel
505 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
506 -tags secsel -fill [$canv3 cget -selectbackground]]
507 $canv3 lower $t
508 set y [expr {$canvy0 + $l * $linespc}]
509 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
510 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
511 set wnow [$canv yview]
512 if {$ytop < [lindex $wnow 0]} {
513 allcanvs yview moveto $ytop
514 } elseif {$ybot > [lindex $wnow 1]} {
515 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
516 allcanvs yview moveto [expr {$ybot - $wh}]
517 }
518 set selectedline $l
519
520 set id $lineid($l)
521 $ctext conf -state normal
522 $ctext delete 0.0 end
523 set info $commitinfo($id)
524 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
525 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
526 $ctext insert end "\n"
527 $ctext insert end [lindex $info 5]
528 $ctext insert end "\n"
529 $ctext tag delete Comments
530 $ctext conf -state disabled
531
532 $cflist delete 0 end
533 set currentid $id
534 if {$nparents($id) == 1} {
535 if {![info exists treediffs($id)]} {
536 if {![info exists treepending]} {
537 gettreediffs $id
538 }
539 } else {
540 addtocflist $id
541 }
542 }
543}
544
545proc selnextline {dir} {
546 global selectedline
547 if {![info exists selectedline]} return
548 set l [expr $selectedline + $dir]
549 selectline $l
550}
551
552proc addtocflist {id} {
553 global currentid treediffs cflist treepending
554 if {$id != $currentid} {
555 gettreediffs $currentid
556 return
557 }
558 $cflist insert end "All files"
559 foreach f $treediffs($currentid) {
560 $cflist insert end $f
561 }
562 getblobdiffs $id
563}
564
565proc gettreediffs {id} {
566 global treediffs parents treepending
567 set treepending $id
568 set treediffs($id) {}
569 set p [lindex $parents($id) 0]
570 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
571 fconfigure $gdtf -blocking 0
572 fileevent $gdtf readable "gettreediffline $gdtf $id"
573}
574
575proc gettreediffline {gdtf id} {
576 global treediffs treepending
577 set n [gets $gdtf line]
578 if {$n < 0} {
579 if {![eof $gdtf]} return
580 close $gdtf
581 unset treepending
582 addtocflist $id
583 return
584 }
585 set type [lindex $line 1]
586 set file [lindex $line 3]
587 if {$type == "blob"} {
588 lappend treediffs($id) $file
589 }
590}
591
592proc getblobdiffs {id} {
593 global parents diffopts blobdifffd env curdifftag curtagstart
594 set p [lindex $parents($id) 0]
595 set env(GIT_DIFF_OPTS) $diffopts
596 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
597 puts "error getting diffs: $err"
598 return
599 }
600 fconfigure $bdf -blocking 0
601 set blobdifffd($id) $bdf
602 set curdifftag Comments
603 set curtagstart 0.0
604 fileevent $bdf readable "getblobdiffline $bdf $id"
605}
606
607proc getblobdiffline {bdf id} {
608 global currentid blobdifffd ctext curdifftag curtagstart
609 set n [gets $bdf line]
610 if {$n < 0} {
611 if {[eof $bdf]} {
612 close $bdf
613 if {$id == $currentid && $bdf == $blobdifffd($id)} {
614 $ctext tag add $curdifftag $curtagstart end
615 }
616 }
617 return
618 }
619 if {$id != $currentid || $bdf != $blobdifffd($id)} {
620 return
621 }
622 $ctext conf -state normal
623 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
624 # start of a new file
625 $ctext insert end "\n"
626 $ctext tag add $curdifftag $curtagstart end
627 set curtagstart [$ctext index "end - 1c"]
628 set curdifftag "f:$fname"
629 $ctext tag delete $curdifftag
630 set l [expr {(78 - [string length $fname]) / 2}]
631 set pad [string range "----------------------------------------" 1 $l]
632 $ctext insert end "$pad $fname $pad\n" filesep
633 } elseif {[string range $line 0 2] == "+++"} {
634 # no need to do anything with this
635 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
636 $line match f1l f1c f2l f2c rest]} {
637 $ctext insert end "\t" hunksep
638 $ctext insert end " $f1l " d0 " $f2l " d1
639 $ctext insert end " $rest \n" hunksep
640 } else {
641 set x [string range $line 0 0]
642 if {$x == "-" || $x == "+"} {
643 set tag [expr {$x == "+"}]
644 set line [string range $line 1 end]
645 $ctext insert end "$line\n" d$tag
646 } elseif {$x == " "} {
647 set line [string range $line 1 end]
648 $ctext insert end "$line\n"
649 } else {
650 # Something else we don't recognize
651 if {$curdifftag != "Comments"} {
652 $ctext insert end "\n"
653 $ctext tag add $curdifftag $curtagstart end
654 set curtagstart [$ctext index "end - 1c"]
655 set curdifftag Comments
656 }
657 $ctext insert end "$line\n" filesep
658 }
659 }
660 $ctext conf -state disabled
661}
662
663proc listboxsel {} {
664 global ctext cflist currentid treediffs
665 set sel [$cflist curselection]
666 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
667 # show everything
668 $ctext tag conf Comments -elide 0
669 foreach f $treediffs($currentid) {
670 $ctext tag conf "f:$f" -elide 0
671 }
672 } else {
673 # just show selected files
674 $ctext tag conf Comments -elide 1
675 set i 1
676 foreach f $treediffs($currentid) {
677 set elide [expr {[lsearch -exact $sel $i] < 0}]
678 $ctext tag conf "f:$f" -elide $elide
679 incr i
680 }
681 }
682}
683
684getcommits $revtreeargs
685
686set linespc [font metrics $mainfont -linespace]
687set charspc [font measure $mainfont "m"]
688
689set canvy0 [expr 3 + 0.5 * $linespc]
690set canvx0 [expr 3 + 0.5 * $linespc]
691set namex [expr 45 * $charspc]
692set datex [expr 75 * $charspc]
693
694makewindow
695
696set start {}
697foreach id $commits {
698 if {$nchildren($id) == 0} {
699 set start $id
700 break
701 }
702}
703if {$start != {}} {
704 drawgraph $start
705}