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.17 $
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 bindkey f nextfile
261 bind . <Control-q> doquit
262 bind . <Control-f> dofind
263 bind . <Control-g> findnext
264 bind . <Control-r> findprev
265 bind . <Control-equal> {incrfont 1}
266 bind . <Control-KP_Add> {incrfont 1}
267 bind . <Control-minus> {incrfont -1}
268 bind . <Control-KP_Subtract> {incrfont -1}
269 bind $cflist <<ListboxSelect>> listboxsel
270 bind . <Destroy> {savestuff %W}
271 bind . <Button-1> "click %W"
272 bind $fstring <Key-Return> dofind
273}
274# when we make a key binding for the toplevel, make sure
276# it doesn't get triggered when that key is pressed in the
277# find string entry widget.
278proc bindkey {ev script} {
279 global fstring
280 bind . $ev $script
281 set escript [bind Entry $ev]
282 if {$escript == {}} {
283 set escript [bind Entry <Key>]
284 }
285 bind $fstring $ev "$escript; break"
286}
287# set the focus back to the toplevel for any click outside
289# the find string entry widget
290proc click {w} {
291 global fstring
292 if {$w != $fstring} {
293 focus .
294 }
295}
296proc savestuff {w} {
298 global canv canv2 canv3 ctext cflist mainfont textfont
299 global stuffsaved
300 if {$stuffsaved} return
301 if {![winfo viewable .]} return
302 catch {
303 set f [open "~/.gitk-new" w]
304 puts $f "set mainfont {$mainfont}"
305 puts $f "set textfont {$textfont}"
306 puts $f "set geometry(width) [winfo width .ctop]"
307 puts $f "set geometry(height) [winfo height .ctop]"
308 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
309 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
310 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
311 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
312 set wid [expr {([winfo width $ctext] - 8) \
313 / [font measure $textfont "0"]}]
314 puts $f "set geometry(ctextw) $wid"
315 set wid [expr {([winfo width $cflist] - 11) \
316 / [font measure [$cflist cget -font] "0"]}]
317 puts $f "set geometry(cflistw) $wid"
318 close $f
319 file rename -force "~/.gitk-new" "~/.gitk"
320 }
321 set stuffsaved 1
322}
323proc resizeclistpanes {win w} {
325 global oldwidth
326 if [info exists oldwidth($win)] {
327 set s0 [$win sash coord 0]
328 set s1 [$win sash coord 1]
329 if {$w < 60} {
330 set sash0 [expr {int($w/2 - 2)}]
331 set sash1 [expr {int($w*5/6 - 2)}]
332 } else {
333 set factor [expr {1.0 * $w / $oldwidth($win)}]
334 set sash0 [expr {int($factor * [lindex $s0 0])}]
335 set sash1 [expr {int($factor * [lindex $s1 0])}]
336 if {$sash0 < 30} {
337 set sash0 30
338 }
339 if {$sash1 < $sash0 + 20} {
340 set sash1 [expr $sash0 + 20]
341 }
342 if {$sash1 > $w - 10} {
343 set sash1 [expr $w - 10]
344 if {$sash0 > $sash1 - 20} {
345 set sash0 [expr $sash1 - 20]
346 }
347 }
348 }
349 $win sash place 0 $sash0 [lindex $s0 1]
350 $win sash place 1 $sash1 [lindex $s1 1]
351 }
352 set oldwidth($win) $w
353}
354proc resizecdetpanes {win w} {
356 global oldwidth
357 if [info exists oldwidth($win)] {
358 set s0 [$win sash coord 0]
359 if {$w < 60} {
360 set sash0 [expr {int($w*3/4 - 2)}]
361 } else {
362 set factor [expr {1.0 * $w / $oldwidth($win)}]
363 set sash0 [expr {int($factor * [lindex $s0 0])}]
364 if {$sash0 < 45} {
365 set sash0 45
366 }
367 if {$sash0 > $w - 15} {
368 set sash0 [expr $w - 15]
369 }
370 }
371 $win sash place 0 $sash0 [lindex $s0 1]
372 }
373 set oldwidth($win) $w
374}
375proc allcanvs args {
377 global canv canv2 canv3
378 eval $canv $args
379 eval $canv2 $args
380 eval $canv3 $args
381}
382proc bindall {event action} {
384 global canv canv2 canv3
385 bind $canv $event $action
386 bind $canv2 $event $action
387 bind $canv3 $event $action
388}
389proc about {} {
391 set w .about
392 if {[winfo exists $w]} {
393 raise $w
394 return
395 }
396 toplevel $w
397 wm title $w "About gitk"
398 message $w.m -text {
399Gitk version 1.0
400Copyright © 2005 Paul Mackerras
402Use and redistribute under the terms of the GNU General Public License
404(CVS $Revision: 1.17 $)} \
406 -justify center -aspect 400
407 pack $w.m -side top -fill x -padx 20 -pady 20
408 button $w.ok -text Close -command "destroy $w"
409 pack $w.ok -side bottom
410}
411proc truncatetofit {str width font} {
413 if {[font measure $font $str] <= $width} {
414 return $str
415 }
416 set best 0
417 set bad [string length $str]
418 set tmp $str
419 while {$best < $bad - 1} {
420 set try [expr {int(($best + $bad) / 2)}]
421 set tmp "[string range $str 0 [expr $try-1]]..."
422 if {[font measure $font $tmp] <= $width} {
423 set best $try
424 } else {
425 set bad $try
426 }
427 }
428 return $tmp
429}
430proc assigncolor {id} {
432 global commitinfo colormap commcolors colors nextcolor
433 global colorbycommitter
434 global parents nparents children nchildren
435 if [info exists colormap($id)] return
436 set ncolors [llength $colors]
437 if {$colorbycommitter} {
438 if {![info exists commitinfo($id)]} {
439 readcommit $id
440 }
441 set comm [lindex $commitinfo($id) 3]
442 if {![info exists commcolors($comm)]} {
443 set commcolors($comm) [lindex $colors $nextcolor]
444 if {[incr nextcolor] >= $ncolors} {
445 set nextcolor 0
446 }
447 }
448 set colormap($id) $commcolors($comm)
449 } else {
450 if {$nparents($id) == 1 && $nchildren($id) == 1} {
451 set child [lindex $children($id) 0]
452 if {[info exists colormap($child)]
453 && $nparents($child) == 1} {
454 set colormap($id) $colormap($child)
455 return
456 }
457 }
458 set badcolors {}
459 foreach child $children($id) {
460 if {[info exists colormap($child)]
461 && [lsearch -exact $badcolors $colormap($child)] < 0} {
462 lappend badcolors $colormap($child)
463 }
464 if {[info exists parents($child)]} {
465 foreach p $parents($child) {
466 if {[info exists colormap($p)]
467 && [lsearch -exact $badcolors $colormap($p)] < 0} {
468 lappend badcolors $colormap($p)
469 }
470 }
471 }
472 }
473 if {[llength $badcolors] >= $ncolors} {
474 set badcolors {}
475 }
476 for {set i 0} {$i <= $ncolors} {incr i} {
477 set c [lindex $colors $nextcolor]
478 if {[incr nextcolor] >= $ncolors} {
479 set nextcolor 0
480 }
481 if {[lsearch -exact $badcolors $c]} break
482 }
483 set colormap($id) $c
484 }
485}
486proc drawgraph {} {
488 global parents children nparents nchildren commits
489 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
490 global datemode cdate
491 global lineid linehtag linentag linedtag commitinfo
492 global nextcolor colormap numcommits
493 global stopped phase redisplaying selectedline
494 allcanvs delete all
496 set start {}
497 foreach id [array names nchildren] {
498 if {$nchildren($id) == 0} {
499 lappend start $id
500 }
501 set ncleft($id) $nchildren($id)
502 if {![info exists nparents($id)]} {
503 set nparents($id) 0
504 }
505 }
506 if {$start == {}} {
507 error_popup "Gitk: ERROR: No starting commits found"
508 exit 1
509 }
510 set nextcolor 0
512 foreach id $start {
513 assigncolor $id
514 }
515 set todo $start
516 set level [expr [llength $todo] - 1]
517 set y2 $canvy0
518 set nullentry -1
519 set lineno -1
520 set numcommits 0
521 set phase drawgraph
522 set lthickness [expr {($linespc / 9) + 1}]
523 while 1 {
524 set canvy $y2
525 allcanvs conf -scrollregion \
526 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
527 update
528 if {$stopped} break
529 incr numcommits
530 incr lineno
531 set nlines [llength $todo]
532 set id [lindex $todo $level]
533 set lineid($lineno) $id
534 set actualparents {}
535 if {[info exists parents($id)]} {
536 foreach p $parents($id) {
537 incr ncleft($p) -1
538 if {![info exists commitinfo($p)]} {
539 readcommit $p
540 if {![info exists commitinfo($p)]} continue
541 }
542 lappend actualparents $p
543 }
544 }
545 if {![info exists commitinfo($id)]} {
546 readcommit $id
547 if {![info exists commitinfo($id)]} {
548 set commitinfo($id) {"No commit information available"}
549 }
550 }
551 set x [expr $canvx0 + $level * $linespc]
552 set y2 [expr $canvy + $linespc]
553 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
554 set t [$canv create line $x $linestarty($level) $x $canvy \
555 -width $lthickness -fill $colormap($id)]
556 $canv lower $t
557 }
558 set linestarty($level) $canvy
559 set ofill [expr {[info exists parents($id)]? "blue": "white"}]
560 set orad [expr {$linespc / 3}]
561 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
562 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
563 -fill $ofill -outline black -width 1]
564 $canv raise $t
565 set xt [expr $canvx0 + $nlines * $linespc]
566 set headline [lindex $commitinfo($id) 0]
567 set name [lindex $commitinfo($id) 1]
568 set date [lindex $commitinfo($id) 2]
569 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
570 -text $headline -font $mainfont ]
571 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
572 -text $name -font $namefont]
573 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
574 -text $date -font $mainfont]
575 if {!$datemode && [llength $actualparents] == 1} {
576 set p [lindex $actualparents 0]
577 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
578 assigncolor $p
579 set todo [lreplace $todo $level $level $p]
580 continue
581 }
582 }
583 set oldtodo $todo
585 set oldlevel $level
586 set lines {}
587 for {set i 0} {$i < $nlines} {incr i} {
588 if {[lindex $todo $i] == {}} continue
589 if {[info exists linestarty($i)]} {
590 set oldstarty($i) $linestarty($i)
591 unset linestarty($i)
592 }
593 if {$i != $level} {
594 lappend lines [list $i [lindex $todo $i]]
595 }
596 }
597 if {$nullentry >= 0} {
598 set todo [lreplace $todo $nullentry $nullentry]
599 if {$nullentry < $level} {
600 incr level -1
601 }
602 }
603 set todo [lreplace $todo $level $level]
605 if {$nullentry > $level} {
606 incr nullentry -1
607 }
608 set i $level
609 foreach p $actualparents {
610 set k [lsearch -exact $todo $p]
611 if {$k < 0} {
612 assigncolor $p
613 set todo [linsert $todo $i $p]
614 if {$nullentry >= $i} {
615 incr nullentry
616 }
617 }
618 lappend lines [list $oldlevel $p]
619 }
620 # choose which one to do next time around
622 set todol [llength $todo]
623 set level -1
624 set latest {}
625 for {set k $todol} {[incr k -1] >= 0} {} {
626 set p [lindex $todo $k]
627 if {$p == {}} continue
628 if {$ncleft($p) == 0} {
629 if {$datemode} {
630 if {$latest == {} || $cdate($p) > $latest} {
631 set level $k
632 set latest $cdate($p)
633 }
634 } else {
635 set level $k
636 break
637 }
638 }
639 }
640 if {$level < 0} {
641 if {$todo != {}} {
642 puts "ERROR: none of the pending commits can be done yet:"
643 foreach p $todo {
644 puts " $p"
645 }
646 }
647 break
648 }
649 # If we are reducing, put in a null entry
651 if {$todol < $nlines} {
652 if {$nullentry >= 0} {
653 set i $nullentry
654 while {$i < $todol
655 && [lindex $oldtodo $i] == [lindex $todo $i]} {
656 incr i
657 }
658 } else {
659 set i $oldlevel
660 if {$level >= $i} {
661 incr i
662 }
663 }
664 if {$i >= $todol} {
665 set nullentry -1
666 } else {
667 set nullentry $i
668 set todo [linsert $todo $nullentry {}]
669 if {$level >= $i} {
670 incr level
671 }
672 }
673 } else {
674 set nullentry -1
675 }
676 foreach l $lines {
678 set i [lindex $l 0]
679 set dst [lindex $l 1]
680 set j [lsearch -exact $todo $dst]
681 if {$i == $j} {
682 if {[info exists oldstarty($i)]} {
683 set linestarty($i) $oldstarty($i)
684 }
685 continue
686 }
687 set xi [expr {$canvx0 + $i * $linespc}]
688 set xj [expr {$canvx0 + $j * $linespc}]
689 set coords {}
690 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
691 lappend coords $xi $oldstarty($i)
692 }
693 lappend coords $xi $canvy
694 if {$j < $i - 1} {
695 lappend coords [expr $xj + $linespc] $canvy
696 } elseif {$j > $i + 1} {
697 lappend coords [expr $xj - $linespc] $canvy
698 }
699 lappend coords $xj $y2
700 set t [$canv create line $coords -width $lthickness \
701 -fill $colormap($dst)]
702 $canv lower $t
703 if {![info exists linestarty($j)]} {
704 set linestarty($j) $y2
705 }
706 }
707 }
708 set phase {}
709 if {$redisplaying} {
710 if {$stopped == 0 && [info exists selectedline]} {
711 selectline $selectedline
712 }
713 if {$stopped == 1} {
714 set stopped 0
715 after idle drawgraph
716 } else {
717 set redisplaying 0
718 }
719 }
720}
721proc findmatches {f} {
723 global findtype foundstring foundstrlen
724 if {$findtype == "Regexp"} {
725 set matches [regexp -indices -all -inline $foundstring $f]
726 } else {
727 if {$findtype == "IgnCase"} {
728 set str [string tolower $f]
729 } else {
730 set str $f
731 }
732 set matches {}
733 set i 0
734 while {[set j [string first $foundstring $str $i]] >= 0} {
735 lappend matches [list $j [expr $j+$foundstrlen-1]]
736 set i [expr $j + $foundstrlen]
737 }
738 }
739 return $matches
740}
741proc dofind {} {
743 global findtype findloc findstring markedmatches commitinfo
744 global numcommits lineid linehtag linentag linedtag
745 global mainfont namefont canv canv2 canv3 selectedline
746 global matchinglines foundstring foundstrlen
747 unmarkmatches
748 focus .
749 set matchinglines {}
750 set fldtypes {Headline Author Date Committer CDate Comment}
751 if {$findtype == "IgnCase"} {
752 set foundstring [string tolower $findstring]
753 } else {
754 set foundstring $findstring
755 }
756 set foundstrlen [string length $findstring]
757 if {$foundstrlen == 0} return
758 if {![info exists selectedline]} {
759 set oldsel -1
760 } else {
761 set oldsel $selectedline
762 }
763 set didsel 0
764 for {set l 0} {$l < $numcommits} {incr l} {
765 set id $lineid($l)
766 set info $commitinfo($id)
767 set doesmatch 0
768 foreach f $info ty $fldtypes {
769 if {$findloc != "All fields" && $findloc != $ty} {
770 continue
771 }
772 set matches [findmatches $f]
773 if {$matches == {}} continue
774 set doesmatch 1
775 if {$ty == "Headline"} {
776 markmatches $canv $l $f $linehtag($l) $matches $mainfont
777 } elseif {$ty == "Author"} {
778 markmatches $canv2 $l $f $linentag($l) $matches $namefont
779 } elseif {$ty == "Date"} {
780 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
781 }
782 }
783 if {$doesmatch} {
784 lappend matchinglines $l
785 if {!$didsel && $l > $oldsel} {
786 findselectline $l
787 set didsel 1
788 }
789 }
790 }
791 if {$matchinglines == {}} {
792 bell
793 } elseif {!$didsel} {
794 findselectline [lindex $matchinglines 0]
795 }
796}
797proc findselectline {l} {
799 global findloc commentend ctext
800 selectline $l
801 if {$findloc == "All fields" || $findloc == "Comments"} {
802 # highlight the matches in the comments
803 set f [$ctext get 1.0 $commentend]
804 set matches [findmatches $f]
805 foreach match $matches {
806 set start [lindex $match 0]
807 set end [expr [lindex $match 1] + 1]
808 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
809 }
810 }
811}
812proc findnext {} {
814 global matchinglines selectedline
815 if {![info exists matchinglines]} {
816 dofind
817 return
818 }
819 if {![info exists selectedline]} return
820 foreach l $matchinglines {
821 if {$l > $selectedline} {
822 findselectline $l
823 return
824 }
825 }
826 bell
827}
828proc findprev {} {
830 global matchinglines selectedline
831 if {![info exists matchinglines]} {
832 dofind
833 return
834 }
835 if {![info exists selectedline]} return
836 set prev {}
837 foreach l $matchinglines {
838 if {$l >= $selectedline} break
839 set prev $l
840 }
841 if {$prev != {}} {
842 findselectline $prev
843 } else {
844 bell
845 }
846}
847proc markmatches {canv l str tag matches font} {
849 set bbox [$canv bbox $tag]
850 set x0 [lindex $bbox 0]
851 set y0 [lindex $bbox 1]
852 set y1 [lindex $bbox 3]
853 foreach match $matches {
854 set start [lindex $match 0]
855 set end [lindex $match 1]
856 if {$start > $end} continue
857 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
858 set xlen [font measure $font [string range $str 0 [expr $end]]]
859 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
860 -outline {} -tags matches -fill yellow]
861 $canv lower $t
862 }
863}
864proc unmarkmatches {} {
866 global matchinglines
867 allcanvs delete matches
868 catch {unset matchinglines}
869}
870proc selcanvline {x y} {
872 global canv canvy0 ctext linespc selectedline
873 global lineid linehtag linentag linedtag
874 set ymax [lindex [$canv cget -scrollregion] 3]
875 set yfrac [lindex [$canv yview] 0]
876 set y [expr {$y + $yfrac * $ymax}]
877 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
878 if {$l < 0} {
879 set l 0
880 }
881 if {[info exists selectedline] && $selectedline == $l} return
882 unmarkmatches
883 selectline $l
884}
885proc selectline {l} {
887 global canv canv2 canv3 ctext commitinfo selectedline
888 global lineid linehtag linentag linedtag
889 global canvy0 linespc nparents treepending
890 global cflist treediffs currentid sha1entry
891 global commentend seenfile numcommits
892 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
893 $canv delete secsel
894 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
895 -tags secsel -fill [$canv cget -selectbackground]]
896 $canv lower $t
897 $canv2 delete secsel
898 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
899 -tags secsel -fill [$canv2 cget -selectbackground]]
900 $canv2 lower $t
901 $canv3 delete secsel
902 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
903 -tags secsel -fill [$canv3 cget -selectbackground]]
904 $canv3 lower $t
905 set y [expr {$canvy0 + $l * $linespc}]
906 set ymax [lindex [$canv cget -scrollregion] 3]
907 set ytop [expr {$y - $linespc - 1}]
908 set ybot [expr {$y + $linespc + 1}]
909 set wnow [$canv yview]
910 set wtop [expr [lindex $wnow 0] * $ymax]
911 set wbot [expr [lindex $wnow 1] * $ymax]
912 set wh [expr {$wbot - $wtop}]
913 set newtop $wtop
914 if {$ytop < $wtop} {
915 if {$ybot < $wtop} {
916 set newtop [expr {$y - $wh / 2.0}]
917 } else {
918 set newtop $ytop
919 if {$newtop > $wtop - $linespc} {
920 set newtop [expr {$wtop - $linespc}]
921 }
922 }
923 } elseif {$ybot > $wbot} {
924 if {$ytop > $wbot} {
925 set newtop [expr {$y - $wh / 2.0}]
926 } else {
927 set newtop [expr {$ybot - $wh}]
928 if {$newtop < $wtop + $linespc} {
929 set newtop [expr {$wtop + $linespc}]
930 }
931 }
932 }
933 if {$newtop != $wtop} {
934 if {$newtop < 0} {
935 set newtop 0
936 }
937 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
938 }
939 set selectedline $l
940 set id $lineid($l)
942 $sha1entry conf -state normal
943 $sha1entry delete 0 end
944 $sha1entry insert 0 $id
945 $sha1entry selection from 0
946 $sha1entry selection to end
947 $sha1entry conf -state readonly
948 $ctext conf -state normal
950 $ctext delete 0.0 end
951 set info $commitinfo($id)
952 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
953 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
954 $ctext insert end "\n"
955 $ctext insert end [lindex $info 5]
956 $ctext insert end "\n"
957 $ctext tag delete Comments
958 $ctext tag remove found 1.0 end
959 $ctext conf -state disabled
960 set commentend [$ctext index "end - 1c"]
961 $cflist delete 0 end
963 set currentid $id
964 if {$nparents($id) == 1} {
965 if {![info exists treediffs($id)]} {
966 if {![info exists treepending]} {
967 gettreediffs $id
968 }
969 } else {
970 addtocflist $id
971 }
972 }
973 catch {unset seenfile}
974}
975proc selnextline {dir} {
977 global selectedline
978 if {![info exists selectedline]} return
979 set l [expr $selectedline + $dir]
980 unmarkmatches
981 selectline $l
982}
983proc addtocflist {id} {
985 global currentid treediffs cflist treepending
986 if {$id != $currentid} {
987 gettreediffs $currentid
988 return
989 }
990 $cflist insert end "All files"
991 foreach f $treediffs($currentid) {
992 $cflist insert end $f
993 }
994 getblobdiffs $id
995}
996proc gettreediffs {id} {
998 global treediffs parents treepending
999 set treepending $id
1000 set treediffs($id) {}
1001 set p [lindex $parents($id) 0]
1002 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1003 fconfigure $gdtf -blocking 0
1004 fileevent $gdtf readable "gettreediffline $gdtf $id"
1005}
1006proc gettreediffline {gdtf id} {
1008 global treediffs treepending
1009 set n [gets $gdtf line]
1010 if {$n < 0} {
1011 if {![eof $gdtf]} return
1012 close $gdtf
1013 unset treepending
1014 addtocflist $id
1015 return
1016 }
1017 set type [lindex $line 1]
1018 set file [lindex $line 3]
1019 if {$type == "blob"} {
1020 lappend treediffs($id) $file
1021 }
1022}
1023proc getblobdiffs {id} {
1025 global parents diffopts blobdifffd env curdifftag curtagstart
1026 global diffindex difffilestart
1027 set p [lindex $parents($id) 0]
1028 set env(GIT_DIFF_OPTS) $diffopts
1029 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1030 puts "error getting diffs: $err"
1031 return
1032 }
1033 fconfigure $bdf -blocking 0
1034 set blobdifffd($id) $bdf
1035 set curdifftag Comments
1036 set curtagstart 0.0
1037 set diffindex 0
1038 catch {unset difffilestart}
1039 fileevent $bdf readable "getblobdiffline $bdf $id"
1040}
1041proc getblobdiffline {bdf id} {
1043 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1044 global diffnexthead diffnextnote diffindex difffilestart
1045 set n [gets $bdf line]
1046 if {$n < 0} {
1047 if {[eof $bdf]} {
1048 close $bdf
1049 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1050 $ctext tag add $curdifftag $curtagstart end
1051 set seenfile($curdifftag) 1
1052 }
1053 }
1054 return
1055 }
1056 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1057 return
1058 }
1059 $ctext conf -state normal
1060 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1061 # start of a new file
1062 $ctext insert end "\n"
1063 $ctext tag add $curdifftag $curtagstart end
1064 set seenfile($curdifftag) 1
1065 set curtagstart [$ctext index "end - 1c"]
1066 set header $fname
1067 if {[info exists diffnexthead]} {
1068 set fname $diffnexthead
1069 set header "$diffnexthead ($diffnextnote)"
1070 unset diffnexthead
1071 }
1072 set difffilestart($diffindex) [$ctext index "end - 1c"]
1073 incr diffindex
1074 set curdifftag "f:$fname"
1075 $ctext tag delete $curdifftag
1076 set l [expr {(78 - [string length $header]) / 2}]
1077 set pad [string range "----------------------------------------" 1 $l]
1078 $ctext insert end "$pad $header $pad\n" filesep
1079 } elseif {[string range $line 0 2] == "+++"} {
1080 # no need to do anything with this
1081 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1082 set diffnexthead $fn
1083 set diffnextnote "created, mode $m"
1084 } elseif {[string range $line 0 8] == "Deleted: "} {
1085 set diffnexthead [string range $line 9 end]
1086 set diffnextnote "deleted"
1087 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1088 # save the filename in case the next thing is "new file mode ..."
1089 set diffnexthead $fn
1090 set diffnextnote "modified"
1091 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1092 set diffnextnote "new file, mode $m"
1093 } elseif {[string range $line 0 11] == "deleted file"} {
1094 set diffnextnote "deleted"
1095 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1096 $line match f1l f1c f2l f2c rest]} {
1097 $ctext insert end "\t" hunksep
1098 $ctext insert end " $f1l " d0 " $f2l " d1
1099 $ctext insert end " $rest \n" hunksep
1100 } else {
1101 set x [string range $line 0 0]
1102 if {$x == "-" || $x == "+"} {
1103 set tag [expr {$x == "+"}]
1104 set line [string range $line 1 end]
1105 $ctext insert end "$line\n" d$tag
1106 } elseif {$x == " "} {
1107 set line [string range $line 1 end]
1108 $ctext insert end "$line\n"
1109 } elseif {$x == "\\"} {
1110 # e.g. "\ No newline at end of file"
1111 $ctext insert end "$line\n" filesep
1112 } else {
1113 # Something else we don't recognize
1114 if {$curdifftag != "Comments"} {
1115 $ctext insert end "\n"
1116 $ctext tag add $curdifftag $curtagstart end
1117 set seenfile($curdifftag) 1
1118 set curtagstart [$ctext index "end - 1c"]
1119 set curdifftag Comments
1120 }
1121 $ctext insert end "$line\n" filesep
1122 }
1123 }
1124 $ctext conf -state disabled
1125}
1126proc nextfile {} {
1128 global difffilestart ctext
1129 set here [$ctext index @0,0]
1130 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1131 if {[$ctext compare $difffilestart($i) > $here]} {
1132 $ctext yview $difffilestart($i)
1133 break
1134 }
1135 }
1136}
1137proc listboxsel {} {
1139 global ctext cflist currentid treediffs seenfile
1140 if {![info exists currentid]} return
1141 set sel [$cflist curselection]
1142 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1143 # show everything
1144 $ctext tag conf Comments -elide 0
1145 foreach f $treediffs($currentid) {
1146 if [info exists seenfile(f:$f)] {
1147 $ctext tag conf "f:$f" -elide 0
1148 }
1149 }
1150 } else {
1151 # just show selected files
1152 $ctext tag conf Comments -elide 1
1153 set i 1
1154 foreach f $treediffs($currentid) {
1155 set elide [expr {[lsearch -exact $sel $i] < 0}]
1156 if [info exists seenfile(f:$f)] {
1157 $ctext tag conf "f:$f" -elide $elide
1158 }
1159 incr i
1160 }
1161 }
1162}
1163proc setcoords {} {
1165 global linespc charspc canvx0 canvy0 mainfont
1166 set linespc [font metrics $mainfont -linespace]
1167 set charspc [font measure $mainfont "m"]
1168 set canvy0 [expr 3 + 0.5 * $linespc]
1169 set canvx0 [expr 3 + 0.5 * $linespc]
1170}
1171proc redisplay {} {
1173 global selectedline stopped redisplaying phase
1174 if {$stopped > 1} return
1175 if {$phase == "getcommits"} return
1176 set redisplaying 1
1177 if {$phase == "drawgraph"} {
1178 set stopped 1
1179 } else {
1180 drawgraph
1181 }
1182}
1183proc incrfont {inc} {
1185 global mainfont namefont textfont selectedline ctext canv phase
1186 global stopped
1187 unmarkmatches
1188 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1189 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1190 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1191 setcoords
1192 $ctext conf -font $textfont
1193 $ctext tag conf filesep -font [concat $textfont bold]
1194 if {$phase == "getcommits"} {
1195 $canv itemconf textitems -font $mainfont
1196 }
1197 redisplay
1198}
1199proc doquit {} {
1201 global stopped
1202 set stopped 100
1203 destroy .
1204}
1205# defaults...
1207set datemode 0
1208set boldnames 0
1209set diffopts "-U 5 -p"
1210set mainfont {Helvetica 9}
1212set textfont {Courier 9}
1213set colors {green red blue magenta darkgrey brown orange}
1215set colorbycommitter false
1216catch {source ~/.gitk}
1218set namefont $mainfont
1220if {$boldnames} {
1221 lappend namefont bold
1222}
1223set revtreeargs {}
1225foreach arg $argv {
1226 switch -regexp -- $arg {
1227 "^$" { }
1228 "^-b" { set boldnames 1 }
1229 "^-c" { set colorbycommitter 1 }
1230 "^-d" { set datemode 1 }
1231 "^-.*" {
1232 puts stderr "unrecognized option $arg"
1233 exit 1
1234 }
1235 default {
1236 lappend revtreeargs $arg
1237 }
1238 }
1239}
1240set stopped 0
1242set redisplaying 0
1243set stuffsaved 0
1244setcoords
1245makewindow
1246getcommits $revtreeargs