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