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