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