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.14 $
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 # this works around what is apparently a bug in Tcl...
36 fconfigure $commfd -blocking 1
37 if {![catch {close $commfd} err]} {
38 after idle drawgraph
39 return
40 }
41 if {[string range $err 0 4] == "usage"} {
42 set err "\
43Gitk: error reading commits: bad arguments to git-rev-tree.\n\
44(Note: arguments to gitk are passed to git-rev-tree\
45to allow selection of commits to be displayed.)"
46 } else {
47 set err "Error reading commits: $err"
48 }
49 error_popup $err
50 exit 1
51 }
52 set i 0
54 set cid {}
55 foreach f $line {
56 if {$i == 0} {
57 set d $f
58 } else {
59 set id [lindex [split $f :] 0]
60 if {![info exists nchildren($id)]} {
61 set children($id) {}
62 set nchildren($id) 0
63 }
64 if {$i == 1} {
65 set cid $id
66 lappend commits $id
67 set parents($id) {}
68 set cdate($id) $d
69 set nparents($id) 0
70 } else {
71 lappend parents($cid) $id
72 incr nparents($cid)
73 incr nchildren($id)
74 lappend children($id) $cid
75 }
76 }
77 incr i
78 }
79}
80proc readcommit {id} {
82 global commitinfo
83 set inhdr 1
84 set comment {}
85 set headline {}
86 set auname {}
87 set audate {}
88 set comname {}
89 set comdate {}
90 if [catch {set contents [exec git-cat-file commit $id]}] return
91 foreach line [split $contents "\n"] {
92 if {$inhdr} {
93 if {$line == {}} {
94 set inhdr 0
95 } else {
96 set tag [lindex $line 0]
97 if {$tag == "author"} {
98 set x [expr {[llength $line] - 2}]
99 set audate [lindex $line $x]
100 set auname [lrange $line 1 [expr {$x - 1}]]
101 } elseif {$tag == "committer"} {
102 set x [expr {[llength $line] - 2}]
103 set comdate [lindex $line $x]
104 set comname [lrange $line 1 [expr {$x - 1}]]
105 }
106 }
107 } else {
108 if {$comment == {}} {
109 set headline $line
110 } else {
111 append comment "\n"
112 }
113 append comment $line
114 }
115 }
116 if {$audate != {}} {
117 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
118 }
119 if {$comdate != {}} {
120 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
121 }
122 set commitinfo($id) [list $headline $auname $audate \
123 $comname $comdate $comment]
124}
125proc error_popup msg {
127 set w .error
128 toplevel $w
129 wm transient $w .
130 message $w.m -text $msg -justify center -aspect 400
131 pack $w.m -side top -fill x -padx 20 -pady 20
132 button $w.ok -text OK -command "destroy $w"
133 pack $w.ok -side bottom -fill x
134 bind $w <Visibility> "grab $w; focus $w"
135 tkwait window $w
136}
137proc makewindow {} {
139 global canv canv2 canv3 linespc charspc ctext cflist textfont
140 global sha1entry findtype findloc findstring fstring geometry
141 menu .bar
143 .bar add cascade -label "File" -menu .bar.file
144 menu .bar.file
145 .bar.file add command -label "Quit" -command doquit
146 menu .bar.help
147 .bar add cascade -label "Help" -menu .bar.help
148 .bar.help add command -label "About gitk" -command about
149 . configure -menu .bar
150 if {![info exists geometry(canv1)]} {
152 set geometry(canv1) [expr 45 * $charspc]
153 set geometry(canv2) [expr 30 * $charspc]
154 set geometry(canv3) [expr 15 * $charspc]
155 set geometry(canvh) [expr 25 * $linespc + 4]
156 set geometry(ctextw) 80
157 set geometry(ctexth) 30
158 set geometry(cflistw) 30
159 }
160 panedwindow .ctop -orient vertical
161 if {[info exists geometry(width)]} {
162 .ctop conf -width $geometry(width) -height $geometry(height)
163 }
164 frame .ctop.top
165 frame .ctop.top.bar
166 pack .ctop.top.bar -side bottom -fill x
167 set cscroll .ctop.top.csb
168 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
169 pack $cscroll -side right -fill y
170 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
171 pack .ctop.top.clist -side top -fill both -expand 1
172 .ctop add .ctop.top
173 set canv .ctop.top.clist.canv
174 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
175 -bg white -bd 0 \
176 -yscrollincr $linespc -yscrollcommand "$cscroll set"
177 .ctop.top.clist add $canv
178 set canv2 .ctop.top.clist.canv2
179 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
180 -bg white -bd 0 -yscrollincr $linespc
181 .ctop.top.clist add $canv2
182 set canv3 .ctop.top.clist.canv3
183 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
184 -bg white -bd 0 -yscrollincr $linespc
185 .ctop.top.clist add $canv3
186 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
187 set sha1entry .ctop.top.bar.sha1
189 label .ctop.top.bar.sha1label -text "SHA1 ID: "
190 pack .ctop.top.bar.sha1label -side left
191 entry $sha1entry -width 40 -font $textfont -state readonly
192 pack $sha1entry -side left -pady 2
193 button .ctop.top.bar.findbut -text "Find" -command dofind
194 pack .ctop.top.bar.findbut -side left
195 set findstring {}
196 set fstring .ctop.top.bar.findstring
197 entry $fstring -width 30 -font $textfont -textvariable findstring
198 # stop the toplevel events from firing on key presses
199 bind $fstring <Key> "[bind Entry <Key>]; break"
200 pack $fstring -side left -expand 1 -fill x
201 set findtype Exact
202 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
203 set findloc "All fields"
204 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
205 Comments Author Committer
206 pack .ctop.top.bar.findloc -side right
207 pack .ctop.top.bar.findtype -side right
208 panedwindow .ctop.cdet -orient horizontal
210 .ctop add .ctop.cdet
211 frame .ctop.cdet.left
212 set ctext .ctop.cdet.left.ctext
213 text $ctext -bg white -state disabled -font $textfont \
214 -width $geometry(ctextw) -height $geometry(ctexth) \
215 -yscrollcommand ".ctop.cdet.left.sb set"
216 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
217 pack .ctop.cdet.left.sb -side right -fill y
218 pack $ctext -side left -fill both -expand 1
219 .ctop.cdet add .ctop.cdet.left
220 $ctext tag conf filesep -font [concat $textfont bold]
222 $ctext tag conf hunksep -back blue -fore white
223 $ctext tag conf d0 -back "#ff8080"
224 $ctext tag conf d1 -back green
225 $ctext tag conf found -back yellow
226 frame .ctop.cdet.right
228 set cflist .ctop.cdet.right.cfiles
229 listbox $cflist -width $geometry(cflistw) -bg white -selectmode extended \
230 -yscrollcommand ".ctop.cdet.right.sb set"
231 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
232 pack .ctop.cdet.right.sb -side right -fill y
233 pack $cflist -side left -fill both -expand 1
234 .ctop.cdet add .ctop.cdet.right
235 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
236 pack .ctop -side top -fill both -expand 1
238 bindall <1> {selcanvline %x %y}
240 bindall <B1-Motion> {selcanvline %x %y}
241 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
242 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
243 bindall <2> "allcanvs scan mark 0 %y"
244 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
245 bindall <Key-Up> "selnextline -1"
246 bindall <Key-Down> "selnextline 1"
247 bindall <Key-Prior> "allcanvs yview scroll -1 p"
248 bindall <Key-Next> "allcanvs yview scroll 1 p"
249 bindkey <Key-Delete> "$ctext yview scroll -1 p"
250 bindkey <Key-BackSpace> "$ctext yview scroll -1 p"
251 bindkey <Key-space> "$ctext yview scroll 1 p"
252 bindkey p "selnextline -1"
253 bindkey n "selnextline 1"
254 bindkey b "$ctext yview scroll -1 p"
255 bindkey d "$ctext yview scroll 18 u"
256 bindkey u "$ctext yview scroll -18 u"
257 bindkey / findnext
258 bindkey ? findprev
259 bind . <Control-q> doquit
260 bind . <Control-f> dofind
261 bind . <Control-g> findnext
262 bind . <Control-r> findprev
263 bind . <Control-equal> {incrfont 1}
264 bind . <Control-KP_Add> {incrfont 1}
265 bind . <Control-minus> {incrfont -1}
266 bind . <Control-KP_Subtract> {incrfont -1}
267 bind $cflist <<ListboxSelect>> listboxsel
268 bind . <Destroy> {savestuff %W}
269 bind . <Button-1> "click %W"
270}
271# when we make a key binding for the toplevel, make sure
273# it doesn't get triggered when that key is pressed in the
274# find string entry widget.
275proc bindkey {ev script} {
276 global fstring
277 bind . $ev $script
278 set escript [bind Entry $ev]
279 if {$escript == {}} {
280 set escript [bind Entry <Key>]
281 }
282 bind $fstring $ev "$escript; break"
283}
284# set the focus back to the toplevel for any click outside
286# the find string entry widget
287proc click {w} {
288 global fstring
289 if {$w != $fstring} {
290 focus .
291 }
292}
293proc savestuff {w} {
295 global canv canv2 canv3 ctext cflist mainfont textfont
296 global stuffsaved
297 if {$stuffsaved} return
298 if {![winfo viewable .]} return
299 catch {
300 set f [open "~/.gitk-new" w]
301 puts $f "set mainfont {$mainfont}"
302 puts $f "set textfont {$textfont}"
303 puts $f "set geometry(width) [winfo width .ctop]"
304 puts $f "set geometry(height) [winfo height .ctop]"
305 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
306 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
307 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
308 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
309 puts $f "set geometry(csash) {[.ctop sash coord 0]}"
310 set wid [expr {([winfo width $ctext] - 8) \
311 / [font measure $textfont "0"]}]
312 set ht [expr {([winfo height $ctext] - 8) \
313 / [font metrics $textfont -linespace]}]
314 puts $f "set geometry(ctextw) $wid"
315 puts $f "set geometry(ctexth) $ht"
316 set wid [expr {([winfo width $cflist] - 11) \
317 / [font measure [$cflist cget -font] "0"]}]
318 puts $f "set geometry(cflistw) $wid"
319 close $f
320 file rename -force "~/.gitk-new" "~/.gitk"
321 }
322 set stuffsaved 1
323}
324proc resizeclistpanes {win w} {
326 global oldwidth
327 if [info exists oldwidth($win)] {
328 set s0 [$win sash coord 0]
329 set s1 [$win sash coord 1]
330 if {$w < 60} {
331 set sash0 [expr {int($w/2 - 2)}]
332 set sash1 [expr {int($w*5/6 - 2)}]
333 } else {
334 set factor [expr {1.0 * $w / $oldwidth($win)}]
335 set sash0 [expr {int($factor * [lindex $s0 0])}]
336 set sash1 [expr {int($factor * [lindex $s1 0])}]
337 if {$sash0 < 30} {
338 set sash0 30
339 }
340 if {$sash1 < $sash0 + 20} {
341 set sash1 [expr $sash0 + 20]
342 }
343 if {$sash1 > $w - 10} {
344 set sash1 [expr $w - 10]
345 if {$sash0 > $sash1 - 20} {
346 set sash0 [expr $sash1 - 20]
347 }
348 }
349 }
350 $win sash place 0 $sash0 [lindex $s0 1]
351 $win sash place 1 $sash1 [lindex $s1 1]
352 }
353 set oldwidth($win) $w
354}
355proc resizecdetpanes {win w} {
357 global oldwidth
358 if [info exists oldwidth($win)] {
359 set s0 [$win sash coord 0]
360 if {$w < 60} {
361 set sash0 [expr {int($w*3/4 - 2)}]
362 } else {
363 set factor [expr {1.0 * $w / $oldwidth($win)}]
364 set sash0 [expr {int($factor * [lindex $s0 0])}]
365 if {$sash0 < 45} {
366 set sash0 45
367 }
368 if {$sash0 > $w - 15} {
369 set sash0 [expr $w - 15]
370 }
371 }
372 $win sash place 0 $sash0 [lindex $s0 1]
373 }
374 set oldwidth($win) $w
375}
376proc allcanvs args {
378 global canv canv2 canv3
379 eval $canv $args
380 eval $canv2 $args
381 eval $canv3 $args
382}
383proc bindall {event action} {
385 global canv canv2 canv3
386 bind $canv $event $action
387 bind $canv2 $event $action
388 bind $canv3 $event $action
389}
390proc about {} {
392 set w .about
393 if {[winfo exists $w]} {
394 raise $w
395 return
396 }
397 toplevel $w
398 wm title $w "About gitk"
399 message $w.m -text {
400Gitk version 0.95
401Copyright © 2005 Paul Mackerras
403Use and redistribute under the terms of the GNU General Public License
405(CVS $Revision: 1.14 $)} \
407 -justify center -aspect 400
408 pack $w.m -side top -fill x -padx 20 -pady 20
409 button $w.ok -text Close -command "destroy $w"
410 pack $w.ok -side bottom
411}
412proc truncatetofit {str width font} {
414 if {[font measure $font $str] <= $width} {
415 return $str
416 }
417 set best 0
418 set bad [string length $str]
419 set tmp $str
420 while {$best < $bad - 1} {
421 set try [expr {int(($best + $bad) / 2)}]
422 set tmp "[string range $str 0 [expr $try-1]]..."
423 if {[font measure $font $tmp] <= $width} {
424 set best $try
425 } else {
426 set bad $try
427 }
428 }
429 return $tmp
430}
431proc assigncolor {id} {
433 global commitinfo colormap commcolors colors nextcolor
434 global colorbycommitter
435 global parents nparents children nchildren
436 if [info exists colormap($id)] return
437 set ncolors [llength $colors]
438 if {$colorbycommitter} {
439 if {![info exists commitinfo($id)]} {
440 readcommit $id
441 }
442 set comm [lindex $commitinfo($id) 3]
443 if {![info exists commcolors($comm)]} {
444 set commcolors($comm) [lindex $colors $nextcolor]
445 if {[incr nextcolor] >= $ncolors} {
446 set nextcolor 0
447 }
448 }
449 set colormap($id) $commcolors($comm)
450 } else {
451 if {$nparents($id) == 1 && $nchildren($id) == 1} {
452 set child [lindex $children($id) 0]
453 if {[info exists colormap($child)]
454 && $nparents($child) == 1} {
455 set colormap($id) $colormap($child)
456 return
457 }
458 }
459 set badcolors {}
460 foreach child $children($id) {
461 if {[info exists colormap($child)]
462 && [lsearch -exact $badcolors $colormap($child)] < 0} {
463 lappend badcolors $colormap($child)
464 }
465 if {[info exists parents($child)]} {
466 foreach p $parents($child) {
467 if {[info exists colormap($p)]
468 && [lsearch -exact $badcolors $colormap($p)] < 0} {
469 lappend badcolors $colormap($p)
470 }
471 }
472 }
473 }
474 if {[llength $badcolors] >= $ncolors} {
475 set badcolors {}
476 }
477 for {set i 0} {$i <= $ncolors} {incr i} {
478 set c [lindex $colors $nextcolor]
479 if {[incr nextcolor] >= $ncolors} {
480 set nextcolor 0
481 }
482 if {[lsearch -exact $badcolors $c]} break
483 }
484 set colormap($id) $c
485 }
486}
487proc drawgraph {} {
489 global parents children nparents nchildren commits
490 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
491 global datemode cdate
492 global lineid linehtag linentag linedtag commitinfo
493 global nextcolor colormap numcommits
494 global stopped phase redisplaying selectedline
495 allcanvs delete all
497 set start {}
498 foreach id [array names nchildren] {
499 if {$nchildren($id) == 0} {
500 lappend start $id
501 }
502 set ncleft($id) $nchildren($id)
503 if {![info exists nparents($id)]} {
504 set nparents($id) 0
505 }
506 }
507 if {$start == {}} {
508 error_popup "Gitk: ERROR: No starting commits found"
509 exit 1
510 }
511 set nextcolor 0
513 foreach id $start {
514 assigncolor $id
515 }
516 set todo $start
517 set level [expr [llength $todo] - 1]
518 set y2 $canvy0
519 set nullentry -1
520 set lineno -1
521 set numcommits 0
522 set phase drawgraph
523 while 1 {
524 set canvy $y2
525 allcanvs conf -scrollregion [list 0 0 0 $canvy]
526 update
527 if {$stopped} break
528 incr numcommits
529 incr lineno
530 set nlines [llength $todo]
531 set id [lindex $todo $level]
532 set lineid($lineno) $id
533 set actualparents {}
534 if {[info exists parents($id)]} {
535 foreach p $parents($id) {
536 incr ncleft($p) -1
537 if {![info exists commitinfo($p)]} {
538 readcommit $p
539 if {![info exists commitinfo($p)]} continue
540 }
541 lappend actualparents $p
542 }
543 }
544 if {![info exists commitinfo($id)]} {
545 readcommit $id
546 if {![info exists commitinfo($id)]} {
547 set commitinfo($id) {"No commit information available"}
548 }
549 }
550 set x [expr $canvx0 + $level * $linespc]
551 set y2 [expr $canvy + $linespc]
552 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
553 set t [$canv create line $x $linestarty($level) $x $canvy \
554 -width 2 -fill $colormap($id)]
555 $canv lower $t
556 }
557 set linestarty($level) $canvy
558 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
559 [expr $x + 3] [expr $canvy + 3] \
560 -fill blue -outline black -width 1]
561 $canv raise $t
562 set xt [expr $canvx0 + $nlines * $linespc]
563 set headline [lindex $commitinfo($id) 0]
564 set name [lindex $commitinfo($id) 1]
565 set date [lindex $commitinfo($id) 2]
566 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
567 -text $headline -font $mainfont ]
568 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
569 -text $name -font $namefont]
570 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
571 -text $date -font $mainfont]
572 if {!$datemode && [llength $actualparents] == 1} {
573 set p [lindex $actualparents 0]
574 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
575 assigncolor $p
576 set todo [lreplace $todo $level $level $p]
577 continue
578 }
579 }
580 set oldtodo $todo
582 set oldlevel $level
583 set lines {}
584 for {set i 0} {$i < $nlines} {incr i} {
585 if {[lindex $todo $i] == {}} continue
586 if {[info exists linestarty($i)]} {
587 set oldstarty($i) $linestarty($i)
588 unset linestarty($i)
589 }
590 if {$i != $level} {
591 lappend lines [list $i [lindex $todo $i]]
592 }
593 }
594 if {$nullentry >= 0} {
595 set todo [lreplace $todo $nullentry $nullentry]
596 if {$nullentry < $level} {
597 incr level -1
598 }
599 }
600 set todo [lreplace $todo $level $level]
602 if {$nullentry > $level} {
603 incr nullentry -1
604 }
605 set i $level
606 foreach p $actualparents {
607 set k [lsearch -exact $todo $p]
608 if {$k < 0} {
609 assigncolor $p
610 set todo [linsert $todo $i $p]
611 if {$nullentry >= $i} {
612 incr nullentry
613 }
614 }
615 lappend lines [list $oldlevel $p]
616 }
617 # choose which one to do next time around
619 set todol [llength $todo]
620 set level -1
621 set latest {}
622 for {set k $todol} {[incr k -1] >= 0} {} {
623 set p [lindex $todo $k]
624 if {$p == {}} continue
625 if {$ncleft($p) == 0} {
626 if {$datemode} {
627 if {$latest == {} || $cdate($p) > $latest} {
628 set level $k
629 set latest $cdate($p)
630 }
631 } else {
632 set level $k
633 break
634 }
635 }
636 }
637 if {$level < 0} {
638 if {$todo != {}} {
639 puts "ERROR: none of the pending commits can be done yet:"
640 foreach p $todo {
641 puts " $p"
642 }
643 }
644 break
645 }
646 # If we are reducing, put in a null entry
648 if {$todol < $nlines} {
649 if {$nullentry >= 0} {
650 set i $nullentry
651 while {$i < $todol
652 && [lindex $oldtodo $i] == [lindex $todo $i]} {
653 incr i
654 }
655 } else {
656 set i $oldlevel
657 if {$level >= $i} {
658 incr i
659 }
660 }
661 if {$i >= $todol} {
662 set nullentry -1
663 } else {
664 set nullentry $i
665 set todo [linsert $todo $nullentry {}]
666 if {$level >= $i} {
667 incr level
668 }
669 }
670 } else {
671 set nullentry -1
672 }
673 foreach l $lines {
675 set i [lindex $l 0]
676 set dst [lindex $l 1]
677 set j [lsearch -exact $todo $dst]
678 if {$i == $j} {
679 if {[info exists oldstarty($i)]} {
680 set linestarty($i) $oldstarty($i)
681 }
682 continue
683 }
684 set xi [expr {$canvx0 + $i * $linespc}]
685 set xj [expr {$canvx0 + $j * $linespc}]
686 set coords {}
687 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
688 lappend coords $xi $oldstarty($i)
689 }
690 lappend coords $xi $canvy
691 if {$j < $i - 1} {
692 lappend coords [expr $xj + $linespc] $canvy
693 } elseif {$j > $i + 1} {
694 lappend coords [expr $xj - $linespc] $canvy
695 }
696 lappend coords $xj $y2
697 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
698 $canv lower $t
699 if {![info exists linestarty($j)]} {
700 set linestarty($j) $y2
701 }
702 }
703 }
704 set phase {}
705 if {$redisplaying} {
706 if {$stopped == 0 && [info exists selectedline]} {
707 selectline $selectedline
708 }
709 if {$stopped == 1} {
710 set stopped 0
711 after idle drawgraph
712 } else {
713 set redisplaying 0
714 }
715 }
716}
717proc findmatches {f} {
719 global findtype foundstring foundstrlen
720 if {$findtype == "Regexp"} {
721 set matches [regexp -indices -all -inline $foundstring $f]
722 } else {
723 if {$findtype == "IgnCase"} {
724 set str [string tolower $f]
725 } else {
726 set str $f
727 }
728 set matches {}
729 set i 0
730 while {[set j [string first $foundstring $str $i]] >= 0} {
731 lappend matches [list $j [expr $j+$foundstrlen-1]]
732 set i [expr $j + $foundstrlen]
733 }
734 }
735 return $matches
736}
737proc dofind {} {
739 global findtype findloc findstring markedmatches commitinfo
740 global numcommits lineid linehtag linentag linedtag
741 global mainfont namefont canv canv2 canv3 selectedline
742 global matchinglines foundstring foundstrlen
743 unmarkmatches
744 focus .
745 set matchinglines {}
746 set fldtypes {Headline Author Date Committer CDate Comment}
747 if {$findtype == "IgnCase"} {
748 set foundstring [string tolower $findstring]
749 } else {
750 set foundstring $findstring
751 }
752 set foundstrlen [string length $findstring]
753 if {$foundstrlen == 0} return
754 if {![info exists selectedline]} {
755 set oldsel -1
756 } else {
757 set oldsel $selectedline
758 }
759 set didsel 0
760 for {set l 0} {$l < $numcommits} {incr l} {
761 set id $lineid($l)
762 set info $commitinfo($id)
763 set doesmatch 0
764 foreach f $info ty $fldtypes {
765 if {$findloc != "All fields" && $findloc != $ty} {
766 continue
767 }
768 set matches [findmatches $f]
769 if {$matches == {}} continue
770 set doesmatch 1
771 if {$ty == "Headline"} {
772 markmatches $canv $l $f $linehtag($l) $matches $mainfont
773 } elseif {$ty == "Author"} {
774 markmatches $canv2 $l $f $linentag($l) $matches $namefont
775 } elseif {$ty == "Date"} {
776 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
777 }
778 }
779 if {$doesmatch} {
780 lappend matchinglines $l
781 if {!$didsel && $l > $oldsel} {
782 findselectline $l
783 set didsel 1
784 }
785 }
786 }
787 if {$matchinglines == {}} {
788 bell
789 } elseif {!$didsel} {
790 findselectline [lindex $matchinglines 0]
791 }
792}
793proc findselectline {l} {
795 global findloc commentend ctext
796 selectline $l
797 if {$findloc == "All fields" || $findloc == "Comments"} {
798 # highlight the matches in the comments
799 set f [$ctext get 1.0 $commentend]
800 set matches [findmatches $f]
801 foreach match $matches {
802 set start [lindex $match 0]
803 set end [expr [lindex $match 1] + 1]
804 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
805 }
806 }
807}
808proc findnext {} {
810 global matchinglines selectedline
811 if {![info exists matchinglines]} {
812 dofind
813 return
814 }
815 if {![info exists selectedline]} return
816 foreach l $matchinglines {
817 if {$l > $selectedline} {
818 findselectline $l
819 return
820 }
821 }
822 bell
823}
824proc findprev {} {
826 global matchinglines selectedline
827 if {![info exists matchinglines]} {
828 dofind
829 return
830 }
831 if {![info exists selectedline]} return
832 set prev {}
833 foreach l $matchinglines {
834 if {$l >= $selectedline} break
835 set prev $l
836 }
837 if {$prev != {}} {
838 findselectline $prev
839 } else {
840 bell
841 }
842}
843proc markmatches {canv l str tag matches font} {
845 set bbox [$canv bbox $tag]
846 set x0 [lindex $bbox 0]
847 set y0 [lindex $bbox 1]
848 set y1 [lindex $bbox 3]
849 foreach match $matches {
850 set start [lindex $match 0]
851 set end [lindex $match 1]
852 if {$start > $end} continue
853 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
854 set xlen [font measure $font [string range $str 0 [expr $end]]]
855 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
856 -outline {} -tags matches -fill yellow]
857 $canv lower $t
858 }
859}
860proc unmarkmatches {} {
862 global matchinglines
863 allcanvs delete matches
864 catch {unset matchinglines}
865}
866proc selcanvline {x y} {
868 global canv canvy0 ctext linespc selectedline
869 global lineid linehtag linentag linedtag
870 set ymax [lindex [$canv cget -scrollregion] 3]
871 set yfrac [lindex [$canv yview] 0]
872 set y [expr {$y + $yfrac * $ymax}]
873 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
874 if {$l < 0} {
875 set l 0
876 }
877 if {[info exists selectedline] && $selectedline == $l} return
878 unmarkmatches
879 selectline $l
880}
881proc selectline {l} {
883 global canv canv2 canv3 ctext commitinfo selectedline
884 global lineid linehtag linentag linedtag
885 global canvy canvy0 linespc nparents treepending
886 global cflist treediffs currentid sha1entry
887 global commentend
888 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
889 $canv delete secsel
890 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
891 -tags secsel -fill [$canv cget -selectbackground]]
892 $canv lower $t
893 $canv2 delete secsel
894 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
895 -tags secsel -fill [$canv2 cget -selectbackground]]
896 $canv2 lower $t
897 $canv3 delete secsel
898 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
899 -tags secsel -fill [$canv3 cget -selectbackground]]
900 $canv3 lower $t
901 set y [expr {$canvy0 + $l * $linespc}]
902 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
903 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
904 set wnow [$canv yview]
905 if {$ytop < [lindex $wnow 0]} {
906 allcanvs yview moveto $ytop
907 } elseif {$ybot > [lindex $wnow 1]} {
908 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
909 allcanvs yview moveto [expr {$ybot - $wh}]
910 }
911 set selectedline $l
912 set id $lineid($l)
914 $sha1entry conf -state normal
915 $sha1entry delete 0 end
916 $sha1entry insert 0 $id
917 $sha1entry selection from 0
918 $sha1entry selection to end
919 $sha1entry conf -state readonly
920 $ctext conf -state normal
922 $ctext delete 0.0 end
923 set info $commitinfo($id)
924 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
925 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
926 $ctext insert end "\n"
927 $ctext insert end [lindex $info 5]
928 $ctext insert end "\n"
929 $ctext tag delete Comments
930 $ctext tag remove found 1.0 end
931 $ctext conf -state disabled
932 set commentend [$ctext index "end - 1c"]
933 $cflist delete 0 end
935 set currentid $id
936 if {$nparents($id) == 1} {
937 if {![info exists treediffs($id)]} {
938 if {![info exists treepending]} {
939 gettreediffs $id
940 }
941 } else {
942 addtocflist $id
943 }
944 }
945}
946proc selnextline {dir} {
948 global selectedline
949 if {![info exists selectedline]} return
950 set l [expr $selectedline + $dir]
951 unmarkmatches
952 selectline $l
953}
954proc addtocflist {id} {
956 global currentid treediffs cflist treepending
957 if {$id != $currentid} {
958 gettreediffs $currentid
959 return
960 }
961 $cflist insert end "All files"
962 foreach f $treediffs($currentid) {
963 $cflist insert end $f
964 }
965 getblobdiffs $id
966}
967proc gettreediffs {id} {
969 global treediffs parents treepending
970 set treepending $id
971 set treediffs($id) {}
972 set p [lindex $parents($id) 0]
973 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
974 fconfigure $gdtf -blocking 0
975 fileevent $gdtf readable "gettreediffline $gdtf $id"
976}
977proc gettreediffline {gdtf id} {
979 global treediffs treepending
980 set n [gets $gdtf line]
981 if {$n < 0} {
982 if {![eof $gdtf]} return
983 close $gdtf
984 unset treepending
985 addtocflist $id
986 return
987 }
988 set type [lindex $line 1]
989 set file [lindex $line 3]
990 if {$type == "blob"} {
991 lappend treediffs($id) $file
992 }
993}
994proc getblobdiffs {id} {
996 global parents diffopts blobdifffd env curdifftag curtagstart
997 set p [lindex $parents($id) 0]
998 set env(GIT_DIFF_OPTS) $diffopts
999 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1000 puts "error getting diffs: $err"
1001 return
1002 }
1003 fconfigure $bdf -blocking 0
1004 set blobdifffd($id) $bdf
1005 set curdifftag Comments
1006 set curtagstart 0.0
1007 fileevent $bdf readable "getblobdiffline $bdf $id"
1008}
1009proc getblobdiffline {bdf id} {
1011 global currentid blobdifffd ctext curdifftag curtagstart
1012 set n [gets $bdf line]
1013 if {$n < 0} {
1014 if {[eof $bdf]} {
1015 close $bdf
1016 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1017 $ctext tag add $curdifftag $curtagstart end
1018 }
1019 }
1020 return
1021 }
1022 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1023 return
1024 }
1025 $ctext conf -state normal
1026 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
1027 # start of a new file
1028 $ctext insert end "\n"
1029 $ctext tag add $curdifftag $curtagstart end
1030 set curtagstart [$ctext index "end - 1c"]
1031 set curdifftag "f:$fname"
1032 $ctext tag delete $curdifftag
1033 set l [expr {(78 - [string length $fname]) / 2}]
1034 set pad [string range "----------------------------------------" 1 $l]
1035 $ctext insert end "$pad $fname $pad\n" filesep
1036 } elseif {[string range $line 0 2] == "+++"} {
1037 # no need to do anything with this
1038 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1039 $line match f1l f1c f2l f2c rest]} {
1040 $ctext insert end "\t" hunksep
1041 $ctext insert end " $f1l " d0 " $f2l " d1
1042 $ctext insert end " $rest \n" hunksep
1043 } else {
1044 set x [string range $line 0 0]
1045 if {$x == "-" || $x == "+"} {
1046 set tag [expr {$x == "+"}]
1047 set line [string range $line 1 end]
1048 $ctext insert end "$line\n" d$tag
1049 } elseif {$x == " "} {
1050 set line [string range $line 1 end]
1051 $ctext insert end "$line\n"
1052 } else {
1053 # Something else we don't recognize
1054 if {$curdifftag != "Comments"} {
1055 $ctext insert end "\n"
1056 $ctext tag add $curdifftag $curtagstart end
1057 set curtagstart [$ctext index "end - 1c"]
1058 set curdifftag Comments
1059 }
1060 $ctext insert end "$line\n" filesep
1061 }
1062 }
1063 $ctext conf -state disabled
1064}
1065proc listboxsel {} {
1067 global ctext cflist currentid treediffs
1068 if {![info exists currentid]} return
1069 set sel [$cflist curselection]
1070 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1071 # show everything
1072 $ctext tag conf Comments -elide 0
1073 foreach f $treediffs($currentid) {
1074 $ctext tag conf "f:$f" -elide 0
1075 }
1076 } else {
1077 # just show selected files
1078 $ctext tag conf Comments -elide 1
1079 set i 1
1080 foreach f $treediffs($currentid) {
1081 set elide [expr {[lsearch -exact $sel $i] < 0}]
1082 $ctext tag conf "f:$f" -elide $elide
1083 incr i
1084 }
1085 }
1086}
1087proc setcoords {} {
1089 global linespc charspc canvx0 canvy0 mainfont
1090 set linespc [font metrics $mainfont -linespace]
1091 set charspc [font measure $mainfont "m"]
1092 set canvy0 [expr 3 + 0.5 * $linespc]
1093 set canvx0 [expr 3 + 0.5 * $linespc]
1094}
1095proc redisplay {} {
1097 global selectedline stopped redisplaying phase
1098 if {$stopped > 1} return
1099 if {$phase == "getcommits"} return
1100 set redisplaying 1
1101 if {$phase == "drawgraph"} {
1102 set stopped 1
1103 } else {
1104 drawgraph
1105 }
1106}
1107proc incrfont {inc} {
1109 global mainfont namefont textfont selectedline ctext canv phase
1110 global stopped
1111 unmarkmatches
1112 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1113 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1114 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1115 setcoords
1116 $ctext conf -font $textfont
1117 $ctext tag conf filesep -font [concat $textfont bold]
1118 if {$phase == "getcommits"} {
1119 $canv itemconf textitems -font $mainfont
1120 }
1121 redisplay
1122}
1123proc doquit {} {
1125 global stopped
1126 set stopped 100
1127 destroy .
1128}
1129# defaults...
1131set datemode 0
1132set boldnames 0
1133set diffopts "-U 5 -p"
1134set mainfont {Helvetica 9}
1136set namefont $mainfont
1137set textfont {Courier 9}
1138if {$boldnames} {
1139 lappend namefont bold
1140}
1141set colors {green red blue magenta darkgrey brown orange}
1143set colorbycommitter false
1144catch {source ~/.gitk}
1146set revtreeargs {}
1148foreach arg $argv {
1149 switch -regexp -- $arg {
1150 "^$" { }
1151 "^-b" { set boldnames 1 }
1152 "^-c" { set colorbycommitter 1 }
1153 "^-d" { set datemode 1 }
1154 "^-.*" {
1155 puts stderr "unrecognized option $arg"
1156 exit 1
1157 }
1158 default {
1159 lappend revtreeargs $arg
1160 }
1161 }
1162}
1163set stopped 0
1165set redisplaying 0
1166set stuffsaved 0
1167setcoords
1168makewindow
1169getcommits $revtreeargs