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