|
|
|
@ -7,16 +7,20 @@ exec wish "$0" -- "${1+$@}" |
|
|
|
# and distributed under the terms of the GNU General Public Licence, |
|
|
|
# and distributed under the terms of the GNU General Public Licence, |
|
|
|
# either version 2, or (at your option) any later version. |
|
|
|
# either version 2, or (at your option) any later version. |
|
|
|
|
|
|
|
|
|
|
|
# CVS $Revision: 1.21 $ |
|
|
|
# CVS $Revision: 1.22 $ |
|
|
|
|
|
|
|
|
|
|
|
proc getcommits {rargs} { |
|
|
|
proc getcommits {rargs} { |
|
|
|
global commits commfd phase canv mainfont |
|
|
|
global commits commfd phase canv mainfont |
|
|
|
|
|
|
|
global startmsecs nextupdate |
|
|
|
|
|
|
|
|
|
|
|
if {$rargs == {}} { |
|
|
|
if {$rargs == {}} { |
|
|
|
set rargs HEAD |
|
|
|
set rargs HEAD |
|
|
|
} |
|
|
|
} |
|
|
|
set commits {} |
|
|
|
set commits {} |
|
|
|
set phase getcommits |
|
|
|
set phase getcommits |
|
|
|
if [catch {set commfd [open "|git-rev-list $rargs" r]} err] { |
|
|
|
set startmsecs [clock clicks -milliseconds] |
|
|
|
|
|
|
|
set nextupdate [expr $startmsecs + 100] |
|
|
|
|
|
|
|
if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] { |
|
|
|
puts stderr "Error executing git-rev-list: $err" |
|
|
|
puts stderr "Error executing git-rev-list: $err" |
|
|
|
exit 1 |
|
|
|
exit 1 |
|
|
|
} |
|
|
|
} |
|
|
|
@ -28,45 +32,77 @@ proc getcommits {rargs} { |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
proc getcommitline {commfd} { |
|
|
|
proc getcommitline {commfd} { |
|
|
|
global commits parents cdate nparents children nchildren |
|
|
|
global commits parents cdate children nchildren ncleft |
|
|
|
|
|
|
|
global commitlisted phase commitinfo nextupdate |
|
|
|
|
|
|
|
global stopped redisplaying |
|
|
|
|
|
|
|
|
|
|
|
set n [gets $commfd line] |
|
|
|
set n [gets $commfd line] |
|
|
|
if {$n < 0} { |
|
|
|
if {$n < 0} { |
|
|
|
if {![eof $commfd]} return |
|
|
|
if {![eof $commfd]} return |
|
|
|
# this works around what is apparently a bug in Tcl... |
|
|
|
# this works around what is apparently a bug in Tcl... |
|
|
|
fconfigure $commfd -blocking 1 |
|
|
|
fconfigure $commfd -blocking 1 |
|
|
|
if {![catch {close $commfd} err]} { |
|
|
|
if {![catch {close $commfd} err]} { |
|
|
|
after idle readallcommits |
|
|
|
after idle finishcommits |
|
|
|
return |
|
|
|
return |
|
|
|
} |
|
|
|
} |
|
|
|
if {[string range $err 0 4] == "usage"} { |
|
|
|
if {[string range $err 0 4] == "usage"} { |
|
|
|
set err "\ |
|
|
|
set err \ |
|
|
|
Gitk: error reading commits: bad arguments to git-rev-list.\n\ |
|
|
|
{Gitk: error reading commits: bad arguments to git-rev-list. |
|
|
|
(Note: arguments to gitk are passed to git-rev-list\ |
|
|
|
(Note: arguments to gitk are passed to git-rev-list |
|
|
|
to allow selection of commits to be displayed.)" |
|
|
|
to allow selection of commits to be displayed.)} |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
set err "Error reading commits: $err" |
|
|
|
set err "Error reading commits: $err" |
|
|
|
} |
|
|
|
} |
|
|
|
error_popup $err |
|
|
|
error_popup $err |
|
|
|
exit 1 |
|
|
|
exit 1 |
|
|
|
} |
|
|
|
} |
|
|
|
if {![regexp {^[0-9a-f]{40}$} $line]} { |
|
|
|
if {![regexp {^[0-9a-f]{40}$} $line id]} { |
|
|
|
error_popup "Can't parse git-rev-list output: {$line}" |
|
|
|
error_popup "Can't parse git-rev-list output: {$line}" |
|
|
|
exit 1 |
|
|
|
exit 1 |
|
|
|
} |
|
|
|
} |
|
|
|
lappend commits $line |
|
|
|
lappend commits $id |
|
|
|
} |
|
|
|
set commitlisted($id) 1 |
|
|
|
|
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
proc readallcommits {} { |
|
|
|
|
|
|
|
global commits |
|
|
|
|
|
|
|
foreach id $commits { |
|
|
|
|
|
|
|
readcommit $id |
|
|
|
readcommit $id |
|
|
|
update |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
drawgraph |
|
|
|
foreach p $parents($id) { |
|
|
|
|
|
|
|
if {[info exists commitlisted($p)]} { |
|
|
|
|
|
|
|
puts "oops, parent $p before child $id" |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
drawcommit $id |
|
|
|
|
|
|
|
if {[clock clicks -milliseconds] >= $nextupdate} { |
|
|
|
|
|
|
|
doupdate |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
while {$redisplaying} { |
|
|
|
|
|
|
|
set redisplaying 0 |
|
|
|
|
|
|
|
if {$stopped == 1} { |
|
|
|
|
|
|
|
set stopped 0 |
|
|
|
|
|
|
|
set phase "getcommits" |
|
|
|
|
|
|
|
foreach id $commits { |
|
|
|
|
|
|
|
drawcommit $id |
|
|
|
|
|
|
|
if {$stopped} break |
|
|
|
|
|
|
|
if {[clock clicks -milliseconds] >= $nextupdate} { |
|
|
|
|
|
|
|
doupdate |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc doupdate {} { |
|
|
|
|
|
|
|
global commfd nextupdate |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
incr nextupdate 100 |
|
|
|
|
|
|
|
fileevent $commfd readable {} |
|
|
|
|
|
|
|
update |
|
|
|
|
|
|
|
fileevent $commfd readable "getcommitline $commfd" |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
proc readcommit {id} { |
|
|
|
proc readcommit {id} { |
|
|
|
global commitinfo children nchildren parents nparents cdate |
|
|
|
global commitinfo children nchildren parents nparents cdate ncleft |
|
|
|
|
|
|
|
global noreadobj |
|
|
|
|
|
|
|
|
|
|
|
set inhdr 1 |
|
|
|
set inhdr 1 |
|
|
|
set comment {} |
|
|
|
set comment {} |
|
|
|
set headline {} |
|
|
|
set headline {} |
|
|
|
@ -77,10 +113,17 @@ proc readcommit {id} { |
|
|
|
if {![info exists nchildren($id)]} { |
|
|
|
if {![info exists nchildren($id)]} { |
|
|
|
set children($id) {} |
|
|
|
set children($id) {} |
|
|
|
set nchildren($id) 0 |
|
|
|
set nchildren($id) 0 |
|
|
|
|
|
|
|
set ncleft($id) 0 |
|
|
|
} |
|
|
|
} |
|
|
|
set parents($id) {} |
|
|
|
set parents($id) {} |
|
|
|
set nparents($id) 0 |
|
|
|
set nparents($id) 0 |
|
|
|
if [catch {set contents [exec git-cat-file commit $id]}] return |
|
|
|
if {$noreadobj} { |
|
|
|
|
|
|
|
if [catch {set contents [exec git-cat-file commit $id]}] return |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
if [catch {set x [readobj $id]}] return |
|
|
|
|
|
|
|
if {[lindex $x 0] != "commit"} return |
|
|
|
|
|
|
|
set contents [lindex $x 1] |
|
|
|
|
|
|
|
} |
|
|
|
foreach line [split $contents "\n"] { |
|
|
|
foreach line [split $contents "\n"] { |
|
|
|
if {$inhdr} { |
|
|
|
if {$inhdr} { |
|
|
|
if {$line == {}} { |
|
|
|
if {$line == {}} { |
|
|
|
@ -92,12 +135,16 @@ proc readcommit {id} { |
|
|
|
if {![info exists nchildren($p)]} { |
|
|
|
if {![info exists nchildren($p)]} { |
|
|
|
set children($p) {} |
|
|
|
set children($p) {} |
|
|
|
set nchildren($p) 0 |
|
|
|
set nchildren($p) 0 |
|
|
|
|
|
|
|
set ncleft($p) 0 |
|
|
|
} |
|
|
|
} |
|
|
|
lappend parents($id) $p |
|
|
|
lappend parents($id) $p |
|
|
|
incr nparents($id) |
|
|
|
incr nparents($id) |
|
|
|
if {[lsearch -exact $children($p) $id] < 0} { |
|
|
|
if {[lsearch -exact $children($p) $id] < 0} { |
|
|
|
lappend children($p) $id |
|
|
|
lappend children($p) $id |
|
|
|
incr nchildren($p) |
|
|
|
incr nchildren($p) |
|
|
|
|
|
|
|
incr ncleft($p) |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
puts "child $id already in $p's list??" |
|
|
|
} |
|
|
|
} |
|
|
|
} elseif {$tag == "author"} { |
|
|
|
} elseif {$tag == "author"} { |
|
|
|
set x [expr {[llength $line] - 2}] |
|
|
|
set x [expr {[llength $line] - 2}] |
|
|
|
@ -137,6 +184,9 @@ proc readrefs {} { |
|
|
|
set fd [open $f r] |
|
|
|
set fd [open $f r] |
|
|
|
set line [read $fd] |
|
|
|
set line [read $fd] |
|
|
|
if {[regexp {^[0-9a-f]{40}} $line id]} { |
|
|
|
if {[regexp {^[0-9a-f]{40}} $line id]} { |
|
|
|
|
|
|
|
set direct [file tail $f] |
|
|
|
|
|
|
|
set tagids($direct) $id |
|
|
|
|
|
|
|
lappend idtags($id) $direct |
|
|
|
set contents [split [exec git-cat-file tag $id] "\n"] |
|
|
|
set contents [split [exec git-cat-file tag $id] "\n"] |
|
|
|
set obj {} |
|
|
|
set obj {} |
|
|
|
set type {} |
|
|
|
set type {} |
|
|
|
@ -462,361 +512,431 @@ Copyright |
|
|
|
|
|
|
|
|
|
|
|
Use and redistribute under the terms of the GNU General Public License |
|
|
|
Use and redistribute under the terms of the GNU General Public License |
|
|
|
|
|
|
|
|
|
|
|
(CVS $Revision: 1.21 $)} \ |
|
|
|
(CVS $Revision: 1.22 $)} \ |
|
|
|
-justify center -aspect 400 |
|
|
|
-justify center -aspect 400 |
|
|
|
pack $w.m -side top -fill x -padx 20 -pady 20 |
|
|
|
pack $w.m -side top -fill x -padx 20 -pady 20 |
|
|
|
button $w.ok -text Close -command "destroy $w" |
|
|
|
button $w.ok -text Close -command "destroy $w" |
|
|
|
pack $w.ok -side bottom |
|
|
|
pack $w.ok -side bottom |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
proc truncatetofit {str width font} { |
|
|
|
|
|
|
|
if {[font measure $font $str] <= $width} { |
|
|
|
|
|
|
|
return $str |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
set best 0 |
|
|
|
|
|
|
|
set bad [string length $str] |
|
|
|
|
|
|
|
set tmp $str |
|
|
|
|
|
|
|
while {$best < $bad - 1} { |
|
|
|
|
|
|
|
set try [expr {int(($best + $bad) / 2)}] |
|
|
|
|
|
|
|
set tmp "[string range $str 0 [expr $try-1]]..." |
|
|
|
|
|
|
|
if {[font measure $font $tmp] <= $width} { |
|
|
|
|
|
|
|
set best $try |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
set bad $try |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
return $tmp |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc assigncolor {id} { |
|
|
|
proc assigncolor {id} { |
|
|
|
global commitinfo colormap commcolors colors nextcolor |
|
|
|
global commitinfo colormap commcolors colors nextcolor |
|
|
|
global colorbycommitter |
|
|
|
|
|
|
|
global parents nparents children nchildren |
|
|
|
global parents nparents children nchildren |
|
|
|
if [info exists colormap($id)] return |
|
|
|
if [info exists colormap($id)] return |
|
|
|
set ncolors [llength $colors] |
|
|
|
set ncolors [llength $colors] |
|
|
|
if {$colorbycommitter} { |
|
|
|
if {$nparents($id) == 1 && $nchildren($id) == 1} { |
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
set child [lindex $children($id) 0] |
|
|
|
readcommit $id |
|
|
|
if {[info exists colormap($child)] |
|
|
|
} |
|
|
|
&& $nparents($child) == 1} { |
|
|
|
set comm [lindex $commitinfo($id) 3] |
|
|
|
set colormap($id) $colormap($child) |
|
|
|
if {![info exists commcolors($comm)]} { |
|
|
|
return |
|
|
|
set commcolors($comm) [lindex $colors $nextcolor] |
|
|
|
|
|
|
|
if {[incr nextcolor] >= $ncolors} { |
|
|
|
|
|
|
|
set nextcolor 0 |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
set colormap($id) $commcolors($comm) |
|
|
|
} |
|
|
|
} else { |
|
|
|
set badcolors {} |
|
|
|
if {$nparents($id) == 1 && $nchildren($id) == 1} { |
|
|
|
foreach child $children($id) { |
|
|
|
set child [lindex $children($id) 0] |
|
|
|
if {[info exists colormap($child)] |
|
|
|
if {[info exists colormap($child)] |
|
|
|
&& [lsearch -exact $badcolors $colormap($child)] < 0} { |
|
|
|
&& $nparents($child) == 1} { |
|
|
|
lappend badcolors $colormap($child) |
|
|
|
set colormap($id) $colormap($child) |
|
|
|
|
|
|
|
return |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
set badcolors {} |
|
|
|
if {[info exists parents($child)]} { |
|
|
|
foreach child $children($id) { |
|
|
|
foreach p $parents($child) { |
|
|
|
if {[info exists colormap($child)] |
|
|
|
if {[info exists colormap($p)] |
|
|
|
&& [lsearch -exact $badcolors $colormap($child)] < 0} { |
|
|
|
&& [lsearch -exact $badcolors $colormap($p)] < 0} { |
|
|
|
lappend badcolors $colormap($child) |
|
|
|
lappend badcolors $colormap($p) |
|
|
|
} |
|
|
|
|
|
|
|
if {[info exists parents($child)]} { |
|
|
|
|
|
|
|
foreach p $parents($child) { |
|
|
|
|
|
|
|
if {[info exists colormap($p)] |
|
|
|
|
|
|
|
&& [lsearch -exact $badcolors $colormap($p)] < 0} { |
|
|
|
|
|
|
|
lappend badcolors $colormap($p) |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
if {[llength $badcolors] >= $ncolors} { |
|
|
|
} |
|
|
|
set badcolors {} |
|
|
|
if {[llength $badcolors] >= $ncolors} { |
|
|
|
} |
|
|
|
set badcolors {} |
|
|
|
for {set i 0} {$i <= $ncolors} {incr i} { |
|
|
|
} |
|
|
|
set c [lindex $colors $nextcolor] |
|
|
|
for {set i 0} {$i <= $ncolors} {incr i} { |
|
|
|
if {[incr nextcolor] >= $ncolors} { |
|
|
|
set c [lindex $colors $nextcolor] |
|
|
|
set nextcolor 0 |
|
|
|
if {[incr nextcolor] >= $ncolors} { |
|
|
|
} |
|
|
|
set nextcolor 0 |
|
|
|
if {[lsearch -exact $badcolors $c]} break |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
set colormap($id) $c |
|
|
|
if {[lsearch -exact $badcolors $c]} break |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
set colormap($id) $c |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
proc drawgraph {} { |
|
|
|
proc initgraph {} { |
|
|
|
global parents children nparents nchildren commits |
|
|
|
global canvy canvy0 lineno numcommits lthickness nextcolor linespc |
|
|
|
global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc |
|
|
|
global linestarty |
|
|
|
global datemode cdate |
|
|
|
global nchildren ncleft |
|
|
|
global lineid linehtag linentag linedtag commitinfo |
|
|
|
|
|
|
|
global nextcolor colormap numcommits |
|
|
|
|
|
|
|
global stopped phase redisplaying selectedline idtags idline |
|
|
|
|
|
|
|
global idheads |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
allcanvs delete all |
|
|
|
allcanvs delete all |
|
|
|
set start {} |
|
|
|
set nextcolor 0 |
|
|
|
|
|
|
|
set canvy $canvy0 |
|
|
|
|
|
|
|
set lineno -1 |
|
|
|
|
|
|
|
set numcommits 0 |
|
|
|
|
|
|
|
set lthickness [expr {int($linespc / 9) + 1}] |
|
|
|
|
|
|
|
catch {unset linestarty} |
|
|
|
foreach id [array names nchildren] { |
|
|
|
foreach id [array names nchildren] { |
|
|
|
if {$nchildren($id) == 0} { |
|
|
|
|
|
|
|
lappend start $id |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
set ncleft($id) $nchildren($id) |
|
|
|
set ncleft($id) $nchildren($id) |
|
|
|
if {![info exists nparents($id)]} { |
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc drawcommitline {level} { |
|
|
|
|
|
|
|
global parents children nparents nchildren ncleft todo |
|
|
|
|
|
|
|
global canv canv2 canv3 mainfont namefont canvx0 canvy linespc |
|
|
|
|
|
|
|
global datemode cdate |
|
|
|
|
|
|
|
global lineid linehtag linentag linedtag commitinfo |
|
|
|
|
|
|
|
global colormap numcommits currentparents |
|
|
|
|
|
|
|
global oldlevel oldnlines oldtodo |
|
|
|
|
|
|
|
global idtags idline idheads |
|
|
|
|
|
|
|
global lineno lthickness linestarty |
|
|
|
|
|
|
|
global commitlisted |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
incr numcommits |
|
|
|
|
|
|
|
incr lineno |
|
|
|
|
|
|
|
set id [lindex $todo $level] |
|
|
|
|
|
|
|
set lineid($lineno) $id |
|
|
|
|
|
|
|
set idline($id) $lineno |
|
|
|
|
|
|
|
set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] |
|
|
|
|
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
|
|
|
|
readcommit $id |
|
|
|
|
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
|
|
|
|
set commitinfo($id) {"No commit information available"} |
|
|
|
set nparents($id) 0 |
|
|
|
set nparents($id) 0 |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
if {$start == {}} { |
|
|
|
set currentparents {} |
|
|
|
error_popup "Gitk: ERROR: No starting commits found" |
|
|
|
if {[info exists commitlisted($id)] && [info exists parents($id)]} { |
|
|
|
exit 1 |
|
|
|
set currentparents $parents($id) |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
set x [expr $canvx0 + $level * $linespc] |
|
|
|
set nextcolor 0 |
|
|
|
set y1 $canvy |
|
|
|
foreach id $start { |
|
|
|
set canvy [expr $canvy + $linespc] |
|
|
|
assigncolor $id |
|
|
|
allcanvs conf -scrollregion \ |
|
|
|
|
|
|
|
[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] |
|
|
|
|
|
|
|
if {[info exists linestarty($id)] && $linestarty($id) < $y1} { |
|
|
|
|
|
|
|
set t [$canv create line $x $linestarty($id) $x $y1 \ |
|
|
|
|
|
|
|
-width $lthickness -fill $colormap($id)] |
|
|
|
|
|
|
|
$canv lower $t |
|
|
|
} |
|
|
|
} |
|
|
|
set todo $start |
|
|
|
set orad [expr {$linespc / 3}] |
|
|
|
set level [expr [llength $todo] - 1] |
|
|
|
set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ |
|
|
|
set y2 $canvy0 |
|
|
|
[expr $x + $orad - 1] [expr $y1 + $orad - 1] \ |
|
|
|
set nullentry -1 |
|
|
|
-fill $ofill -outline black -width 1] |
|
|
|
set lineno -1 |
|
|
|
$canv raise $t |
|
|
|
set numcommits 0 |
|
|
|
set xt [expr $canvx0 + [llength $todo] * $linespc] |
|
|
|
set phase drawgraph |
|
|
|
if {$nparents($id) > 2} { |
|
|
|
set lthickness [expr {($linespc / 9) + 1}] |
|
|
|
set xt [expr {$xt + ($nparents($id) - 2) * $linespc}] |
|
|
|
while 1 { |
|
|
|
} |
|
|
|
set canvy $y2 |
|
|
|
set marks {} |
|
|
|
allcanvs conf -scrollregion \ |
|
|
|
set ntags 0 |
|
|
|
[list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]] |
|
|
|
if {[info exists idtags($id)]} { |
|
|
|
update |
|
|
|
set marks $idtags($id) |
|
|
|
if {$stopped} break |
|
|
|
set ntags [llength $marks] |
|
|
|
incr numcommits |
|
|
|
} |
|
|
|
incr lineno |
|
|
|
if {[info exists idheads($id)]} { |
|
|
|
set nlines [llength $todo] |
|
|
|
set marks [concat $marks $idheads($id)] |
|
|
|
set id [lindex $todo $level] |
|
|
|
} |
|
|
|
set lineid($lineno) $id |
|
|
|
if {$marks != {}} { |
|
|
|
set idline($id) $lineno |
|
|
|
set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
|
|
|
set actualparents {} |
|
|
|
set yt [expr $y1 - 0.5 * $linespc] |
|
|
|
set ofill white |
|
|
|
set yb [expr $yt + $linespc - 1] |
|
|
|
if {[info exists parents($id)]} { |
|
|
|
set xvals {} |
|
|
|
foreach p $parents($id) { |
|
|
|
set wvals {} |
|
|
|
if {[info exists ncleft($p)]} { |
|
|
|
foreach tag $marks { |
|
|
|
incr ncleft($p) -1 |
|
|
|
set wid [font measure $mainfont $tag] |
|
|
|
if {![info exists commitinfo($p)]} { |
|
|
|
lappend xvals $xt |
|
|
|
readcommit $p |
|
|
|
lappend wvals $wid |
|
|
|
if {![info exists commitinfo($p)]} continue |
|
|
|
set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
|
|
|
} |
|
|
|
|
|
|
|
lappend actualparents $p |
|
|
|
|
|
|
|
set ofill blue |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ |
|
|
|
readcommit $id |
|
|
|
-width $lthickness -fill black] |
|
|
|
if {![info exists commitinfo($id)]} { |
|
|
|
$canv lower $t |
|
|
|
set commitinfo($id) {"No commit information available"} |
|
|
|
foreach tag $marks x $xvals wid $wvals { |
|
|
|
|
|
|
|
set xl [expr $x + $delta] |
|
|
|
|
|
|
|
set xr [expr $x + $delta + $wid + $lthickness] |
|
|
|
|
|
|
|
if {[incr ntags -1] >= 0} { |
|
|
|
|
|
|
|
# draw a tag |
|
|
|
|
|
|
|
$canv create polygon $x [expr $yt + $delta] $xl $yt\ |
|
|
|
|
|
|
|
$xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
|
|
|
|
|
|
|
-width 1 -outline black -fill yellow |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
# draw a head |
|
|
|
|
|
|
|
set xl [expr $xl - $delta/2] |
|
|
|
|
|
|
|
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
|
|
|
|
|
|
|
-width 1 -outline black -fill green |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
$canv create text $xl $y1 -anchor w -text $tag \ |
|
|
|
|
|
|
|
-font $mainfont |
|
|
|
} |
|
|
|
} |
|
|
|
set x [expr $canvx0 + $level * $linespc] |
|
|
|
} |
|
|
|
set y2 [expr $canvy + $linespc] |
|
|
|
set headline [lindex $commitinfo($id) 0] |
|
|
|
if {[info exists linestarty($level)] && $linestarty($level) < $canvy} { |
|
|
|
set name [lindex $commitinfo($id) 1] |
|
|
|
set t [$canv create line $x $linestarty($level) $x $canvy \ |
|
|
|
set date [lindex $commitinfo($id) 2] |
|
|
|
-width $lthickness -fill $colormap($id)] |
|
|
|
set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ |
|
|
|
$canv lower $t |
|
|
|
-text $headline -font $mainfont ] |
|
|
|
} |
|
|
|
set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ |
|
|
|
set linestarty($level) $canvy |
|
|
|
-text $name -font $namefont] |
|
|
|
set orad [expr {$linespc / 3}] |
|
|
|
set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ |
|
|
|
set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \ |
|
|
|
-text $date -font $mainfont] |
|
|
|
[expr $x + $orad - 1] [expr $canvy + $orad - 1] \ |
|
|
|
} |
|
|
|
-fill $ofill -outline black -width 1] |
|
|
|
|
|
|
|
$canv raise $t |
|
|
|
proc updatetodo {level noshortcut} { |
|
|
|
set xt [expr $canvx0 + $nlines * $linespc] |
|
|
|
global datemode currentparents ncleft todo |
|
|
|
if {$nparents($id) > 2} { |
|
|
|
global linestarty oldlevel oldtodo oldnlines |
|
|
|
set xt [expr {$xt + ($nparents($id) - 2) * $linespc}] |
|
|
|
global canvy linespc |
|
|
|
|
|
|
|
global commitinfo |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
foreach p $currentparents { |
|
|
|
|
|
|
|
if {![info exists commitinfo($p)]} { |
|
|
|
|
|
|
|
readcommit $p |
|
|
|
} |
|
|
|
} |
|
|
|
set marks {} |
|
|
|
} |
|
|
|
set ntags 0 |
|
|
|
if {!$noshortcut && [llength $currentparents] == 1} { |
|
|
|
if {[info exists idtags($id)]} { |
|
|
|
set p [lindex $currentparents 0] |
|
|
|
set marks $idtags($id) |
|
|
|
if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { |
|
|
|
set ntags [llength $marks] |
|
|
|
assigncolor $p |
|
|
|
|
|
|
|
set linestarty($p) [expr $canvy - $linespc] |
|
|
|
|
|
|
|
set todo [lreplace $todo $level $level $p] |
|
|
|
|
|
|
|
return 0 |
|
|
|
} |
|
|
|
} |
|
|
|
if {[info exists idheads($id)]} { |
|
|
|
} |
|
|
|
set marks [concat $marks $idheads($id)] |
|
|
|
|
|
|
|
|
|
|
|
set oldlevel $level |
|
|
|
|
|
|
|
set oldtodo $todo |
|
|
|
|
|
|
|
set oldnlines [llength $todo] |
|
|
|
|
|
|
|
set todo [lreplace $todo $level $level] |
|
|
|
|
|
|
|
set i $level |
|
|
|
|
|
|
|
foreach p $currentparents { |
|
|
|
|
|
|
|
incr ncleft($p) -1 |
|
|
|
|
|
|
|
set k [lsearch -exact $todo $p] |
|
|
|
|
|
|
|
if {$k < 0} { |
|
|
|
|
|
|
|
assigncolor $p |
|
|
|
|
|
|
|
set todo [linsert $todo $i $p] |
|
|
|
|
|
|
|
incr i |
|
|
|
} |
|
|
|
} |
|
|
|
if {$marks != {}} { |
|
|
|
} |
|
|
|
set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
|
|
|
return 1 |
|
|
|
set yt [expr $canvy - 0.5 * $linespc] |
|
|
|
} |
|
|
|
set yb [expr $yt + $linespc - 1] |
|
|
|
|
|
|
|
set xvals {} |
|
|
|
proc drawslants {} { |
|
|
|
set wvals {} |
|
|
|
global canv linestarty canvx0 canvy linespc |
|
|
|
foreach tag $marks { |
|
|
|
global oldlevel oldtodo todo currentparents |
|
|
|
set wid [font measure $mainfont $tag] |
|
|
|
global lthickness linespc canvy colormap |
|
|
|
lappend xvals $xt |
|
|
|
|
|
|
|
lappend wvals $wid |
|
|
|
set y1 [expr $canvy - $linespc] |
|
|
|
set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
|
|
|
set y2 $canvy |
|
|
|
} |
|
|
|
set i -1 |
|
|
|
set t [$canv create line $x $canvy [lindex $xvals end] $canvy \ |
|
|
|
foreach id $oldtodo { |
|
|
|
-width $lthickness -fill black] |
|
|
|
incr i |
|
|
|
$canv lower $t |
|
|
|
if {$id == {}} continue |
|
|
|
foreach tag $marks x $xvals wid $wvals { |
|
|
|
set xi [expr {$canvx0 + $i * $linespc}] |
|
|
|
set xl [expr $x + $delta] |
|
|
|
if {$i == $oldlevel} { |
|
|
|
set xr [expr $x + $delta + $wid + $lthickness] |
|
|
|
foreach p $currentparents { |
|
|
|
if {[incr ntags -1] >= 0} { |
|
|
|
set j [lsearch -exact $todo $p] |
|
|
|
# draw a tag |
|
|
|
if {$i == $j && ![info exists linestarty($p)]} { |
|
|
|
$canv create polygon $x [expr $yt + $delta] $xl $yt\ |
|
|
|
set linestarty($p) $y1 |
|
|
|
$xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
|
|
|
|
|
|
|
-width 1 -outline black -fill yellow |
|
|
|
|
|
|
|
} else { |
|
|
|
} else { |
|
|
|
# draw a head |
|
|
|
set xj [expr {$canvx0 + $j * $linespc}] |
|
|
|
set xl [expr $xl - $delta/2] |
|
|
|
set coords [list $xi $y1] |
|
|
|
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
|
|
|
if {$j < $i - 1} { |
|
|
|
-width 1 -outline black -fill green |
|
|
|
lappend coords [expr $xj + $linespc] $y1 |
|
|
|
|
|
|
|
} elseif {$j > $i + 1} { |
|
|
|
|
|
|
|
lappend coords [expr $xj - $linespc] $y1 |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
lappend coords $xj $y2 |
|
|
|
|
|
|
|
set t [$canv create line $coords -width $lthickness \ |
|
|
|
|
|
|
|
-fill $colormap($p)] |
|
|
|
|
|
|
|
$canv lower $t |
|
|
|
|
|
|
|
if {![info exists linestarty($p)]} { |
|
|
|
|
|
|
|
set linestarty($p) $y2 |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
$canv create text $xl $canvy -anchor w -text $tag \ |
|
|
|
|
|
|
|
-font $mainfont |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} elseif {[lindex $todo $i] != $id} { |
|
|
|
set headline [lindex $commitinfo($id) 0] |
|
|
|
set j [lsearch -exact $todo $id] |
|
|
|
set name [lindex $commitinfo($id) 1] |
|
|
|
set xj [expr {$canvx0 + $j * $linespc}] |
|
|
|
set date [lindex $commitinfo($id) 2] |
|
|
|
set coords {} |
|
|
|
set linehtag($lineno) [$canv create text $xt $canvy -anchor w \ |
|
|
|
if {[info exists linestarty($id)] && $linestarty($id) < $y1} { |
|
|
|
-text $headline -font $mainfont ] |
|
|
|
lappend coords $xi $linestarty($id) |
|
|
|
set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \ |
|
|
|
|
|
|
|
-text $name -font $namefont] |
|
|
|
|
|
|
|
set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \ |
|
|
|
|
|
|
|
-text $date -font $mainfont] |
|
|
|
|
|
|
|
if {!$datemode && [llength $actualparents] == 1} { |
|
|
|
|
|
|
|
set p [lindex $actualparents 0] |
|
|
|
|
|
|
|
if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { |
|
|
|
|
|
|
|
assigncolor $p |
|
|
|
|
|
|
|
set todo [lreplace $todo $level $level $p] |
|
|
|
|
|
|
|
continue |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
lappend coords $xi $y1 $xj $y2 |
|
|
|
|
|
|
|
set t [$canv create line $coords -width $lthickness \ |
|
|
|
|
|
|
|
-fill $colormap($id)] |
|
|
|
|
|
|
|
$canv lower $t |
|
|
|
|
|
|
|
set linestarty($id) $y2 |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
set oldtodo $todo |
|
|
|
proc decidenext {} { |
|
|
|
set oldlevel $level |
|
|
|
global parents children nchildren ncleft todo |
|
|
|
set lines {} |
|
|
|
global canv canv2 canv3 mainfont namefont canvx0 canvy linespc |
|
|
|
for {set i 0} {$i < $nlines} {incr i} { |
|
|
|
global datemode cdate |
|
|
|
if {[lindex $todo $i] == {}} continue |
|
|
|
global lineid linehtag linentag linedtag commitinfo |
|
|
|
if {[info exists linestarty($i)]} { |
|
|
|
global currentparents oldlevel oldnlines oldtodo |
|
|
|
set oldstarty($i) $linestarty($i) |
|
|
|
global lineno lthickness |
|
|
|
unset linestarty($i) |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
if {$i != $level} { |
|
|
|
|
|
|
|
lappend lines [list $i [lindex $todo $i]] |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
if {$nullentry >= 0} { |
|
|
|
|
|
|
|
set todo [lreplace $todo $nullentry $nullentry] |
|
|
|
|
|
|
|
if {$nullentry < $level} { |
|
|
|
|
|
|
|
incr level -1 |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
set todo [lreplace $todo $level $level] |
|
|
|
# remove the null entry if present |
|
|
|
if {$nullentry > $level} { |
|
|
|
set nullentry [lsearch -exact $todo {}] |
|
|
|
incr nullentry -1 |
|
|
|
if {$nullentry >= 0} { |
|
|
|
} |
|
|
|
set todo [lreplace $todo $nullentry $nullentry] |
|
|
|
set i $level |
|
|
|
} |
|
|
|
foreach p $actualparents { |
|
|
|
|
|
|
|
set k [lsearch -exact $todo $p] |
|
|
|
|
|
|
|
if {$k < 0} { |
|
|
|
|
|
|
|
assigncolor $p |
|
|
|
|
|
|
|
set todo [linsert $todo $i $p] |
|
|
|
|
|
|
|
if {$nullentry >= $i} { |
|
|
|
|
|
|
|
incr nullentry |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
incr i |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
lappend lines [list $oldlevel $p] |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# choose which one to do next time around |
|
|
|
# choose which one to do next time around |
|
|
|
set todol [llength $todo] |
|
|
|
set todol [llength $todo] |
|
|
|
set level -1 |
|
|
|
set level -1 |
|
|
|
set latest {} |
|
|
|
set latest {} |
|
|
|
for {set k $todol} {[incr k -1] >= 0} {} { |
|
|
|
for {set k $todol} {[incr k -1] >= 0} {} { |
|
|
|
set p [lindex $todo $k] |
|
|
|
set p [lindex $todo $k] |
|
|
|
if {$p == {}} continue |
|
|
|
if {$ncleft($p) == 0} { |
|
|
|
if {$ncleft($p) == 0} { |
|
|
|
if {$datemode} { |
|
|
|
if {$datemode} { |
|
|
|
if {$latest == {} || $cdate($p) > $latest} { |
|
|
|
if {$latest == {} || $cdate($p) > $latest} { |
|
|
|
|
|
|
|
set level $k |
|
|
|
|
|
|
|
set latest $cdate($p) |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
set level $k |
|
|
|
set level $k |
|
|
|
break |
|
|
|
set latest $cdate($p) |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
set level $k |
|
|
|
|
|
|
|
break |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
if {$level < 0} { |
|
|
|
} |
|
|
|
if {$todo != {}} { |
|
|
|
if {$level < 0} { |
|
|
|
puts "ERROR: none of the pending commits can be done yet:" |
|
|
|
if {$todo != {}} { |
|
|
|
foreach p $todo { |
|
|
|
puts "ERROR: none of the pending commits can be done yet:" |
|
|
|
puts " $p" |
|
|
|
foreach p $todo { |
|
|
|
} |
|
|
|
puts " $p" |
|
|
|
} |
|
|
|
} |
|
|
|
break |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
return -1 |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# If we are reducing, put in a null entry |
|
|
|
# If we are reducing, put in a null entry |
|
|
|
if {$todol < $nlines} { |
|
|
|
if {$todol < $oldnlines} { |
|
|
|
if {$nullentry >= 0} { |
|
|
|
if {$nullentry >= 0} { |
|
|
|
set i $nullentry |
|
|
|
set i $nullentry |
|
|
|
while {$i < $todol |
|
|
|
while {$i < $todol |
|
|
|
&& [lindex $oldtodo $i] == [lindex $todo $i]} { |
|
|
|
&& [lindex $oldtodo $i] == [lindex $todo $i]} { |
|
|
|
incr i |
|
|
|
incr i |
|
|
|
} |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
set i $oldlevel |
|
|
|
|
|
|
|
if {$level >= $i} { |
|
|
|
|
|
|
|
incr i |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
if {$i >= $todol} { |
|
|
|
|
|
|
|
set nullentry -1 |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
set nullentry $i |
|
|
|
|
|
|
|
set todo [linsert $todo $nullentry {}] |
|
|
|
|
|
|
|
if {$level >= $i} { |
|
|
|
|
|
|
|
incr level |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
set nullentry -1 |
|
|
|
set i $oldlevel |
|
|
|
|
|
|
|
if {$level >= $i} { |
|
|
|
|
|
|
|
incr i |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
if {$i < $todol} { |
|
|
|
|
|
|
|
set todo [linsert $todo $i {}] |
|
|
|
|
|
|
|
if {$level >= $i} { |
|
|
|
|
|
|
|
incr level |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
return $level |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
foreach l $lines { |
|
|
|
proc drawcommit {id} { |
|
|
|
set i [lindex $l 0] |
|
|
|
global phase todo nchildren datemode nextupdate |
|
|
|
set dst [lindex $l 1] |
|
|
|
global startcommits |
|
|
|
set j [lsearch -exact $todo $dst] |
|
|
|
|
|
|
|
if {$i == $j} { |
|
|
|
if {$phase != "incrdraw"} { |
|
|
|
if {[info exists oldstarty($i)]} { |
|
|
|
set phase incrdraw |
|
|
|
set linestarty($i) $oldstarty($i) |
|
|
|
set todo $id |
|
|
|
} |
|
|
|
set startcommits $id |
|
|
|
continue |
|
|
|
initgraph |
|
|
|
|
|
|
|
assigncolor $id |
|
|
|
|
|
|
|
drawcommitline 0 |
|
|
|
|
|
|
|
updatetodo 0 $datemode |
|
|
|
|
|
|
|
} else { |
|
|
|
|
|
|
|
if {$nchildren($id) == 0} { |
|
|
|
|
|
|
|
lappend todo $id |
|
|
|
|
|
|
|
lappend startcommits $id |
|
|
|
|
|
|
|
assigncolor $id |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
set level [decidenext] |
|
|
|
|
|
|
|
if {$id != [lindex $todo $level]} { |
|
|
|
|
|
|
|
return |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
while 1 { |
|
|
|
|
|
|
|
drawslants |
|
|
|
|
|
|
|
drawcommitline $level |
|
|
|
|
|
|
|
if {[updatetodo $level $datemode]} { |
|
|
|
|
|
|
|
set level [decidenext] |
|
|
|
} |
|
|
|
} |
|
|
|
set xi [expr {$canvx0 + $i * $linespc}] |
|
|
|
set id [lindex $todo $level] |
|
|
|
set xj [expr {$canvx0 + $j * $linespc}] |
|
|
|
if {![info exists commitlisted($id)]} { |
|
|
|
set coords {} |
|
|
|
break |
|
|
|
if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} { |
|
|
|
|
|
|
|
lappend coords $xi $oldstarty($i) |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
lappend coords $xi $canvy |
|
|
|
if {[clock clicks -milliseconds] >= $nextupdate} { |
|
|
|
if {$j < $i - 1} { |
|
|
|
doupdate |
|
|
|
lappend coords [expr $xj + $linespc] $canvy |
|
|
|
if {$stopped} break |
|
|
|
} elseif {$j > $i + 1} { |
|
|
|
|
|
|
|
lappend coords [expr $xj - $linespc] $canvy |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
lappend coords $xj $y2 |
|
|
|
} |
|
|
|
set t [$canv create line $coords -width $lthickness \ |
|
|
|
} |
|
|
|
-fill $colormap($dst)] |
|
|
|
} |
|
|
|
$canv lower $t |
|
|
|
|
|
|
|
if {![info exists linestarty($j)]} { |
|
|
|
proc finishcommits {} { |
|
|
|
set linestarty($j) $y2 |
|
|
|
global phase |
|
|
|
|
|
|
|
global startcommits |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if {$phase != "incrdraw"} { |
|
|
|
|
|
|
|
$canv delete all |
|
|
|
|
|
|
|
$canv create text 3 3 -anchor nw -text "No commits selected" \ |
|
|
|
|
|
|
|
-font $mainfont -tags textitems |
|
|
|
|
|
|
|
set phase {} |
|
|
|
|
|
|
|
return |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
drawslants |
|
|
|
|
|
|
|
set level [decidenext] |
|
|
|
|
|
|
|
drawrest $level [llength $startcommits] |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc drawgraph {} { |
|
|
|
|
|
|
|
global nextupdate startmsecs startcommits todo |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if {$startcommits == {}} return |
|
|
|
|
|
|
|
set startmsecs [clock clicks -milliseconds] |
|
|
|
|
|
|
|
set nextupdate [expr $startmsecs + 100] |
|
|
|
|
|
|
|
initgraph |
|
|
|
|
|
|
|
set todo [lindex $startcommits 0] |
|
|
|
|
|
|
|
drawrest 0 1 |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc drawrest {level startix} { |
|
|
|
|
|
|
|
global phase stopped redisplaying selectedline |
|
|
|
|
|
|
|
global datemode currentparents todo |
|
|
|
|
|
|
|
global numcommits |
|
|
|
|
|
|
|
global nextupdate startmsecs startcommits idline |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
set phase drawgraph |
|
|
|
|
|
|
|
set startid [lindex $startcommits $startix] |
|
|
|
|
|
|
|
set startline -1 |
|
|
|
|
|
|
|
if {$startid != {}} { |
|
|
|
|
|
|
|
set startline $idline($startid) |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
while 1 { |
|
|
|
|
|
|
|
if {$stopped} break |
|
|
|
|
|
|
|
drawcommitline $level |
|
|
|
|
|
|
|
set hard [updatetodo $level $datemode] |
|
|
|
|
|
|
|
if {$numcommits == $startline} { |
|
|
|
|
|
|
|
lappend todo $startid |
|
|
|
|
|
|
|
set hard 1 |
|
|
|
|
|
|
|
incr startix |
|
|
|
|
|
|
|
set startid [lindex $startcommits $startix] |
|
|
|
|
|
|
|
set startline -1 |
|
|
|
|
|
|
|
if {$startid != {}} { |
|
|
|
|
|
|
|
set startline $idline($startid) |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
if {$hard} { |
|
|
|
|
|
|
|
set level [decidenext] |
|
|
|
|
|
|
|
if {$level < 0} break |
|
|
|
|
|
|
|
drawslants |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
if {[clock clicks -milliseconds] >= $nextupdate} { |
|
|
|
|
|
|
|
update |
|
|
|
|
|
|
|
incr nextupdate 100 |
|
|
|
|
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
set phase {} |
|
|
|
set phase {} |
|
|
|
|
|
|
|
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] |
|
|
|
|
|
|
|
puts "overall $drawmsecs ms for $numcommits commits" |
|
|
|
if {$redisplaying} { |
|
|
|
if {$redisplaying} { |
|
|
|
if {$stopped == 0 && [info exists selectedline]} { |
|
|
|
if {$stopped == 0 && [info exists selectedline]} { |
|
|
|
selectline $selectedline |
|
|
|
selectline $selectedline |
|
|
|
@ -854,7 +974,7 @@ proc dofind {} { |
|
|
|
global findtype findloc findstring markedmatches commitinfo |
|
|
|
global findtype findloc findstring markedmatches commitinfo |
|
|
|
global numcommits lineid linehtag linentag linedtag |
|
|
|
global numcommits lineid linehtag linentag linedtag |
|
|
|
global mainfont namefont canv canv2 canv3 selectedline |
|
|
|
global mainfont namefont canv canv2 canv3 selectedline |
|
|
|
global matchinglines foundstring foundstrlen idtags |
|
|
|
global matchinglines foundstring foundstrlen |
|
|
|
unmarkmatches |
|
|
|
unmarkmatches |
|
|
|
focus . |
|
|
|
focus . |
|
|
|
set matchinglines {} |
|
|
|
set matchinglines {} |
|
|
|
@ -1000,7 +1120,7 @@ proc selectline {l} { |
|
|
|
global lineid linehtag linentag linedtag |
|
|
|
global lineid linehtag linentag linedtag |
|
|
|
global canvy0 linespc nparents treepending |
|
|
|
global canvy0 linespc nparents treepending |
|
|
|
global cflist treediffs currentid sha1entry |
|
|
|
global cflist treediffs currentid sha1entry |
|
|
|
global commentend seenfile numcommits idtags |
|
|
|
global commentend seenfile idtags |
|
|
|
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
|
|
|
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
|
|
|
$canv delete secsel |
|
|
|
$canv delete secsel |
|
|
|
set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ |
|
|
|
set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ |
|
|
|
@ -1288,7 +1408,7 @@ proc redisplay {} { |
|
|
|
if {$stopped > 1} return |
|
|
|
if {$stopped > 1} return |
|
|
|
if {$phase == "getcommits"} return |
|
|
|
if {$phase == "getcommits"} return |
|
|
|
set redisplaying 1 |
|
|
|
set redisplaying 1 |
|
|
|
if {$phase == "drawgraph"} { |
|
|
|
if {$phase == "drawgraph" || $phase == "incrdraw"} { |
|
|
|
set stopped 1 |
|
|
|
set stopped 1 |
|
|
|
} else { |
|
|
|
} else { |
|
|
|
drawgraph |
|
|
|
drawgraph |
|
|
|
@ -1366,7 +1486,6 @@ set mainfont {Helvetica 9} |
|
|
|
set textfont {Courier 9} |
|
|
|
set textfont {Courier 9} |
|
|
|
|
|
|
|
|
|
|
|
set colors {green red blue magenta darkgrey brown orange} |
|
|
|
set colors {green red blue magenta darkgrey brown orange} |
|
|
|
set colorbycommitter 0 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
catch {source ~/.gitk} |
|
|
|
catch {source ~/.gitk} |
|
|
|
|
|
|
|
|
|
|
|
@ -1380,7 +1499,6 @@ foreach arg $argv { |
|
|
|
switch -regexp -- $arg { |
|
|
|
switch -regexp -- $arg { |
|
|
|
"^$" { } |
|
|
|
"^$" { } |
|
|
|
"^-b" { set boldnames 1 } |
|
|
|
"^-b" { set boldnames 1 } |
|
|
|
"^-c" { set colorbycommitter 1 } |
|
|
|
|
|
|
|
"^-d" { set datemode 1 } |
|
|
|
"^-d" { set datemode 1 } |
|
|
|
default { |
|
|
|
default { |
|
|
|
lappend revtreeargs $arg |
|
|
|
lappend revtreeargs $arg |
|
|
|
@ -1388,6 +1506,8 @@ foreach arg $argv { |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
set noreadobj [load libreadobj.so.0.0] |
|
|
|
|
|
|
|
set noreadobj 0 |
|
|
|
set stopped 0 |
|
|
|
set stopped 0 |
|
|
|
set redisplaying 0 |
|
|
|
set redisplaying 0 |
|
|
|
set stuffsaved 0 |
|
|
|
set stuffsaved 0 |
|
|
|
|
Paul Mackerras
20 years ago