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.18 $
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 readrefs {} {
127 global tagids idtags
128 set tags [glob -nocomplain -types f .git/refs/tags/*]
129 foreach f $tags {
130 catch {
131 set fd [open $f r]
132 set line [read $fd]
133 if {[regexp {^[0-9a-f]{40}} $line id]} {
134 set contents [split [exec git-cat-file tag $id] "\n"]
135 set obj {}
136 set type {}
137 set tag {}
138 foreach l $contents {
139 if {$l == {}} break
140 switch -- [lindex $l 0] {
141 "object" {set obj [lindex $l 1]}
142 "type" {set type [lindex $l 1]}
143 "tag" {set tag [string range $l 4 end]}
144 }
145 }
146 if {$obj != {} && $type == "commit" && $tag != {}} {
147 set tagids($tag) $obj
148 lappend idtags($obj) $tag
149 }
150 }
151 }
152 }
153}
154proc error_popup msg {
156 set w .error
157 toplevel $w
158 wm transient $w .
159 message $w.m -text $msg -justify center -aspect 400
160 pack $w.m -side top -fill x -padx 20 -pady 20
161 button $w.ok -text OK -command "destroy $w"
162 pack $w.ok -side bottom -fill x
163 bind $w <Visibility> "grab $w; focus $w"
164 tkwait window $w
165}
166proc makewindow {} {
168 global canv canv2 canv3 linespc charspc ctext cflist textfont
169 global findtype findloc findstring fstring geometry
170 global entries sha1entry sha1string sha1but
171 menu .bar
173 .bar add cascade -label "File" -menu .bar.file
174 menu .bar.file
175 .bar.file add command -label "Quit" -command doquit
176 menu .bar.help
177 .bar add cascade -label "Help" -menu .bar.help
178 .bar.help add command -label "About gitk" -command about
179 . configure -menu .bar
180 if {![info exists geometry(canv1)]} {
182 set geometry(canv1) [expr 45 * $charspc]
183 set geometry(canv2) [expr 30 * $charspc]
184 set geometry(canv3) [expr 15 * $charspc]
185 set geometry(canvh) [expr 25 * $linespc + 4]
186 set geometry(ctextw) 80
187 set geometry(ctexth) 30
188 set geometry(cflistw) 30
189 }
190 panedwindow .ctop -orient vertical
191 if {[info exists geometry(width)]} {
192 .ctop conf -width $geometry(width) -height $geometry(height)
193 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
194 set geometry(ctexth) [expr {($texth - 8) /
195 [font metrics $textfont -linespace]}]
196 }
197 frame .ctop.top
198 frame .ctop.top.bar
199 pack .ctop.top.bar -side bottom -fill x
200 set cscroll .ctop.top.csb
201 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
202 pack $cscroll -side right -fill y
203 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
204 pack .ctop.top.clist -side top -fill both -expand 1
205 .ctop add .ctop.top
206 set canv .ctop.top.clist.canv
207 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
208 -bg white -bd 0 \
209 -yscrollincr $linespc -yscrollcommand "$cscroll set"
210 .ctop.top.clist add $canv
211 set canv2 .ctop.top.clist.canv2
212 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
213 -bg white -bd 0 -yscrollincr $linespc
214 .ctop.top.clist add $canv2
215 set canv3 .ctop.top.clist.canv3
216 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
217 -bg white -bd 0 -yscrollincr $linespc
218 .ctop.top.clist add $canv3
219 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
220 set sha1entry .ctop.top.bar.sha1
222 set entries $sha1entry
223 set sha1but .ctop.top.bar.sha1label
224 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
225 -command gotocommit -width 8
226 $sha1but conf -disabledforeground [$sha1but cget -foreground]
227 pack .ctop.top.bar.sha1label -side left
228 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
229 trace add variable sha1string write sha1change
230 pack $sha1entry -side left -pady 2
231 button .ctop.top.bar.findbut -text "Find" -command dofind
232 pack .ctop.top.bar.findbut -side left
233 set findstring {}
234 set fstring .ctop.top.bar.findstring
235 lappend entries $fstring
236 entry $fstring -width 30 -font $textfont -textvariable findstring
237 pack $fstring -side left -expand 1 -fill x
238 set findtype Exact
239 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
240 set findloc "All fields"
241 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
242 Comments Author Committer
243 pack .ctop.top.bar.findloc -side right
244 pack .ctop.top.bar.findtype -side right
245 panedwindow .ctop.cdet -orient horizontal
247 .ctop add .ctop.cdet
248 frame .ctop.cdet.left
249 set ctext .ctop.cdet.left.ctext
250 text $ctext -bg white -state disabled -font $textfont \
251 -width $geometry(ctextw) -height $geometry(ctexth) \
252 -yscrollcommand ".ctop.cdet.left.sb set"
253 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
254 pack .ctop.cdet.left.sb -side right -fill y
255 pack $ctext -side left -fill both -expand 1
256 .ctop.cdet add .ctop.cdet.left
257 $ctext tag conf filesep -font [concat $textfont bold]
259 $ctext tag conf hunksep -back blue -fore white
260 $ctext tag conf d0 -back "#ff8080"
261 $ctext tag conf d1 -back green
262 $ctext tag conf found -back yellow
263 frame .ctop.cdet.right
265 set cflist .ctop.cdet.right.cfiles
266 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
267 -yscrollcommand ".ctop.cdet.right.sb set"
268 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
269 pack .ctop.cdet.right.sb -side right -fill y
270 pack $cflist -side left -fill both -expand 1
271 .ctop.cdet add .ctop.cdet.right
272 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
273 pack .ctop -side top -fill both -expand 1
275 bindall <1> {selcanvline %x %y}
277 bindall <B1-Motion> {selcanvline %x %y}
278 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
279 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
280 bindall <2> "allcanvs scan mark 0 %y"
281 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
282 bind . <Key-Up> "selnextline -1"
283 bind . <Key-Down> "selnextline 1"
284 bind . <Key-Prior> "allcanvs yview scroll -1 p"
285 bind . <Key-Next> "allcanvs yview scroll 1 p"
286 bindkey <Key-Delete> "$ctext yview scroll -1 p"
287 bindkey <Key-BackSpace> "$ctext yview scroll -1 p"
288 bindkey <Key-space> "$ctext yview scroll 1 p"
289 bindkey p "selnextline -1"
290 bindkey n "selnextline 1"
291 bindkey b "$ctext yview scroll -1 p"
292 bindkey d "$ctext yview scroll 18 u"
293 bindkey u "$ctext yview scroll -18 u"
294 bindkey / findnext
295 bindkey ? findprev
296 bindkey f nextfile
297 bind . <Control-q> doquit
298 bind . <Control-f> dofind
299 bind . <Control-g> findnext
300 bind . <Control-r> findprev
301 bind . <Control-equal> {incrfont 1}
302 bind . <Control-KP_Add> {incrfont 1}
303 bind . <Control-minus> {incrfont -1}
304 bind . <Control-KP_Subtract> {incrfont -1}
305 bind $cflist <<ListboxSelect>> listboxsel
306 bind . <Destroy> {savestuff %W}
307 bind . <Button-1> "click %W"
308 bind $fstring <Key-Return> dofind
309 bind $sha1entry <Key-Return> gotocommit
310}
311# when we make a key binding for the toplevel, make sure
313# it doesn't get triggered when that key is pressed in the
314# find string entry widget.
315proc bindkey {ev script} {
316 global entries
317 bind . $ev $script
318 set escript [bind Entry $ev]
319 if {$escript == {}} {
320 set escript [bind Entry <Key>]
321 }
322 foreach e $entries {
323 bind $e $ev "$escript; break"
324 }
325}
326# set the focus back to the toplevel for any click outside
328# the entry widgets
329proc click {w} {
330 global entries
331 foreach e $entries {
332 if {$w == $e} return
333 }
334 focus .
335}
336proc savestuff {w} {
338 global canv canv2 canv3 ctext cflist mainfont textfont
339 global stuffsaved
340 if {$stuffsaved} return
341 if {![winfo viewable .]} return
342 catch {
343 set f [open "~/.gitk-new" w]
344 puts $f "set mainfont {$mainfont}"
345 puts $f "set textfont {$textfont}"
346 puts $f "set geometry(width) [winfo width .ctop]"
347 puts $f "set geometry(height) [winfo height .ctop]"
348 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
349 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
350 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
351 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
352 set wid [expr {([winfo width $ctext] - 8) \
353 / [font measure $textfont "0"]}]
354 puts $f "set geometry(ctextw) $wid"
355 set wid [expr {([winfo width $cflist] - 11) \
356 / [font measure [$cflist cget -font] "0"]}]
357 puts $f "set geometry(cflistw) $wid"
358 close $f
359 file rename -force "~/.gitk-new" "~/.gitk"
360 }
361 set stuffsaved 1
362}
363proc resizeclistpanes {win w} {
365 global oldwidth
366 if [info exists oldwidth($win)] {
367 set s0 [$win sash coord 0]
368 set s1 [$win sash coord 1]
369 if {$w < 60} {
370 set sash0 [expr {int($w/2 - 2)}]
371 set sash1 [expr {int($w*5/6 - 2)}]
372 } else {
373 set factor [expr {1.0 * $w / $oldwidth($win)}]
374 set sash0 [expr {int($factor * [lindex $s0 0])}]
375 set sash1 [expr {int($factor * [lindex $s1 0])}]
376 if {$sash0 < 30} {
377 set sash0 30
378 }
379 if {$sash1 < $sash0 + 20} {
380 set sash1 [expr $sash0 + 20]
381 }
382 if {$sash1 > $w - 10} {
383 set sash1 [expr $w - 10]
384 if {$sash0 > $sash1 - 20} {
385 set sash0 [expr $sash1 - 20]
386 }
387 }
388 }
389 $win sash place 0 $sash0 [lindex $s0 1]
390 $win sash place 1 $sash1 [lindex $s1 1]
391 }
392 set oldwidth($win) $w
393}
394proc resizecdetpanes {win w} {
396 global oldwidth
397 if [info exists oldwidth($win)] {
398 set s0 [$win sash coord 0]
399 if {$w < 60} {
400 set sash0 [expr {int($w*3/4 - 2)}]
401 } else {
402 set factor [expr {1.0 * $w / $oldwidth($win)}]
403 set sash0 [expr {int($factor * [lindex $s0 0])}]
404 if {$sash0 < 45} {
405 set sash0 45
406 }
407 if {$sash0 > $w - 15} {
408 set sash0 [expr $w - 15]
409 }
410 }
411 $win sash place 0 $sash0 [lindex $s0 1]
412 }
413 set oldwidth($win) $w
414}
415proc allcanvs args {
417 global canv canv2 canv3
418 eval $canv $args
419 eval $canv2 $args
420 eval $canv3 $args
421}
422proc bindall {event action} {
424 global canv canv2 canv3
425 bind $canv $event $action
426 bind $canv2 $event $action
427 bind $canv3 $event $action
428}
429proc about {} {
431 set w .about
432 if {[winfo exists $w]} {
433 raise $w
434 return
435 }
436 toplevel $w
437 wm title $w "About gitk"
438 message $w.m -text {
439Gitk version 1.0
440Copyright © 2005 Paul Mackerras
442Use and redistribute under the terms of the GNU General Public License
444(CVS $Revision: 1.18 $)} \
446 -justify center -aspect 400
447 pack $w.m -side top -fill x -padx 20 -pady 20
448 button $w.ok -text Close -command "destroy $w"
449 pack $w.ok -side bottom
450}
451proc truncatetofit {str width font} {
453 if {[font measure $font $str] <= $width} {
454 return $str
455 }
456 set best 0
457 set bad [string length $str]
458 set tmp $str
459 while {$best < $bad - 1} {
460 set try [expr {int(($best + $bad) / 2)}]
461 set tmp "[string range $str 0 [expr $try-1]]..."
462 if {[font measure $font $tmp] <= $width} {
463 set best $try
464 } else {
465 set bad $try
466 }
467 }
468 return $tmp
469}
470proc assigncolor {id} {
472 global commitinfo colormap commcolors colors nextcolor
473 global colorbycommitter
474 global parents nparents children nchildren
475 if [info exists colormap($id)] return
476 set ncolors [llength $colors]
477 if {$colorbycommitter} {
478 if {![info exists commitinfo($id)]} {
479 readcommit $id
480 }
481 set comm [lindex $commitinfo($id) 3]
482 if {![info exists commcolors($comm)]} {
483 set commcolors($comm) [lindex $colors $nextcolor]
484 if {[incr nextcolor] >= $ncolors} {
485 set nextcolor 0
486 }
487 }
488 set colormap($id) $commcolors($comm)
489 } else {
490 if {$nparents($id) == 1 && $nchildren($id) == 1} {
491 set child [lindex $children($id) 0]
492 if {[info exists colormap($child)]
493 && $nparents($child) == 1} {
494 set colormap($id) $colormap($child)
495 return
496 }
497 }
498 set badcolors {}
499 foreach child $children($id) {
500 if {[info exists colormap($child)]
501 && [lsearch -exact $badcolors $colormap($child)] < 0} {
502 lappend badcolors $colormap($child)
503 }
504 if {[info exists parents($child)]} {
505 foreach p $parents($child) {
506 if {[info exists colormap($p)]
507 && [lsearch -exact $badcolors $colormap($p)] < 0} {
508 lappend badcolors $colormap($p)
509 }
510 }
511 }
512 }
513 if {[llength $badcolors] >= $ncolors} {
514 set badcolors {}
515 }
516 for {set i 0} {$i <= $ncolors} {incr i} {
517 set c [lindex $colors $nextcolor]
518 if {[incr nextcolor] >= $ncolors} {
519 set nextcolor 0
520 }
521 if {[lsearch -exact $badcolors $c]} break
522 }
523 set colormap($id) $c
524 }
525}
526proc drawgraph {} {
528 global parents children nparents nchildren commits
529 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
530 global datemode cdate
531 global lineid linehtag linentag linedtag commitinfo
532 global nextcolor colormap numcommits
533 global stopped phase redisplaying selectedline idtags idline
534 allcanvs delete all
536 set start {}
537 foreach id [array names nchildren] {
538 if {$nchildren($id) == 0} {
539 lappend start $id
540 }
541 set ncleft($id) $nchildren($id)
542 if {![info exists nparents($id)]} {
543 set nparents($id) 0
544 }
545 }
546 if {$start == {}} {
547 error_popup "Gitk: ERROR: No starting commits found"
548 exit 1
549 }
550 set nextcolor 0
552 foreach id $start {
553 assigncolor $id
554 }
555 set todo $start
556 set level [expr [llength $todo] - 1]
557 set y2 $canvy0
558 set nullentry -1
559 set lineno -1
560 set numcommits 0
561 set phase drawgraph
562 set lthickness [expr {($linespc / 9) + 1}]
563 while 1 {
564 set canvy $y2
565 allcanvs conf -scrollregion \
566 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
567 update
568 if {$stopped} break
569 incr numcommits
570 incr lineno
571 set nlines [llength $todo]
572 set id [lindex $todo $level]
573 set lineid($lineno) $id
574 set idline($id) $lineno
575 set actualparents {}
576 if {[info exists parents($id)]} {
577 foreach p $parents($id) {
578 incr ncleft($p) -1
579 if {![info exists commitinfo($p)]} {
580 readcommit $p
581 if {![info exists commitinfo($p)]} continue
582 }
583 lappend actualparents $p
584 }
585 }
586 if {![info exists commitinfo($id)]} {
587 readcommit $id
588 if {![info exists commitinfo($id)]} {
589 set commitinfo($id) {"No commit information available"}
590 }
591 }
592 set x [expr $canvx0 + $level * $linespc]
593 set y2 [expr $canvy + $linespc]
594 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
595 set t [$canv create line $x $linestarty($level) $x $canvy \
596 -width $lthickness -fill $colormap($id)]
597 $canv lower $t
598 }
599 set linestarty($level) $canvy
600 set ofill [expr {[info exists parents($id)]? "blue": "white"}]
601 set orad [expr {$linespc / 3}]
602 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
603 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
604 -fill $ofill -outline black -width 1]
605 $canv raise $t
606 set xt [expr $canvx0 + $nlines * $linespc]
607 if {$nparents($id) > 2} {
608 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
609 }
610 if {[info exists idtags($id)] && $idtags($id) != {}} {
611 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
612 set yt [expr $canvy - 0.5 * $linespc]
613 set yb [expr $yt + $linespc - 1]
614 set xvals {}
615 set wvals {}
616 foreach tag $idtags($id) {
617 set wid [font measure $mainfont $tag]
618 lappend xvals $xt
619 lappend wvals $wid
620 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
621 }
622 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \
623 -width $lthickness -fill black]
624 $canv lower $t
625 foreach tag $idtags($id) x $xvals wid $wvals {
626 set xl [expr $x + $delta]
627 set xr [expr $x + $delta + $wid + $lthickness]
628 $canv create polygon $x [expr $yt + $delta] $xl $yt\
629 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
630 -width 1 -outline black -fill yellow
631 $canv create text $xl $canvy -anchor w -text $tag \
632 -font $mainfont
633 }
634 }
635 set headline [lindex $commitinfo($id) 0]
636 set name [lindex $commitinfo($id) 1]
637 set date [lindex $commitinfo($id) 2]
638 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
639 -text $headline -font $mainfont ]
640 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
641 -text $name -font $namefont]
642 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
643 -text $date -font $mainfont]
644 if {!$datemode && [llength $actualparents] == 1} {
645 set p [lindex $actualparents 0]
646 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
647 assigncolor $p
648 set todo [lreplace $todo $level $level $p]
649 continue
650 }
651 }
652 set oldtodo $todo
654 set oldlevel $level
655 set lines {}
656 for {set i 0} {$i < $nlines} {incr i} {
657 if {[lindex $todo $i] == {}} continue
658 if {[info exists linestarty($i)]} {
659 set oldstarty($i) $linestarty($i)
660 unset linestarty($i)
661 }
662 if {$i != $level} {
663 lappend lines [list $i [lindex $todo $i]]
664 }
665 }
666 if {$nullentry >= 0} {
667 set todo [lreplace $todo $nullentry $nullentry]
668 if {$nullentry < $level} {
669 incr level -1
670 }
671 }
672 set todo [lreplace $todo $level $level]
674 if {$nullentry > $level} {
675 incr nullentry -1
676 }
677 set i $level
678 foreach p $actualparents {
679 set k [lsearch -exact $todo $p]
680 if {$k < 0} {
681 assigncolor $p
682 set todo [linsert $todo $i $p]
683 if {$nullentry >= $i} {
684 incr nullentry
685 }
686 }
687 lappend lines [list $oldlevel $p]
688 }
689 # choose which one to do next time around
691 set todol [llength $todo]
692 set level -1
693 set latest {}
694 for {set k $todol} {[incr k -1] >= 0} {} {
695 set p [lindex $todo $k]
696 if {$p == {}} continue
697 if {$ncleft($p) == 0} {
698 if {$datemode} {
699 if {$latest == {} || $cdate($p) > $latest} {
700 set level $k
701 set latest $cdate($p)
702 }
703 } else {
704 set level $k
705 break
706 }
707 }
708 }
709 if {$level < 0} {
710 if {$todo != {}} {
711 puts "ERROR: none of the pending commits can be done yet:"
712 foreach p $todo {
713 puts " $p"
714 }
715 }
716 break
717 }
718 # If we are reducing, put in a null entry
720 if {$todol < $nlines} {
721 if {$nullentry >= 0} {
722 set i $nullentry
723 while {$i < $todol
724 && [lindex $oldtodo $i] == [lindex $todo $i]} {
725 incr i
726 }
727 } else {
728 set i $oldlevel
729 if {$level >= $i} {
730 incr i
731 }
732 }
733 if {$i >= $todol} {
734 set nullentry -1
735 } else {
736 set nullentry $i
737 set todo [linsert $todo $nullentry {}]
738 if {$level >= $i} {
739 incr level
740 }
741 }
742 } else {
743 set nullentry -1
744 }
745 foreach l $lines {
747 set i [lindex $l 0]
748 set dst [lindex $l 1]
749 set j [lsearch -exact $todo $dst]
750 if {$i == $j} {
751 if {[info exists oldstarty($i)]} {
752 set linestarty($i) $oldstarty($i)
753 }
754 continue
755 }
756 set xi [expr {$canvx0 + $i * $linespc}]
757 set xj [expr {$canvx0 + $j * $linespc}]
758 set coords {}
759 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
760 lappend coords $xi $oldstarty($i)
761 }
762 lappend coords $xi $canvy
763 if {$j < $i - 1} {
764 lappend coords [expr $xj + $linespc] $canvy
765 } elseif {$j > $i + 1} {
766 lappend coords [expr $xj - $linespc] $canvy
767 }
768 lappend coords $xj $y2
769 set t [$canv create line $coords -width $lthickness \
770 -fill $colormap($dst)]
771 $canv lower $t
772 if {![info exists linestarty($j)]} {
773 set linestarty($j) $y2
774 }
775 }
776 }
777 set phase {}
778 if {$redisplaying} {
779 if {$stopped == 0 && [info exists selectedline]} {
780 selectline $selectedline
781 }
782 if {$stopped == 1} {
783 set stopped 0
784 after idle drawgraph
785 } else {
786 set redisplaying 0
787 }
788 }
789}
790proc findmatches {f} {
792 global findtype foundstring foundstrlen
793 if {$findtype == "Regexp"} {
794 set matches [regexp -indices -all -inline $foundstring $f]
795 } else {
796 if {$findtype == "IgnCase"} {
797 set str [string tolower $f]
798 } else {
799 set str $f
800 }
801 set matches {}
802 set i 0
803 while {[set j [string first $foundstring $str $i]] >= 0} {
804 lappend matches [list $j [expr $j+$foundstrlen-1]]
805 set i [expr $j + $foundstrlen]
806 }
807 }
808 return $matches
809}
810proc dofind {} {
812 global findtype findloc findstring markedmatches commitinfo
813 global numcommits lineid linehtag linentag linedtag
814 global mainfont namefont canv canv2 canv3 selectedline
815 global matchinglines foundstring foundstrlen idtags
816 unmarkmatches
817 focus .
818 set matchinglines {}
819 set fldtypes {Headline Author Date Committer CDate Comment}
820 if {$findtype == "IgnCase"} {
821 set foundstring [string tolower $findstring]
822 } else {
823 set foundstring $findstring
824 }
825 set foundstrlen [string length $findstring]
826 if {$foundstrlen == 0} return
827 if {![info exists selectedline]} {
828 set oldsel -1
829 } else {
830 set oldsel $selectedline
831 }
832 set didsel 0
833 for {set l 0} {$l < $numcommits} {incr l} {
834 set id $lineid($l)
835 set info $commitinfo($id)
836 set doesmatch 0
837 foreach f $info ty $fldtypes {
838 if {$findloc != "All fields" && $findloc != $ty} {
839 continue
840 }
841 set matches [findmatches $f]
842 if {$matches == {}} continue
843 set doesmatch 1
844 if {$ty == "Headline"} {
845 markmatches $canv $l $f $linehtag($l) $matches $mainfont
846 } elseif {$ty == "Author"} {
847 markmatches $canv2 $l $f $linentag($l) $matches $namefont
848 } elseif {$ty == "Date"} {
849 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
850 }
851 }
852 if {$doesmatch} {
853 lappend matchinglines $l
854 if {!$didsel && $l > $oldsel} {
855 findselectline $l
856 set didsel 1
857 }
858 }
859 }
860 if {$matchinglines == {}} {
861 bell
862 } elseif {!$didsel} {
863 findselectline [lindex $matchinglines 0]
864 }
865}
866proc findselectline {l} {
868 global findloc commentend ctext
869 selectline $l
870 if {$findloc == "All fields" || $findloc == "Comments"} {
871 # highlight the matches in the comments
872 set f [$ctext get 1.0 $commentend]
873 set matches [findmatches $f]
874 foreach match $matches {
875 set start [lindex $match 0]
876 set end [expr [lindex $match 1] + 1]
877 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
878 }
879 }
880}
881proc findnext {} {
883 global matchinglines selectedline
884 if {![info exists matchinglines]} {
885 dofind
886 return
887 }
888 if {![info exists selectedline]} return
889 foreach l $matchinglines {
890 if {$l > $selectedline} {
891 findselectline $l
892 return
893 }
894 }
895 bell
896}
897proc findprev {} {
899 global matchinglines selectedline
900 if {![info exists matchinglines]} {
901 dofind
902 return
903 }
904 if {![info exists selectedline]} return
905 set prev {}
906 foreach l $matchinglines {
907 if {$l >= $selectedline} break
908 set prev $l
909 }
910 if {$prev != {}} {
911 findselectline $prev
912 } else {
913 bell
914 }
915}
916proc markmatches {canv l str tag matches font} {
918 set bbox [$canv bbox $tag]
919 set x0 [lindex $bbox 0]
920 set y0 [lindex $bbox 1]
921 set y1 [lindex $bbox 3]
922 foreach match $matches {
923 set start [lindex $match 0]
924 set end [lindex $match 1]
925 if {$start > $end} continue
926 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
927 set xlen [font measure $font [string range $str 0 [expr $end]]]
928 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
929 -outline {} -tags matches -fill yellow]
930 $canv lower $t
931 }
932}
933proc unmarkmatches {} {
935 global matchinglines
936 allcanvs delete matches
937 catch {unset matchinglines}
938}
939proc selcanvline {x y} {
941 global canv canvy0 ctext linespc selectedline
942 global lineid linehtag linentag linedtag
943 set ymax [lindex [$canv cget -scrollregion] 3]
944 set yfrac [lindex [$canv yview] 0]
945 set y [expr {$y + $yfrac * $ymax}]
946 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
947 if {$l < 0} {
948 set l 0
949 }
950 if {[info exists selectedline] && $selectedline == $l} return
951 unmarkmatches
952 selectline $l
953}
954proc selectline {l} {
956 global canv canv2 canv3 ctext commitinfo selectedline
957 global lineid linehtag linentag linedtag
958 global canvy0 linespc nparents treepending
959 global cflist treediffs currentid sha1entry
960 global commentend seenfile numcommits idtags
961 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
962 $canv delete secsel
963 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
964 -tags secsel -fill [$canv cget -selectbackground]]
965 $canv lower $t
966 $canv2 delete secsel
967 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
968 -tags secsel -fill [$canv2 cget -selectbackground]]
969 $canv2 lower $t
970 $canv3 delete secsel
971 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
972 -tags secsel -fill [$canv3 cget -selectbackground]]
973 $canv3 lower $t
974 set y [expr {$canvy0 + $l * $linespc}]
975 set ymax [lindex [$canv cget -scrollregion] 3]
976 set ytop [expr {$y - $linespc - 1}]
977 set ybot [expr {$y + $linespc + 1}]
978 set wnow [$canv yview]
979 set wtop [expr [lindex $wnow 0] * $ymax]
980 set wbot [expr [lindex $wnow 1] * $ymax]
981 set wh [expr {$wbot - $wtop}]
982 set newtop $wtop
983 if {$ytop < $wtop} {
984 if {$ybot < $wtop} {
985 set newtop [expr {$y - $wh / 2.0}]
986 } else {
987 set newtop $ytop
988 if {$newtop > $wtop - $linespc} {
989 set newtop [expr {$wtop - $linespc}]
990 }
991 }
992 } elseif {$ybot > $wbot} {
993 if {$ytop > $wbot} {
994 set newtop [expr {$y - $wh / 2.0}]
995 } else {
996 set newtop [expr {$ybot - $wh}]
997 if {$newtop < $wtop + $linespc} {
998 set newtop [expr {$wtop + $linespc}]
999 }
1000 }
1001 }
1002 if {$newtop != $wtop} {
1003 if {$newtop < 0} {
1004 set newtop 0
1005 }
1006 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1007 }
1008 set selectedline $l
1009 set id $lineid($l)
1011 set currentid $id
1012 $sha1entry delete 0 end
1013 $sha1entry insert 0 $id
1014 $sha1entry selection from 0
1015 $sha1entry selection to end
1016 $ctext conf -state normal
1018 $ctext delete 0.0 end
1019 set info $commitinfo($id)
1020 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1021 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1022 if {[info exists idtags($id)]} {
1023 $ctext insert end "Tags:"
1024 foreach tag $idtags($id) {
1025 $ctext insert end " $tag"
1026 }
1027 $ctext insert end "\n"
1028 }
1029 $ctext insert end "\n"
1030 $ctext insert end [lindex $info 5]
1031 $ctext insert end "\n"
1032 $ctext tag delete Comments
1033 $ctext tag remove found 1.0 end
1034 $ctext conf -state disabled
1035 set commentend [$ctext index "end - 1c"]
1036 $cflist delete 0 end
1038 if {$nparents($id) == 1} {
1039 if {![info exists treediffs($id)]} {
1040 if {![info exists treepending]} {
1041 gettreediffs $id
1042 }
1043 } else {
1044 addtocflist $id
1045 }
1046 }
1047 catch {unset seenfile}
1048}
1049proc selnextline {dir} {
1051 global selectedline
1052 if {![info exists selectedline]} return
1053 set l [expr $selectedline + $dir]
1054 unmarkmatches
1055 selectline $l
1056}
1057proc addtocflist {id} {
1059 global currentid treediffs cflist treepending
1060 if {$id != $currentid} {
1061 gettreediffs $currentid
1062 return
1063 }
1064 $cflist insert end "All files"
1065 foreach f $treediffs($currentid) {
1066 $cflist insert end $f
1067 }
1068 getblobdiffs $id
1069}
1070proc gettreediffs {id} {
1072 global treediffs parents treepending
1073 set treepending $id
1074 set treediffs($id) {}
1075 set p [lindex $parents($id) 0]
1076 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1077 fconfigure $gdtf -blocking 0
1078 fileevent $gdtf readable "gettreediffline $gdtf $id"
1079}
1080proc gettreediffline {gdtf id} {
1082 global treediffs treepending
1083 set n [gets $gdtf line]
1084 if {$n < 0} {
1085 if {![eof $gdtf]} return
1086 close $gdtf
1087 unset treepending
1088 addtocflist $id
1089 return
1090 }
1091 set type [lindex $line 1]
1092 set file [lindex $line 3]
1093 if {$type == "blob"} {
1094 lappend treediffs($id) $file
1095 }
1096}
1097proc getblobdiffs {id} {
1099 global parents diffopts blobdifffd env curdifftag curtagstart
1100 global diffindex difffilestart
1101 set p [lindex $parents($id) 0]
1102 set env(GIT_DIFF_OPTS) $diffopts
1103 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1104 puts "error getting diffs: $err"
1105 return
1106 }
1107 fconfigure $bdf -blocking 0
1108 set blobdifffd($id) $bdf
1109 set curdifftag Comments
1110 set curtagstart 0.0
1111 set diffindex 0
1112 catch {unset difffilestart}
1113 fileevent $bdf readable "getblobdiffline $bdf $id"
1114}
1115proc getblobdiffline {bdf id} {
1117 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1118 global diffnexthead diffnextnote diffindex difffilestart
1119 set n [gets $bdf line]
1120 if {$n < 0} {
1121 if {[eof $bdf]} {
1122 close $bdf
1123 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1124 $ctext tag add $curdifftag $curtagstart end
1125 set seenfile($curdifftag) 1
1126 }
1127 }
1128 return
1129 }
1130 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1131 return
1132 }
1133 $ctext conf -state normal
1134 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1135 # start of a new file
1136 $ctext insert end "\n"
1137 $ctext tag add $curdifftag $curtagstart end
1138 set seenfile($curdifftag) 1
1139 set curtagstart [$ctext index "end - 1c"]
1140 set header $fname
1141 if {[info exists diffnexthead]} {
1142 set fname $diffnexthead
1143 set header "$diffnexthead ($diffnextnote)"
1144 unset diffnexthead
1145 }
1146 set difffilestart($diffindex) [$ctext index "end - 1c"]
1147 incr diffindex
1148 set curdifftag "f:$fname"
1149 $ctext tag delete $curdifftag
1150 set l [expr {(78 - [string length $header]) / 2}]
1151 set pad [string range "----------------------------------------" 1 $l]
1152 $ctext insert end "$pad $header $pad\n" filesep
1153 } elseif {[string range $line 0 2] == "+++"} {
1154 # no need to do anything with this
1155 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1156 set diffnexthead $fn
1157 set diffnextnote "created, mode $m"
1158 } elseif {[string range $line 0 8] == "Deleted: "} {
1159 set diffnexthead [string range $line 9 end]
1160 set diffnextnote "deleted"
1161 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1162 # save the filename in case the next thing is "new file mode ..."
1163 set diffnexthead $fn
1164 set diffnextnote "modified"
1165 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1166 set diffnextnote "new file, mode $m"
1167 } elseif {[string range $line 0 11] == "deleted file"} {
1168 set diffnextnote "deleted"
1169 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1170 $line match f1l f1c f2l f2c rest]} {
1171 $ctext insert end "\t" hunksep
1172 $ctext insert end " $f1l " d0 " $f2l " d1
1173 $ctext insert end " $rest \n" hunksep
1174 } else {
1175 set x [string range $line 0 0]
1176 if {$x == "-" || $x == "+"} {
1177 set tag [expr {$x == "+"}]
1178 set line [string range $line 1 end]
1179 $ctext insert end "$line\n" d$tag
1180 } elseif {$x == " "} {
1181 set line [string range $line 1 end]
1182 $ctext insert end "$line\n"
1183 } elseif {$x == "\\"} {
1184 # e.g. "\ No newline at end of file"
1185 $ctext insert end "$line\n" filesep
1186 } else {
1187 # Something else we don't recognize
1188 if {$curdifftag != "Comments"} {
1189 $ctext insert end "\n"
1190 $ctext tag add $curdifftag $curtagstart end
1191 set seenfile($curdifftag) 1
1192 set curtagstart [$ctext index "end - 1c"]
1193 set curdifftag Comments
1194 }
1195 $ctext insert end "$line\n" filesep
1196 }
1197 }
1198 $ctext conf -state disabled
1199}
1200proc nextfile {} {
1202 global difffilestart ctext
1203 set here [$ctext index @0,0]
1204 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1205 if {[$ctext compare $difffilestart($i) > $here]} {
1206 $ctext yview $difffilestart($i)
1207 break
1208 }
1209 }
1210}
1211proc listboxsel {} {
1213 global ctext cflist currentid treediffs seenfile
1214 if {![info exists currentid]} return
1215 set sel [$cflist curselection]
1216 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1217 # show everything
1218 $ctext tag conf Comments -elide 0
1219 foreach f $treediffs($currentid) {
1220 if [info exists seenfile(f:$f)] {
1221 $ctext tag conf "f:$f" -elide 0
1222 }
1223 }
1224 } else {
1225 # just show selected files
1226 $ctext tag conf Comments -elide 1
1227 set i 1
1228 foreach f $treediffs($currentid) {
1229 set elide [expr {[lsearch -exact $sel $i] < 0}]
1230 if [info exists seenfile(f:$f)] {
1231 $ctext tag conf "f:$f" -elide $elide
1232 }
1233 incr i
1234 }
1235 }
1236}
1237proc setcoords {} {
1239 global linespc charspc canvx0 canvy0 mainfont
1240 set linespc [font metrics $mainfont -linespace]
1241 set charspc [font measure $mainfont "m"]
1242 set canvy0 [expr 3 + 0.5 * $linespc]
1243 set canvx0 [expr 3 + 0.5 * $linespc]
1244}
1245proc redisplay {} {
1247 global selectedline stopped redisplaying phase
1248 if {$stopped > 1} return
1249 if {$phase == "getcommits"} return
1250 set redisplaying 1
1251 if {$phase == "drawgraph"} {
1252 set stopped 1
1253 } else {
1254 drawgraph
1255 }
1256}
1257proc incrfont {inc} {
1259 global mainfont namefont textfont selectedline ctext canv phase
1260 global stopped
1261 unmarkmatches
1262 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1263 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1264 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1265 setcoords
1266 $ctext conf -font $textfont
1267 $ctext tag conf filesep -font [concat $textfont bold]
1268 foreach e $entries {
1269 $e conf -font $mainfont
1270 }
1271 if {$phase == "getcommits"} {
1272 $canv itemconf textitems -font $mainfont
1273 }
1274 redisplay
1275}
1276proc sha1change {n1 n2 op} {
1278 global sha1string currentid sha1but
1279 if {$sha1string == {}
1280 || ([info exists currentid] && $sha1string == $currentid)} {
1281 set state disabled
1282 } else {
1283 set state normal
1284 }
1285 if {[$sha1but cget -state] == $state} return
1286 if {$state == "normal"} {
1287 $sha1but conf -state normal -relief raised -text "Goto: "
1288 } else {
1289 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1290 }
1291}
1292proc gotocommit {} {
1294 global sha1string currentid idline tagids
1295 if {$sha1string == {}
1296 || ([info exists currentid] && $sha1string == $currentid)} return
1297 if {[info exists tagids($sha1string)]} {
1298 set id $tagids($sha1string)
1299 } else {
1300 set id [string tolower $sha1string]
1301 }
1302 if {[info exists idline($id)]} {
1303 selectline $idline($id)
1304 return
1305 }
1306 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1307 set type "SHA1 id"
1308 } else {
1309 set type "Tag"
1310 }
1311 error_popup "$type $sha1string is not known"
1312}
1313proc doquit {} {
1315 global stopped
1316 set stopped 100
1317 destroy .
1318}
1319# defaults...
1321set datemode 0
1322set boldnames 0
1323set diffopts "-U 5 -p"
1324set mainfont {Helvetica 9}
1326set textfont {Courier 9}
1327set colors {green red blue magenta darkgrey brown orange}
1329set colorbycommitter false
1330catch {source ~/.gitk}
1332set namefont $mainfont
1334if {$boldnames} {
1335 lappend namefont bold
1336}
1337set revtreeargs {}
1339foreach arg $argv {
1340 switch -regexp -- $arg {
1341 "^$" { }
1342 "^-b" { set boldnames 1 }
1343 "^-c" { set colorbycommitter 1 }
1344 "^-d" { set datemode 1 }
1345 "^-.*" {
1346 puts stderr "unrecognized option $arg"
1347 exit 1
1348 }
1349 default {
1350 lappend revtreeargs $arg
1351 }
1352 }
1353}
1354set stopped 0
1356set redisplaying 0
1357set stuffsaved 0
1358setcoords
1359makewindow
1360readrefs
1361getcommits $revtreeargs