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