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