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