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.12 $
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 stderr "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 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
159 set sha1entry .ctop.top.bar.sha1
161 label .ctop.top.bar.sha1label -text "SHA1 ID: "
162 pack .ctop.top.bar.sha1label -side left
163 entry $sha1entry -width 40 -font $textfont -state readonly
164 pack $sha1entry -side left -pady 2
165 button .ctop.top.bar.findbut -text "Find" -command dofind
166 pack .ctop.top.bar.findbut -side left
167 set findstring {}
168 entry .ctop.top.bar.findstring -width 30 -font $textfont \
169 -textvariable findstring
170 pack .ctop.top.bar.findstring -side left -expand 1 -fill x
171 set findtype Exact
172 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
173 set findloc "All fields"
174 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
175 Comments Author Committer
176 pack .ctop.top.bar.findloc -side right
177 pack .ctop.top.bar.findtype -side right
178 panedwindow .ctop.cdet -orient horizontal
180 .ctop add .ctop.cdet
181 frame .ctop.cdet.left
182 set ctext .ctop.cdet.left.ctext
183 text $ctext -bg white -state disabled -font $textfont -height 32 \
184 -yscrollcommand ".ctop.cdet.left.sb set"
185 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
186 pack .ctop.cdet.left.sb -side right -fill y
187 pack $ctext -side left -fill both -expand 1
188 .ctop.cdet add .ctop.cdet.left
189 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
190 $ctext tag conf filesep -font [concat $textfont bold]
192 $ctext tag conf hunksep -back blue -fore white
193 $ctext tag conf d0 -back "#ff8080"
194 $ctext tag conf d1 -back green
195 frame .ctop.cdet.right
197 set cflist .ctop.cdet.right.cfiles
198 listbox $cflist -width 30 -bg white -selectmode extended \
199 -yscrollcommand ".ctop.cdet.right.sb set"
200 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
201 pack .ctop.cdet.right.sb -side right -fill y
202 pack $cflist -side left -fill both -expand 1
203 .ctop.cdet add .ctop.cdet.right
204 pack .ctop -side top -fill both -expand 1
206 bindall <1> {selcanvline %x %y}
208 bindall <B1-Motion> {selcanvline %x %y}
209 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
210 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
211 bindall <2> "allcanvs scan mark 0 %y"
212 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
213 bind . <Key-Up> "selnextline -1"
214 bind . <Key-Down> "selnextline 1"
215 bind . p "selnextline -1"
216 bind . n "selnextline 1"
217 bind . <Key-Prior> "allcanvs yview scroll -1 p"
218 bind . <Key-Next> "allcanvs yview scroll 1 p"
219 bind . <Key-Delete> "$ctext yview scroll -1 p"
220 bind . <Key-BackSpace> "$ctext yview scroll -1 p"
221 bind . <Key-space> "$ctext yview scroll 1 p"
222 bind . b "$ctext yview scroll -1 p"
223 bind . d "$ctext yview scroll 18 u"
224 bind . u "$ctext yview scroll -18 u"
225 bind . Q doquit
226 bind . <Control-q> doquit
227 bind . <Control-f> dofind
228 bind . <Control-g> findnext
229 bind . <Control-r> findprev
230 bind . <Control-equal> {incrfont 1}
231 bind . <Control-KP_Add> {incrfont 1}
232 bind . <Control-minus> {incrfont -1}
233 bind . <Control-KP_Subtract> {incrfont -1}
234 bind $cflist <<ListboxSelect>> listboxsel
235}
236proc resizeclistpanes {win w} {
238 global oldwidth
239 if [info exists oldwidth($win)] {
240 set s0 [$win sash coord 0]
241 set s1 [$win sash coord 1]
242 if {$w < 60} {
243 set sash0 [expr {int($w/2 - 2)}]
244 set sash1 [expr {int($w*5/6 - 2)}]
245 } else {
246 set factor [expr {1.0 * $w / $oldwidth($win)}]
247 set sash0 [expr {int($factor * [lindex $s0 0])}]
248 set sash1 [expr {int($factor * [lindex $s1 0])}]
249 if {$sash0 < 30} {
250 set sash0 30
251 }
252 if {$sash1 < $sash0 + 20} {
253 set sash1 [expr $sash0 + 20]
254 }
255 if {$sash1 > $w - 10} {
256 set sash1 [expr $w - 10]
257 if {$sash0 > $sash1 - 20} {
258 set sash0 [expr $sash1 - 20]
259 }
260 }
261 }
262 $win sash place 0 $sash0 [lindex $s0 1]
263 $win sash place 1 $sash1 [lindex $s1 1]
264 }
265 set oldwidth($win) $w
266}
267proc resizecdetpanes {win w} {
269 global oldwidth
270 if [info exists oldwidth($win)] {
271 set s0 [$win sash coord 0]
272 if {$w < 60} {
273 set sash0 [expr {int($w*3/4 - 2)}]
274 } else {
275 set factor [expr {1.0 * $w / $oldwidth($win)}]
276 set sash0 [expr {int($factor * [lindex $s0 0])}]
277 if {$sash0 < 45} {
278 set sash0 45
279 }
280 if {$sash0 > $w - 15} {
281 set sash0 [expr $w - 15]
282 }
283 }
284 $win sash place 0 $sash0 [lindex $s0 1]
285 }
286 set oldwidth($win) $w
287}
288proc allcanvs args {
290 global canv canv2 canv3
291 eval $canv $args
292 eval $canv2 $args
293 eval $canv3 $args
294}
295proc bindall {event action} {
297 global canv canv2 canv3
298 bind $canv $event $action
299 bind $canv2 $event $action
300 bind $canv3 $event $action
301}
302proc about {} {
304 set w .about
305 if {[winfo exists $w]} {
306 raise $w
307 return
308 }
309 toplevel $w
310 wm title $w "About gitk"
311 message $w.m -text {
312Gitk version 0.91
313Copyright © 2005 Paul Mackerras
315Use and redistribute under the terms of the GNU General Public License
317(CVS $Revision: 1.12 $)} \
319 -justify center -aspect 400
320 pack $w.m -side top -fill x -padx 20 -pady 20
321 button $w.ok -text Close -command "destroy $w"
322 pack $w.ok -side bottom
323}
324proc truncatetofit {str width font} {
326 if {[font measure $font $str] <= $width} {
327 return $str
328 }
329 set best 0
330 set bad [string length $str]
331 set tmp $str
332 while {$best < $bad - 1} {
333 set try [expr {int(($best + $bad) / 2)}]
334 set tmp "[string range $str 0 [expr $try-1]]..."
335 if {[font measure $font $tmp] <= $width} {
336 set best $try
337 } else {
338 set bad $try
339 }
340 }
341 return $tmp
342}
343proc assigncolor {id} {
345 global commitinfo colormap commcolors colors nextcolor
346 global colorbycommitter
347 global parents nparents children nchildren
348 if [info exists colormap($id)] return
349 set ncolors [llength $colors]
350 if {$colorbycommitter} {
351 if {![info exists commitinfo($id)]} {
352 readcommit $id
353 }
354 set comm [lindex $commitinfo($id) 3]
355 if {![info exists commcolors($comm)]} {
356 set commcolors($comm) [lindex $colors $nextcolor]
357 if {[incr nextcolor] >= $ncolors} {
358 set nextcolor 0
359 }
360 }
361 set colormap($id) $commcolors($comm)
362 } else {
363 if {$nparents($id) == 1 && $nchildren($id) == 1} {
364 set child [lindex $children($id) 0]
365 if {[info exists colormap($child)]
366 && $nparents($child) == 1} {
367 set colormap($id) $colormap($child)
368 return
369 }
370 }
371 set badcolors {}
372 foreach child $children($id) {
373 if {[info exists colormap($child)]
374 && [lsearch -exact $badcolors $colormap($child)] < 0} {
375 lappend badcolors $colormap($child)
376 }
377 if {[info exists parents($child)]} {
378 foreach p $parents($child) {
379 if {[info exists colormap($p)]
380 && [lsearch -exact $badcolors $colormap($p)] < 0} {
381 lappend badcolors $colormap($p)
382 }
383 }
384 }
385 }
386 if {[llength $badcolors] >= $ncolors} {
387 set badcolors {}
388 }
389 for {set i 0} {$i <= $ncolors} {incr i} {
390 set c [lindex $colors $nextcolor]
391 if {[incr nextcolor] >= $ncolors} {
392 set nextcolor 0
393 }
394 if {[lsearch -exact $badcolors $c]} break
395 }
396 set colormap($id) $c
397 }
398}
399proc drawgraph {} {
401 global parents children nparents nchildren commits
402 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
403 global datemode cdate
404 global lineid linehtag linentag linedtag commitinfo
405 global nextcolor colormap numcommits
406 global stopped phase redisplaying selectedline
407 allcanvs delete all
409 set start {}
410 foreach id $commits {
411 if {$nchildren($id) == 0} {
412 lappend start $id
413 }
414 set ncleft($id) $nchildren($id)
415 }
416 if {$start == {}} {
417 $canv create text 3 3 -anchor nw -font $mainfont \
418 -text "ERROR: No starting commits found"
419 set phase {}
420 return
421 }
422 set nextcolor 0
424 foreach id $start {
425 assigncolor $id
426 }
427 set todo $start
428 set level [expr [llength $todo] - 1]
429 set y2 $canvy0
430 set nullentry -1
431 set lineno -1
432 set numcommits 0
433 set phase drawgraph
434 while 1 {
435 set canvy $y2
436 allcanvs conf -scrollregion [list 0 0 0 $canvy]
437 update
438 if {$stopped} break
439 incr numcommits
440 incr lineno
441 set nlines [llength $todo]
442 set id [lindex $todo $level]
443 set lineid($lineno) $id
444 set actualparents {}
445 foreach p $parents($id) {
446 if {[info exists ncleft($p)]} {
447 incr ncleft($p) -1
448 lappend actualparents $p
449 }
450 }
451 if {![info exists commitinfo($id)]} {
452 readcommit $id
453 }
454 set x [expr $canvx0 + $level * $linespc]
455 set y2 [expr $canvy + $linespc]
456 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
457 set t [$canv create line $x $linestarty($level) $x $canvy \
458 -width 2 -fill $colormap($id)]
459 $canv lower $t
460 }
461 set linestarty($level) $canvy
462 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
463 [expr $x + 3] [expr $canvy + 3] \
464 -fill blue -outline black -width 1]
465 $canv raise $t
466 set xt [expr $canvx0 + $nlines * $linespc]
467 set headline [lindex $commitinfo($id) 0]
468 set name [lindex $commitinfo($id) 1]
469 set date [lindex $commitinfo($id) 2]
470 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
471 -text $headline -font $mainfont ]
472 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
473 -text $name -font $namefont]
474 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
475 -text $date -font $mainfont]
476 if {!$datemode && [llength $actualparents] == 1} {
477 set p [lindex $actualparents 0]
478 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
479 assigncolor $p
480 set todo [lreplace $todo $level $level $p]
481 continue
482 }
483 }
484 set oldtodo $todo
486 set oldlevel $level
487 set lines {}
488 for {set i 0} {$i < $nlines} {incr i} {
489 if {[lindex $todo $i] == {}} continue
490 if {[info exists linestarty($i)]} {
491 set oldstarty($i) $linestarty($i)
492 unset linestarty($i)
493 }
494 if {$i != $level} {
495 lappend lines [list $i [lindex $todo $i]]
496 }
497 }
498 if {$nullentry >= 0} {
499 set todo [lreplace $todo $nullentry $nullentry]
500 if {$nullentry < $level} {
501 incr level -1
502 }
503 }
504 set todo [lreplace $todo $level $level]
506 if {$nullentry > $level} {
507 incr nullentry -1
508 }
509 set i $level
510 foreach p $actualparents {
511 set k [lsearch -exact $todo $p]
512 if {$k < 0} {
513 assigncolor $p
514 set todo [linsert $todo $i $p]
515 if {$nullentry >= $i} {
516 incr nullentry
517 }
518 }
519 lappend lines [list $oldlevel $p]
520 }
521 # choose which one to do next time around
523 set todol [llength $todo]
524 set level -1
525 set latest {}
526 for {set k $todol} {[incr k -1] >= 0} {} {
527 set p [lindex $todo $k]
528 if {$p == {}} continue
529 if {$ncleft($p) == 0} {
530 if {$datemode} {
531 if {$latest == {} || $cdate($p) > $latest} {
532 set level $k
533 set latest $cdate($p)
534 }
535 } else {
536 set level $k
537 break
538 }
539 }
540 }
541 if {$level < 0} {
542 if {$todo != {}} {
543 puts "ERROR: none of the pending commits can be done yet:"
544 foreach p $todo {
545 puts " $p"
546 }
547 }
548 break
549 }
550 # If we are reducing, put in a null entry
552 if {$todol < $nlines} {
553 if {$nullentry >= 0} {
554 set i $nullentry
555 while {$i < $todol
556 && [lindex $oldtodo $i] == [lindex $todo $i]} {
557 incr i
558 }
559 } else {
560 set i $oldlevel
561 if {$level >= $i} {
562 incr i
563 }
564 }
565 if {$i >= $todol} {
566 set nullentry -1
567 } else {
568 set nullentry $i
569 set todo [linsert $todo $nullentry {}]
570 if {$level >= $i} {
571 incr level
572 }
573 }
574 } else {
575 set nullentry -1
576 }
577 foreach l $lines {
579 set i [lindex $l 0]
580 set dst [lindex $l 1]
581 set j [lsearch -exact $todo $dst]
582 if {$i == $j} {
583 if {[info exists oldstarty($i)]} {
584 set linestarty($i) $oldstarty($i)
585 }
586 continue
587 }
588 set xi [expr {$canvx0 + $i * $linespc}]
589 set xj [expr {$canvx0 + $j * $linespc}]
590 set coords {}
591 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
592 lappend coords $xi $oldstarty($i)
593 }
594 lappend coords $xi $canvy
595 if {$j < $i - 1} {
596 lappend coords [expr $xj + $linespc] $canvy
597 } elseif {$j > $i + 1} {
598 lappend coords [expr $xj - $linespc] $canvy
599 }
600 lappend coords $xj $y2
601 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
602 $canv lower $t
603 if {![info exists linestarty($j)]} {
604 set linestarty($j) $y2
605 }
606 }
607 }
608 set phase {}
609 if {$redisplaying} {
610 if {$stopped == 0 && [info exists selectedline]} {
611 selectline $selectedline
612 }
613 if {$stopped == 1} {
614 set stopped 0
615 after idle drawgraph
616 } else {
617 set redisplaying 0
618 }
619 }
620}
621proc dofind {} {
623 global findtype findloc findstring markedmatches commitinfo
624 global numcommits lineid linehtag linentag linedtag
625 global mainfont namefont canv canv2 canv3 selectedline
626 global matchinglines
627 unmarkmatches
628 set matchinglines {}
629 set fldtypes {Headline Author Date Committer CDate Comment}
630 if {$findtype == "IgnCase"} {
631 set fstr [string tolower $findstring]
632 } else {
633 set fstr $findstring
634 }
635 set mlen [string length $findstring]
636 if {$mlen == 0} return
637 if {![info exists selectedline]} {
638 set oldsel -1
639 } else {
640 set oldsel $selectedline
641 }
642 set didsel 0
643 for {set l 0} {$l < $numcommits} {incr l} {
644 set id $lineid($l)
645 set info $commitinfo($id)
646 set doesmatch 0
647 foreach f $info ty $fldtypes {
648 if {$findloc != "All fields" && $findloc != $ty} {
649 continue
650 }
651 if {$findtype == "Regexp"} {
652 set matches [regexp -indices -all -inline $fstr $f]
653 } else {
654 if {$findtype == "IgnCase"} {
655 set str [string tolower $f]
656 } else {
657 set str $f
658 }
659 set matches {}
660 set i 0
661 while {[set j [string first $fstr $str $i]] >= 0} {
662 lappend matches [list $j [expr $j+$mlen-1]]
663 set i [expr $j + $mlen]
664 }
665 }
666 if {$matches == {}} continue
667 set doesmatch 1
668 if {$ty == "Headline"} {
669 markmatches $canv $l $f $linehtag($l) $matches $mainfont
670 } elseif {$ty == "Author"} {
671 markmatches $canv2 $l $f $linentag($l) $matches $namefont
672 } elseif {$ty == "Date"} {
673 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
674 }
675 }
676 if {$doesmatch} {
677 lappend matchinglines $l
678 if {!$didsel && $l > $oldsel} {
679 selectline $l
680 set didsel 1
681 }
682 }
683 }
684 if {$matchinglines == {}} {
685 bell
686 } elseif {!$didsel} {
687 selectline [lindex $matchinglines 0]
688 }
689}
690proc findnext {} {
692 global matchinglines selectedline
693 if {![info exists matchinglines]} {
694 dofind
695 return
696 }
697 if {![info exists selectedline]} return
698 foreach l $matchinglines {
699 if {$l > $selectedline} {
700 selectline $l
701 return
702 }
703 }
704 bell
705}
706proc findprev {} {
708 global matchinglines selectedline
709 if {![info exists matchinglines]} {
710 dofind
711 return
712 }
713 if {![info exists selectedline]} return
714 set prev {}
715 foreach l $matchinglines {
716 if {$l >= $selectedline} break
717 set prev $l
718 }
719 if {$prev != {}} {
720 selectline $prev
721 } else {
722 bell
723 }
724}
725proc markmatches {canv l str tag matches font} {
727 set bbox [$canv bbox $tag]
728 set x0 [lindex $bbox 0]
729 set y0 [lindex $bbox 1]
730 set y1 [lindex $bbox 3]
731 foreach match $matches {
732 set start [lindex $match 0]
733 set end [lindex $match 1]
734 if {$start > $end} continue
735 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
736 set xlen [font measure $font [string range $str 0 [expr $end]]]
737 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
738 -outline {} -tags matches -fill yellow]
739 $canv lower $t
740 }
741}
742proc unmarkmatches {} {
744 global matchinglines
745 allcanvs delete matches
746 catch {unset matchinglines}
747}
748proc selcanvline {x y} {
750 global canv canvy0 ctext linespc selectedline
751 global lineid linehtag linentag linedtag
752 set ymax [lindex [$canv cget -scrollregion] 3]
753 set yfrac [lindex [$canv yview] 0]
754 set y [expr {$y + $yfrac * $ymax}]
755 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
756 if {$l < 0} {
757 set l 0
758 }
759 if {[info exists selectedline] && $selectedline == $l} return
760 unmarkmatches
761 selectline $l
762}
763proc selectline {l} {
765 global canv canv2 canv3 ctext commitinfo selectedline
766 global lineid linehtag linentag linedtag
767 global canvy canvy0 linespc nparents treepending
768 global cflist treediffs currentid sha1entry
769 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
770 $canv delete secsel
771 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
772 -tags secsel -fill [$canv cget -selectbackground]]
773 $canv lower $t
774 $canv2 delete secsel
775 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
776 -tags secsel -fill [$canv2 cget -selectbackground]]
777 $canv2 lower $t
778 $canv3 delete secsel
779 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
780 -tags secsel -fill [$canv3 cget -selectbackground]]
781 $canv3 lower $t
782 set y [expr {$canvy0 + $l * $linespc}]
783 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
784 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
785 set wnow [$canv yview]
786 if {$ytop < [lindex $wnow 0]} {
787 allcanvs yview moveto $ytop
788 } elseif {$ybot > [lindex $wnow 1]} {
789 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
790 allcanvs yview moveto [expr {$ybot - $wh}]
791 }
792 set selectedline $l
793 set id $lineid($l)
795 $sha1entry conf -state normal
796 $sha1entry delete 0 end
797 $sha1entry insert 0 $id
798 $sha1entry selection from 0
799 $sha1entry selection to end
800 $sha1entry conf -state readonly
801 $ctext conf -state normal
803 $ctext delete 0.0 end
804 set info $commitinfo($id)
805 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
806 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
807 $ctext insert end "\n"
808 $ctext insert end [lindex $info 5]
809 $ctext insert end "\n"
810 $ctext tag delete Comments
811 $ctext conf -state disabled
812 $cflist delete 0 end
814 set currentid $id
815 if {$nparents($id) == 1} {
816 if {![info exists treediffs($id)]} {
817 if {![info exists treepending]} {
818 gettreediffs $id
819 }
820 } else {
821 addtocflist $id
822 }
823 }
824}
825proc selnextline {dir} {
827 global selectedline
828 if {![info exists selectedline]} return
829 set l [expr $selectedline + $dir]
830 unmarkmatches
831 selectline $l
832}
833proc addtocflist {id} {
835 global currentid treediffs cflist treepending
836 if {$id != $currentid} {
837 gettreediffs $currentid
838 return
839 }
840 $cflist insert end "All files"
841 foreach f $treediffs($currentid) {
842 $cflist insert end $f
843 }
844 getblobdiffs $id
845}
846proc gettreediffs {id} {
848 global treediffs parents treepending
849 set treepending $id
850 set treediffs($id) {}
851 set p [lindex $parents($id) 0]
852 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
853 fconfigure $gdtf -blocking 0
854 fileevent $gdtf readable "gettreediffline $gdtf $id"
855}
856proc gettreediffline {gdtf id} {
858 global treediffs treepending
859 set n [gets $gdtf line]
860 if {$n < 0} {
861 if {![eof $gdtf]} return
862 close $gdtf
863 unset treepending
864 addtocflist $id
865 return
866 }
867 set type [lindex $line 1]
868 set file [lindex $line 3]
869 if {$type == "blob"} {
870 lappend treediffs($id) $file
871 }
872}
873proc getblobdiffs {id} {
875 global parents diffopts blobdifffd env curdifftag curtagstart
876 set p [lindex $parents($id) 0]
877 set env(GIT_DIFF_OPTS) $diffopts
878 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
879 puts "error getting diffs: $err"
880 return
881 }
882 fconfigure $bdf -blocking 0
883 set blobdifffd($id) $bdf
884 set curdifftag Comments
885 set curtagstart 0.0
886 fileevent $bdf readable "getblobdiffline $bdf $id"
887}
888proc getblobdiffline {bdf id} {
890 global currentid blobdifffd ctext curdifftag curtagstart
891 set n [gets $bdf line]
892 if {$n < 0} {
893 if {[eof $bdf]} {
894 close $bdf
895 if {$id == $currentid && $bdf == $blobdifffd($id)} {
896 $ctext tag add $curdifftag $curtagstart end
897 }
898 }
899 return
900 }
901 if {$id != $currentid || $bdf != $blobdifffd($id)} {
902 return
903 }
904 $ctext conf -state normal
905 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
906 # start of a new file
907 $ctext insert end "\n"
908 $ctext tag add $curdifftag $curtagstart end
909 set curtagstart [$ctext index "end - 1c"]
910 set curdifftag "f:$fname"
911 $ctext tag delete $curdifftag
912 set l [expr {(78 - [string length $fname]) / 2}]
913 set pad [string range "----------------------------------------" 1 $l]
914 $ctext insert end "$pad $fname $pad\n" filesep
915 } elseif {[string range $line 0 2] == "+++"} {
916 # no need to do anything with this
917 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
918 $line match f1l f1c f2l f2c rest]} {
919 $ctext insert end "\t" hunksep
920 $ctext insert end " $f1l " d0 " $f2l " d1
921 $ctext insert end " $rest \n" hunksep
922 } else {
923 set x [string range $line 0 0]
924 if {$x == "-" || $x == "+"} {
925 set tag [expr {$x == "+"}]
926 set line [string range $line 1 end]
927 $ctext insert end "$line\n" d$tag
928 } elseif {$x == " "} {
929 set line [string range $line 1 end]
930 $ctext insert end "$line\n"
931 } else {
932 # Something else we don't recognize
933 if {$curdifftag != "Comments"} {
934 $ctext insert end "\n"
935 $ctext tag add $curdifftag $curtagstart end
936 set curtagstart [$ctext index "end - 1c"]
937 set curdifftag Comments
938 }
939 $ctext insert end "$line\n" filesep
940 }
941 }
942 $ctext conf -state disabled
943}
944proc listboxsel {} {
946 global ctext cflist currentid treediffs
947 if {![info exists currentid]} return
948 set sel [$cflist curselection]
949 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
950 # show everything
951 $ctext tag conf Comments -elide 0
952 foreach f $treediffs($currentid) {
953 $ctext tag conf "f:$f" -elide 0
954 }
955 } else {
956 # just show selected files
957 $ctext tag conf Comments -elide 1
958 set i 1
959 foreach f $treediffs($currentid) {
960 set elide [expr {[lsearch -exact $sel $i] < 0}]
961 $ctext tag conf "f:$f" -elide $elide
962 incr i
963 }
964 }
965}
966proc setcoords {} {
968 global linespc charspc canvx0 canvy0 mainfont
969 set linespc [font metrics $mainfont -linespace]
970 set charspc [font measure $mainfont "m"]
971 set canvy0 [expr 3 + 0.5 * $linespc]
972 set canvx0 [expr 3 + 0.5 * $linespc]
973}
974proc redisplay {} {
976 global selectedline stopped redisplaying phase
977 if {$stopped > 1} return
978 if {$phase == "getcommits"} return
979 set redisplaying 1
980 if {$phase == "drawgraph"} {
981 set stopped 1
982 } else {
983 drawgraph
984 }
985}
986proc incrfont {inc} {
988 global mainfont namefont textfont selectedline ctext canv phase
989 global stopped
990 unmarkmatches
991 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
992 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
993 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
994 setcoords
995 $ctext conf -font $textfont
996 $ctext tag conf filesep -font [concat $textfont bold]
997 if {$phase == "getcommits"} {
998 $canv itemconf textitems -font $mainfont
999 }
1000 redisplay
1001}
1002proc doquit {} {
1004 global stopped
1005 set stopped 100
1006 destroy .
1007}
1008# defaults...
1010set datemode 0
1011set boldnames 0
1012set diffopts "-U 5 -p"
1013set mainfont {Helvetica 9}
1015set namefont $mainfont
1016set textfont {Courier 9}
1017if {$boldnames} {
1018 lappend namefont bold
1019}
1020set colors {green red blue magenta darkgrey brown orange}
1022set colorbycommitter false
1023catch {source ~/.gitk}
1025set revtreeargs {}
1027foreach arg $argv {
1028 switch -regexp -- $arg {
1029 "^$" { }
1030 "^-b" { set boldnames 1 }
1031 "^-c" { set colorbycommitter 1 }
1032 "^-d" { set datemode 1 }
1033 "^-.*" {
1034 puts stderr "unrecognized option $arg"
1035 exit 1
1036 }
1037 default {
1038 lappend revtreeargs $arg
1039 }
1040 }
1041}
1042set stopped 0
1044set redisplaying 0
1045setcoords
1046makewindow
1047getcommits $revtreeargs