1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "${1+$@}"
4# 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# CVS $Revision: 1.8 $
11set datemode 0
13set boldnames 0
14set revtreeargs {}
15set diffopts "-U 5 -p"
16set mainfont {Helvetica 9}
18set namefont $mainfont
19set textfont {Courier 9}
20if {$boldnames} {
21 lappend namefont bold
22}
23set colors {green red blue magenta darkgrey brown orange}
25set colorbycommitter false
26catch {source ~/.gitk}
28foreach 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}
44proc getcommits {rargs} {
46 global commits parents cdate nparents children nchildren
47 if {$rargs == {}} {
48 set rargs HEAD
49 }
50 set commits {}
51 if [catch {set clist [eval exec git-rev-tree $rargs]} err] {
52 if {[string range $err 0 4] == "usage"} {
53 puts stderr "Error reading commits: bad arguments to git-rev-tree"
54 puts stderr "Note: arguments to gitk are passed to git-rev-tree"
55 puts stderr " to allow selection of commits to be displayed"
56 } else {
57 puts stderr "Error reading commits: $err"
58 }
59 return 0
60 }
61 foreach c [split $clist "\n"] {
62 set i 0
63 set cid {}
64 foreach f $c {
65 if {$i == 0} {
66 set d $f
67 } else {
68 set id [lindex [split $f :] 0]
69 if {![info exists nchildren($id)]} {
70 set children($id) {}
71 set nchildren($id) 0
72 }
73 if {$i == 1} {
74 set cid $id
75 lappend commits $id
76 set parents($id) {}
77 set cdate($id) $d
78 set nparents($id) 0
79 } else {
80 lappend parents($cid) $id
81 incr nparents($cid)
82 incr nchildren($id)
83 lappend children($id) $cid
84 }
85 }
86 incr i
87 }
88 }
89 return 1
90}
91proc readcommit {id} {
93 global commitinfo
94 set inhdr 1
95 set comment {}
96 set headline {}
97 set auname {}
98 set audate {}
99 set comname {}
100 set comdate {}
101 foreach line [split [exec git-cat-file commit $id] "\n"] {
102 if {$inhdr} {
103 if {$line == {}} {
104 set inhdr 0
105 } else {
106 set tag [lindex $line 0]
107 if {$tag == "author"} {
108 set x [expr {[llength $line] - 2}]
109 set audate [lindex $line $x]
110 set auname [lrange $line 1 [expr {$x - 1}]]
111 } elseif {$tag == "committer"} {
112 set x [expr {[llength $line] - 2}]
113 set comdate [lindex $line $x]
114 set comname [lrange $line 1 [expr {$x - 1}]]
115 }
116 }
117 } else {
118 if {$comment == {}} {
119 set headline $line
120 } else {
121 append comment "\n"
122 }
123 append comment $line
124 }
125 }
126 if {$audate != {}} {
127 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
128 }
129 if {$comdate != {}} {
130 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
131 }
132 set commitinfo($id) [list $headline $auname $audate \
133 $comname $comdate $comment]
134}
135proc makewindow {} {
137 global canv canv2 canv3 linespc charspc ctext cflist textfont
138 global sha1entry findtype findloc findstring
139 menu .bar
141 .bar add cascade -label "File" -menu .bar.file
142 menu .bar.file
143 .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
144 menu .bar.help
145 .bar add cascade -label "Help" -menu .bar.help
146 .bar.help add command -label "About gitk" -command about
147 . configure -menu .bar
148 panedwindow .ctop -orient vertical
150 frame .ctop.top
151 frame .ctop.top.bar
152 pack .ctop.top.bar -side bottom -fill x
153 set cscroll .ctop.top.csb
154 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
155 pack $cscroll -side right -fill y
156 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
157 pack .ctop.top.clist -side top -fill both -expand 1
158 .ctop add .ctop.top
159 set canv .ctop.top.clist.canv
160 set height [expr 25 * $linespc + 4]
161 canvas $canv -height $height -width [expr 45 * $charspc] \
162 -bg white -bd 0 \
163 -yscrollincr $linespc -yscrollcommand "$cscroll set"
164 .ctop.top.clist add $canv
165 set canv2 .ctop.top.clist.canv2
166 canvas $canv2 -height $height -width [expr 30 * $charspc] \
167 -bg white -bd 0 -yscrollincr $linespc
168 .ctop.top.clist add $canv2
169 set canv3 .ctop.top.clist.canv3
170 canvas $canv3 -height $height -width [expr 15 * $charspc] \
171 -bg white -bd 0 -yscrollincr $linespc
172 .ctop.top.clist add $canv3
173 set sha1entry .ctop.top.bar.sha1
175 label .ctop.top.bar.sha1label -text "SHA1 ID: "
176 pack .ctop.top.bar.sha1label -side left
177 entry $sha1entry -width 40 -font $textfont -state readonly
178 pack $sha1entry -side left -pady 2
179 button .ctop.top.bar.findbut -text "Find" -command dofind
180 pack .ctop.top.bar.findbut -side left
181 set findstring {}
182 entry .ctop.top.bar.findstring -width 30 -font $textfont \
183 -textvariable findstring
184 pack .ctop.top.bar.findstring -side left -expand 1 -fill x
185 set findtype Exact
186 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
187 set findloc "All fields"
188 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
189 Comments Author Committer
190 pack .ctop.top.bar.findloc -side right
191 pack .ctop.top.bar.findtype -side right
192 panedwindow .ctop.cdet -orient horizontal
194 .ctop add .ctop.cdet
195 frame .ctop.cdet.left
196 set ctext .ctop.cdet.left.ctext
197 text $ctext -bg white -state disabled -font $textfont -height 32 \
198 -yscrollcommand ".ctop.cdet.left.sb set"
199 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
200 pack .ctop.cdet.left.sb -side right -fill y
201 pack $ctext -side left -fill both -expand 1
202 .ctop.cdet add .ctop.cdet.left
203 $ctext tag conf filesep -font [concat $textfont bold]
205 $ctext tag conf hunksep -back blue -fore white
206 $ctext tag conf d0 -back "#ff8080"
207 $ctext tag conf d1 -back green
208 frame .ctop.cdet.right
210 set cflist .ctop.cdet.right.cfiles
211 listbox $cflist -width 30 -bg white -selectmode extended \
212 -yscrollcommand ".ctop.cdet.right.sb set"
213 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
214 pack .ctop.cdet.right.sb -side right -fill y
215 pack $cflist -side left -fill both -expand 1
216 .ctop.cdet add .ctop.cdet.right
217 pack .ctop -side top -fill both -expand 1
219 bindall <1> {selcanvline %x %y}
221 bindall <B1-Motion> {selcanvline %x %y}
222 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
223 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
224 bindall <2> "allcanvs scan mark 0 %y"
225 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
226 bind . <Key-Up> "selnextline -1"
227 bind . <Key-Down> "selnextline 1"
228 bind . p "selnextline -1"
229 bind . n "selnextline 1"
230 bind . <Key-Prior> "allcanvs yview scroll -1 p"
231 bind . <Key-Next> "allcanvs yview scroll 1 p"
232 bind . <Key-Delete> "$ctext yview scroll -1 p"
233 bind . <Key-BackSpace> "$ctext yview scroll -1 p"
234 bind . <Key-space> "$ctext yview scroll 1 p"
235 bind . b "$ctext yview scroll -1 p"
236 bind . d "$ctext yview scroll 18 u"
237 bind . u "$ctext yview scroll -18 u"
238 bind . Q "set stopped 1; destroy ."
239 bind . <Control-q> "set stopped 1; destroy ."
240 bind . <Control-f> dofind
241 bind . <Control-g> findnext
242 bind . <Control-r> findprev
243 bind $cflist <<ListboxSelect>> listboxsel
244}
245proc allcanvs args {
247 global canv canv2 canv3
248 eval $canv $args
249 eval $canv2 $args
250 eval $canv3 $args
251}
252proc bindall {event action} {
254 global canv canv2 canv3
255 bind $canv $event $action
256 bind $canv2 $event $action
257 bind $canv3 $event $action
258}
259proc about {} {
261 set w .about
262 if {[winfo exists $w]} {
263 raise $w
264 return
265 }
266 toplevel $w
267 wm title $w "About gitk"
268 message $w.m -text {
269Gitk version 0.9
270Copyright © 2005 Paul Mackerras
272Use and redistribute under the terms of the GNU General Public License
274(CVS $Revision: 1.8 $)} \
276 -justify center -aspect 400
277 pack $w.m -side top -fill x -padx 20 -pady 20
278 button $w.ok -text Close -command "destroy $w"
279 pack $w.ok -side bottom
280}
281proc truncatetofit {str width font} {
283 if {[font measure $font $str] <= $width} {
284 return $str
285 }
286 set best 0
287 set bad [string length $str]
288 set tmp $str
289 while {$best < $bad - 1} {
290 set try [expr {int(($best + $bad) / 2)}]
291 set tmp "[string range $str 0 [expr $try-1]]..."
292 if {[font measure $font $tmp] <= $width} {
293 set best $try
294 } else {
295 set bad $try
296 }
297 }
298 return $tmp
299}
300proc assigncolor {id} {
302 global commitinfo colormap commcolors colors nextcolor
303 global colorbycommitter
304 global parents nparents children nchildren
305 if [info exists colormap($id)] return
306 set ncolors [llength $colors]
307 if {$colorbycommitter} {
308 if {![info exists commitinfo($id)]} {
309 readcommit $id
310 }
311 set comm [lindex $commitinfo($id) 3]
312 if {![info exists commcolors($comm)]} {
313 set commcolors($comm) [lindex $colors $nextcolor]
314 if {[incr nextcolor] >= $ncolors} {
315 set nextcolor 0
316 }
317 }
318 set colormap($id) $commcolors($comm)
319 } else {
320 if {$nparents($id) == 1 && $nchildren($id) == 1} {
321 set child [lindex $children($id) 0]
322 if {[info exists colormap($child)]
323 && $nparents($child) == 1} {
324 set colormap($id) $colormap($child)
325 return
326 }
327 }
328 set badcolors {}
329 foreach child $children($id) {
330 if {[info exists colormap($child)]
331 && [lsearch -exact $badcolors $colormap($child)] < 0} {
332 lappend badcolors $colormap($child)
333 }
334 if {[info exists parents($child)]} {
335 foreach p $parents($child) {
336 if {[info exists colormap($p)]
337 && [lsearch -exact $badcolors $colormap($p)] < 0} {
338 lappend badcolors $colormap($p)
339 }
340 }
341 }
342 }
343 if {[llength $badcolors] >= $ncolors} {
344 set badcolors {}
345 }
346 for {set i 0} {$i <= $ncolors} {incr i} {
347 set c [lindex $colors $nextcolor]
348 if {[incr nextcolor] >= $ncolors} {
349 set nextcolor 0
350 }
351 if {[lsearch -exact $badcolors $c]} break
352 }
353 set colormap($id) $c
354 }
355}
356proc drawgraph {startlist} {
358 global parents children nparents nchildren commits
359 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
360 global datemode cdate
361 global lineid linehtag linentag linedtag commitinfo
362 global nextcolor colormap numcommits
363 global stopped
364 set nextcolor 0
366 foreach id $commits {
367 set ncleft($id) $nchildren($id)
368 }
369 foreach id $startlist {
370 assigncolor $id
371 }
372 set todo $startlist
373 set level [expr [llength $todo] - 1]
374 set y2 $canvy0
375 set nullentry -1
376 set lineno -1
377 set numcommits 0
378 while 1 {
379 set canvy $y2
380 allcanvs conf -scrollregion [list 0 0 0 $canvy]
381 update
382 if {$stopped} return
383 incr numcommits
384 incr lineno
385 set nlines [llength $todo]
386 set id [lindex $todo $level]
387 set lineid($lineno) $id
388 set actualparents {}
389 foreach p $parents($id) {
390 if {[info exists ncleft($p)]} {
391 incr ncleft($p) -1
392 lappend actualparents $p
393 }
394 }
395 if {![info exists commitinfo($id)]} {
396 readcommit $id
397 }
398 set x [expr $canvx0 + $level * $linespc]
399 set y2 [expr $canvy + $linespc]
400 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
401 set t [$canv create line $x $linestarty($level) $x $canvy \
402 -width 2 -fill $colormap($id)]
403 $canv lower $t
404 }
405 set linestarty($level) $canvy
406 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
407 [expr $x + 3] [expr $canvy + 3] \
408 -fill blue -outline black -width 1]
409 $canv raise $t
410 set xt [expr $canvx0 + $nlines * $linespc]
411 set headline [lindex $commitinfo($id) 0]
412 set name [lindex $commitinfo($id) 1]
413 set date [lindex $commitinfo($id) 2]
414 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
415 -text $headline -font $mainfont ]
416 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
417 -text $name -font $namefont]
418 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
419 -text $date -font $mainfont]
420 if {!$datemode && [llength $actualparents] == 1} {
421 set p [lindex $actualparents 0]
422 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
423 assigncolor $p
424 set todo [lreplace $todo $level $level $p]
425 continue
426 }
427 }
428 set oldtodo $todo
430 set oldlevel $level
431 set lines {}
432 for {set i 0} {$i < $nlines} {incr i} {
433 if {[lindex $todo $i] == {}} continue
434 if {[info exists linestarty($i)]} {
435 set oldstarty($i) $linestarty($i)
436 unset linestarty($i)
437 }
438 if {$i != $level} {
439 lappend lines [list $i [lindex $todo $i]]
440 }
441 }
442 if {$nullentry >= 0} {
443 set todo [lreplace $todo $nullentry $nullentry]
444 if {$nullentry < $level} {
445 incr level -1
446 }
447 }
448 set todo [lreplace $todo $level $level]
450 if {$nullentry > $level} {
451 incr nullentry -1
452 }
453 set i $level
454 foreach p $actualparents {
455 set k [lsearch -exact $todo $p]
456 if {$k < 0} {
457 assigncolor $p
458 set todo [linsert $todo $i $p]
459 if {$nullentry >= $i} {
460 incr nullentry
461 }
462 }
463 lappend lines [list $oldlevel $p]
464 }
465 # choose which one to do next time around
467 set todol [llength $todo]
468 set level -1
469 set latest {}
470 for {set k $todol} {[incr k -1] >= 0} {} {
471 set p [lindex $todo $k]
472 if {$p == {}} continue
473 if {$ncleft($p) == 0} {
474 if {$datemode} {
475 if {$latest == {} || $cdate($p) > $latest} {
476 set level $k
477 set latest $cdate($p)
478 }
479 } else {
480 set level $k
481 break
482 }
483 }
484 }
485 if {$level < 0} {
486 if {$todo != {}} {
487 puts "ERROR: none of the pending commits can be done yet:"
488 foreach p $todo {
489 puts " $p"
490 }
491 }
492 break
493 }
494 # If we are reducing, put in a null entry
496 if {$todol < $nlines} {
497 if {$nullentry >= 0} {
498 set i $nullentry
499 while {$i < $todol
500 && [lindex $oldtodo $i] == [lindex $todo $i]} {
501 incr i
502 }
503 } else {
504 set i $oldlevel
505 if {$level >= $i} {
506 incr i
507 }
508 }
509 if {$i >= $todol} {
510 set nullentry -1
511 } else {
512 set nullentry $i
513 set todo [linsert $todo $nullentry {}]
514 if {$level >= $i} {
515 incr level
516 }
517 }
518 } else {
519 set nullentry -1
520 }
521 foreach l $lines {
523 set i [lindex $l 0]
524 set dst [lindex $l 1]
525 set j [lsearch -exact $todo $dst]
526 if {$i == $j} {
527 if {[info exists oldstarty($i)]} {
528 set linestarty($i) $oldstarty($i)
529 }
530 continue
531 }
532 set xi [expr {$canvx0 + $i * $linespc}]
533 set xj [expr {$canvx0 + $j * $linespc}]
534 set coords {}
535 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
536 lappend coords $xi $oldstarty($i)
537 }
538 lappend coords $xi $canvy
539 if {$j < $i - 1} {
540 lappend coords [expr $xj + $linespc] $canvy
541 } elseif {$j > $i + 1} {
542 lappend coords [expr $xj - $linespc] $canvy
543 }
544 lappend coords $xj $y2
545 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
546 $canv lower $t
547 if {![info exists linestarty($j)]} {
548 set linestarty($j) $y2
549 }
550 }
551 }
552}
553proc dofind {} {
555 global findtype findloc findstring markedmatches commitinfo
556 global numcommits lineid linehtag linentag linedtag
557 global mainfont namefont canv canv2 canv3 selectedline
558 global matchinglines
559 unmarkmatches
560 set matchinglines {}
561 set fldtypes {Headline Author Date Committer CDate Comment}
562 if {$findtype == "IgnCase"} {
563 set fstr [string tolower $findstring]
564 } else {
565 set fstr $findstring
566 }
567 set mlen [string length $findstring]
568 if {$mlen == 0} return
569 if {![info exists selectedline]} {
570 set oldsel -1
571 } else {
572 set oldsel $selectedline
573 }
574 set didsel 0
575 for {set l 0} {$l < $numcommits} {incr l} {
576 set id $lineid($l)
577 set info $commitinfo($id)
578 set doesmatch 0
579 foreach f $info ty $fldtypes {
580 if {$findloc != "All fields" && $findloc != $ty} {
581 continue
582 }
583 if {$findtype == "Regexp"} {
584 set matches [regexp -indices -all -inline $fstr $f]
585 } else {
586 if {$findtype == "IgnCase"} {
587 set str [string tolower $f]
588 } else {
589 set str $f
590 }
591 set matches {}
592 set i 0
593 while {[set j [string first $fstr $str $i]] >= 0} {
594 lappend matches [list $j [expr $j+$mlen-1]]
595 set i [expr $j + $mlen]
596 }
597 }
598 if {$matches == {}} continue
599 set doesmatch 1
600 if {$ty == "Headline"} {
601 markmatches $canv $l $f $linehtag($l) $matches $mainfont
602 } elseif {$ty == "Author"} {
603 markmatches $canv2 $l $f $linentag($l) $matches $namefont
604 } elseif {$ty == "Date"} {
605 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
606 }
607 }
608 if {$doesmatch} {
609 lappend matchinglines $l
610 if {!$didsel && $l > $oldsel} {
611 selectline $l
612 set didsel 1
613 }
614 }
615 }
616 if {$matchinglines == {}} {
617 bell
618 } elseif {!$didsel} {
619 selectline [lindex $matchinglines 0]
620 }
621}
622proc findnext {} {
624 global matchinglines selectedline
625 if {![info exists matchinglines]} {
626 dofind
627 return
628 }
629 if {![info exists selectedline]} return
630 foreach l $matchinglines {
631 if {$l > $selectedline} {
632 selectline $l
633 return
634 }
635 }
636 bell
637}
638proc findprev {} {
640 global matchinglines selectedline
641 if {![info exists matchinglines]} {
642 dofind
643 return
644 }
645 if {![info exists selectedline]} return
646 set prev {}
647 foreach l $matchinglines {
648 if {$l >= $selectedline} break
649 set prev $l
650 }
651 if {$prev != {}} {
652 selectline $prev
653 } else {
654 bell
655 }
656}
657proc markmatches {canv l str tag matches font} {
659 set bbox [$canv bbox $tag]
660 set x0 [lindex $bbox 0]
661 set y0 [lindex $bbox 1]
662 set y1 [lindex $bbox 3]
663 foreach match $matches {
664 set start [lindex $match 0]
665 set end [lindex $match 1]
666 if {$start > $end} continue
667 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
668 set xlen [font measure $font [string range $str 0 [expr $end]]]
669 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
670 -outline {} -tags matches -fill yellow]
671 $canv lower $t
672 }
673}
674proc unmarkmatches {} {
676 global matchinglines
677 allcanvs delete matches
678 catch {unset matchinglines}
679}
680proc selcanvline {x y} {
682 global canv canvy0 ctext linespc selectedline
683 global lineid linehtag linentag linedtag
684 set ymax [lindex [$canv cget -scrollregion] 3]
685 set yfrac [lindex [$canv yview] 0]
686 set y [expr {$y + $yfrac * $ymax}]
687 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
688 if {$l < 0} {
689 set l 0
690 }
691 if {[info exists selectedline] && $selectedline == $l} return
692 unmarkmatches
693 selectline $l
694}
695proc selectline {l} {
697 global canv canv2 canv3 ctext commitinfo selectedline
698 global lineid linehtag linentag linedtag
699 global canvy canvy0 linespc nparents treepending
700 global cflist treediffs currentid sha1entry
701 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
702 $canv delete secsel
703 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
704 -tags secsel -fill [$canv cget -selectbackground]]
705 $canv lower $t
706 $canv2 delete secsel
707 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
708 -tags secsel -fill [$canv2 cget -selectbackground]]
709 $canv2 lower $t
710 $canv3 delete secsel
711 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
712 -tags secsel -fill [$canv3 cget -selectbackground]]
713 $canv3 lower $t
714 set y [expr {$canvy0 + $l * $linespc}]
715 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
716 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
717 set wnow [$canv yview]
718 if {$ytop < [lindex $wnow 0]} {
719 allcanvs yview moveto $ytop
720 } elseif {$ybot > [lindex $wnow 1]} {
721 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
722 allcanvs yview moveto [expr {$ybot - $wh}]
723 }
724 set selectedline $l
725 set id $lineid($l)
727 $sha1entry conf -state normal
728 $sha1entry delete 0 end
729 $sha1entry insert 0 $id
730 $sha1entry selection from 0
731 $sha1entry selection to end
732 $sha1entry conf -state readonly
733 $ctext conf -state normal
735 $ctext delete 0.0 end
736 set info $commitinfo($id)
737 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
738 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
739 $ctext insert end "\n"
740 $ctext insert end [lindex $info 5]
741 $ctext insert end "\n"
742 $ctext tag delete Comments
743 $ctext conf -state disabled
744 $cflist delete 0 end
746 set currentid $id
747 if {$nparents($id) == 1} {
748 if {![info exists treediffs($id)]} {
749 if {![info exists treepending]} {
750 gettreediffs $id
751 }
752 } else {
753 addtocflist $id
754 }
755 }
756}
757proc selnextline {dir} {
759 global selectedline
760 if {![info exists selectedline]} return
761 set l [expr $selectedline + $dir]
762 unmarkmatches
763 selectline $l
764}
765proc addtocflist {id} {
767 global currentid treediffs cflist treepending
768 if {$id != $currentid} {
769 gettreediffs $currentid
770 return
771 }
772 $cflist insert end "All files"
773 foreach f $treediffs($currentid) {
774 $cflist insert end $f
775 }
776 getblobdiffs $id
777}
778proc gettreediffs {id} {
780 global treediffs parents treepending
781 set treepending $id
782 set treediffs($id) {}
783 set p [lindex $parents($id) 0]
784 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
785 fconfigure $gdtf -blocking 0
786 fileevent $gdtf readable "gettreediffline $gdtf $id"
787}
788proc gettreediffline {gdtf id} {
790 global treediffs treepending
791 set n [gets $gdtf line]
792 if {$n < 0} {
793 if {![eof $gdtf]} return
794 close $gdtf
795 unset treepending
796 addtocflist $id
797 return
798 }
799 set type [lindex $line 1]
800 set file [lindex $line 3]
801 if {$type == "blob"} {
802 lappend treediffs($id) $file
803 }
804}
805proc getblobdiffs {id} {
807 global parents diffopts blobdifffd env curdifftag curtagstart
808 set p [lindex $parents($id) 0]
809 set env(GIT_DIFF_OPTS) $diffopts
810 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
811 puts "error getting diffs: $err"
812 return
813 }
814 fconfigure $bdf -blocking 0
815 set blobdifffd($id) $bdf
816 set curdifftag Comments
817 set curtagstart 0.0
818 fileevent $bdf readable "getblobdiffline $bdf $id"
819}
820proc getblobdiffline {bdf id} {
822 global currentid blobdifffd ctext curdifftag curtagstart
823 set n [gets $bdf line]
824 if {$n < 0} {
825 if {[eof $bdf]} {
826 close $bdf
827 if {$id == $currentid && $bdf == $blobdifffd($id)} {
828 $ctext tag add $curdifftag $curtagstart end
829 }
830 }
831 return
832 }
833 if {$id != $currentid || $bdf != $blobdifffd($id)} {
834 return
835 }
836 $ctext conf -state normal
837 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
838 # start of a new file
839 $ctext insert end "\n"
840 $ctext tag add $curdifftag $curtagstart end
841 set curtagstart [$ctext index "end - 1c"]
842 set curdifftag "f:$fname"
843 $ctext tag delete $curdifftag
844 set l [expr {(78 - [string length $fname]) / 2}]
845 set pad [string range "----------------------------------------" 1 $l]
846 $ctext insert end "$pad $fname $pad\n" filesep
847 } elseif {[string range $line 0 2] == "+++"} {
848 # no need to do anything with this
849 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
850 $line match f1l f1c f2l f2c rest]} {
851 $ctext insert end "\t" hunksep
852 $ctext insert end " $f1l " d0 " $f2l " d1
853 $ctext insert end " $rest \n" hunksep
854 } else {
855 set x [string range $line 0 0]
856 if {$x == "-" || $x == "+"} {
857 set tag [expr {$x == "+"}]
858 set line [string range $line 1 end]
859 $ctext insert end "$line\n" d$tag
860 } elseif {$x == " "} {
861 set line [string range $line 1 end]
862 $ctext insert end "$line\n"
863 } else {
864 # Something else we don't recognize
865 if {$curdifftag != "Comments"} {
866 $ctext insert end "\n"
867 $ctext tag add $curdifftag $curtagstart end
868 set curtagstart [$ctext index "end - 1c"]
869 set curdifftag Comments
870 }
871 $ctext insert end "$line\n" filesep
872 }
873 }
874 $ctext conf -state disabled
875}
876proc listboxsel {} {
878 global ctext cflist currentid treediffs
879 if {![info exists currentid]} return
880 set sel [$cflist curselection]
881 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
882 # show everything
883 $ctext tag conf Comments -elide 0
884 foreach f $treediffs($currentid) {
885 $ctext tag conf "f:$f" -elide 0
886 }
887 } else {
888 # just show selected files
889 $ctext tag conf Comments -elide 1
890 set i 1
891 foreach f $treediffs($currentid) {
892 set elide [expr {[lsearch -exact $sel $i] < 0}]
893 $ctext tag conf "f:$f" -elide $elide
894 incr i
895 }
896 }
897}
898if {![getcommits $revtreeargs]} {
900 exit 1
901}
902set linespc [font metrics $mainfont -linespace]
904set charspc [font measure $mainfont "m"]
905set canvy0 [expr 3 + 0.5 * $linespc]
907set canvx0 [expr 3 + 0.5 * $linespc]
908set namex [expr 45 * $charspc]
909set datex [expr 75 * $charspc]
910set stopped 0
912makewindow
913set start {}
915foreach id $commits {
916 if {$nchildren($id) == 0} {
917 lappend start $id
918 }
919}
920if {$start != {}} {
921 drawgraph $start
922}