提交 f6075eba 编写于 作者: P Paul Mackerras

Allow graph lines to jump through hyperspace.

When the graph gets too wide (as defined by the maxwidth variable,
which can be set in ~/.gitk), we can now terminate graph lines with
an arrow pointing downwards, and reintroduce them later with an
arrow pointing upwards when we need them.  This makes the graph much
less cluttered on large repositories such as the linux kernel.

Unfortunately this has made it slower; it takes about 10 seconds
user time on the linux-2.6 repository on my machine now, compared
to 6 seconds before.  I'll have to work on optimizing that.  Also
on the todo list are making the arrow heads active (so if you click
on them you jump to the other end) and improving the placement of
the null entry.
上级 244edd12
......@@ -59,7 +59,7 @@ proc getcommits {rargs} {
}
proc getcommitlines {commfd} {
global commits parents cdate children nchildren
global commits parents cdate children
global commitlisted phase commitinfo nextupdate
global stopped redisplaying leftover
......@@ -750,21 +750,24 @@ proc assigncolor {id} {
}
proc initgraph {} {
global canvy canvy0 lineno numcommits lthickness nextcolor linespc
global mainline sidelines
global canvy canvy0 lineno numcommits nextcolor linespc
global mainline mainlinearrow sidelines
global nchildren ncleft
global displist nhyperspace
allcanvs delete all
set nextcolor 0
set canvy $canvy0
set lineno -1
set numcommits 0
set lthickness [expr {int($linespc / 9) + 1}]
catch {unset mainline}
catch {unset mainlinearrow}
catch {unset sidelines}
foreach id [array names nchildren] {
set ncleft($id) $nchildren($id)
}
set displist {}
set nhyperspace 0
}
proc bindline {t id} {
......@@ -776,19 +779,21 @@ proc bindline {t id} {
$canv bind $t <Button-1> "lineclick %x %y $id 1"
}
# level here is an index in displist
proc drawcommitline {level} {
global parents children nparents nchildren todo
global parents children nparents displist
global canv canv2 canv3 mainfont namefont canvy linespc
global lineid linehtag linentag linedtag commitinfo
global colormap numcommits currentparents dupparents
global oldlevel oldnlines oldtodo
global idtags idline idheads
global lineno lthickness mainline sidelines
global commitlisted rowtextx idpos
global lineno lthickness mainline mainlinearrow sidelines
global commitlisted rowtextx idpos lastuse displist
global oldnlines olddlevel olddisplist
incr numcommits
incr lineno
set id [lindex $todo $level]
set id [lindex $displist $level]
set lastuse($id) $lineno
set lineid($lineno) $id
set idline($id) $lineno
set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
......@@ -819,8 +824,12 @@ proc drawcommitline {level} {
[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
if {[info exists mainline($id)]} {
lappend mainline($id) $x $y1
if {$mainlinearrow($id) ne "none"} {
set mainline($id) [trimdiagstart $mainline($id)]
}
set t [$canv create line $mainline($id) \
-width $lthickness -fill $colormap($id)]
-width $lthickness -fill $colormap($id) \
-arrow $mainlinearrow($id)]
$canv lower $t
bindline $t $id
}
......@@ -828,8 +837,9 @@ proc drawcommitline {level} {
foreach ls $sidelines($id) {
set coords [lindex $ls 0]
set thick [lindex $ls 1]
set arrow [lindex $ls 2]
set t [$canv create line $coords -fill $colormap($id) \
-width [expr {$thick * $lthickness}]]
-width [expr {$thick * $lthickness}] -arrow $arrow]
$canv lower $t
bindline $t $id
}
......@@ -840,7 +850,7 @@ proc drawcommitline {level} {
-fill $ofill -outline black -width 1]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
set xt [xcoord [llength $todo] $level $lineno]
set xt [xcoord [llength $displist] $level $lineno]
if {[llength $currentparents] > 2} {
set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
}
......@@ -859,6 +869,10 @@ proc drawcommitline {level} {
-text $name -font $namefont]
set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
-text $date -font $mainfont]
set olddlevel $level
set olddisplist $displist
set oldnlines [llength $displist]
}
proc drawtags {id x xt y1} {
......@@ -913,46 +927,11 @@ proc drawtags {id x xt y1} {
return $xt
}
proc updatetodo {level noshortcut} {
global currentparents ncleft todo
global mainline oldlevel oldtodo oldnlines
global canvy linespc mainline
global commitinfo lineno xspc1
set oldlevel $level
set oldtodo $todo
set oldnlines [llength $todo]
if {!$noshortcut && [llength $currentparents] == 1} {
set p [lindex $currentparents 0]
if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
set ncleft($p) 0
set x [xcoord $level $level $lineno]
set y [expr $canvy - $linespc]
set mainline($p) [list $x $y]
set todo [lreplace $todo $level $level $p]
set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
return 0
}
}
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} {
set todo [linsert $todo $i $p]
incr i
}
}
return 1
}
proc notecrossings {id lo hi corner} {
global oldtodo crossings cornercrossings
global olddisplist crossings cornercrossings
for {set i $lo} {[incr i] < $hi} {} {
set p [lindex $oldtodo $i]
set p [lindex $olddisplist $i]
if {$p == {}} continue
if {$i == $corner} {
if {![info exists cornercrossings($id)]
......@@ -988,37 +967,218 @@ proc xcoord {i level ln} {
return $x
}
proc drawslants {level} {
global canv mainline sidelines canvx0 canvy xspc1 xspc2 lthickness
global oldlevel oldtodo todo currentparents dupparents
# it seems Tk can't draw arrows on the end of diagonal line segments...
proc trimdiagend {line} {
while {[llength $line] > 4} {
set x1 [lindex $line end-3]
set y1 [lindex $line end-2]
set x2 [lindex $line end-1]
set y2 [lindex $line end]
if {($x1 == $x2) != ($y1 == $y2)} break
set line [lreplace $line end-1 end]
}
return $line
}
proc trimdiagstart {line} {
while {[llength $line] > 4} {
set x1 [lindex $line 0]
set y1 [lindex $line 1]
set x2 [lindex $line 2]
set y2 [lindex $line 3]
if {($x1 == $x2) != ($y1 == $y2)} break
set line [lreplace $line 0 1]
}
return $line
}
proc drawslants {id needonscreen nohs} {
global canv mainline mainlinearrow sidelines
global canvx0 canvy xspc1 xspc2 lthickness
global currentparents dupparents
global lthickness linespc canvy colormap lineno geometry
global maxgraphpct
global maxgraphpct maxwidth
global displist onscreen lastuse
global parents commitlisted
global oldnlines olddlevel olddisplist
global nhyperspace numcommits nnewparents
if {$lineno < 0} {
lappend displist $id
set onscreen($id) 1
return 0
}
set y1 [expr {$canvy - $linespc}]
set y2 $canvy
# work out what we need to get back on screen
set reins {}
if {$onscreen($id) < 0} {
# next to do isn't displayed, better get it on screen...
lappend reins [list $id 0]
}
# make sure all the previous commits's parents are on the screen
foreach p $currentparents {
if {$onscreen($p) < 0} {
lappend reins [list $p 0]
}
}
# bring back anything requested by caller
if {$needonscreen ne {}} {
lappend reins $needonscreen
}
# try the shortcut
if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
set dlevel $olddlevel
set x [xcoord $dlevel $dlevel $lineno]
set mainline($id) [list $x $y1]
set mainlinearrow($id) none
set lastuse($id) $lineno
set displist [lreplace $displist $dlevel $dlevel $id]
set onscreen($id) 1
set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
return $dlevel
}
# update displist
set displist [lreplace $displist $olddlevel $olddlevel]
set j $olddlevel
foreach p $currentparents {
set lastuse($p) $lineno
if {$onscreen($p) == 0} {
set displist [linsert $displist $j $p]
set onscreen($p) 1
incr j
}
}
if {$onscreen($id) == 0} {
lappend displist $id
}
# remove the null entry if present
set nullentry [lsearch -exact $displist {}]
if {$nullentry >= 0} {
set displist [lreplace $displist $nullentry $nullentry]
}
# bring back the ones we need now (if we did it earlier
# it would change displist and invalidate olddlevel)
foreach pi $reins {
# test again in case of duplicates in reins
set p [lindex $pi 0]
if {$onscreen($p) < 0} {
set onscreen($p) 1
set lastuse($p) $lineno
set displist [linsert $displist [lindex $pi 1] $p]
incr nhyperspace -1
}
}
set lastuse($id) $lineno
# see if we need to make any lines jump off into hyperspace
set displ [llength $displist]
if {$displ > $maxwidth} {
set ages {}
foreach x $displist {
lappend ages [list $lastuse($x) $x]
}
set ages [lsort -integer -index 0 $ages]
set k 0
while {$displ > $maxwidth} {
set use [lindex $ages $k 0]
set victim [lindex $ages $k 1]
if {$use >= $lineno - 5} break
incr k
if {[lsearch -exact $nohs $victim] >= 0} continue
set i [lsearch -exact $displist $victim]
set displist [lreplace $displist $i $i]
set onscreen($victim) -1
incr nhyperspace
incr displ -1
if {$i < $nullentry} {
incr nullentry -1
}
set x [lindex $mainline($victim) end-1]
lappend mainline($victim) $x $y1
set line [trimdiagend $mainline($victim)]
set arrow "last"
if {$mainlinearrow($victim) ne "none"} {
set line [trimdiagstart $line]
set arrow "both"
}
lappend sidelines($victim) [list $line 1 $arrow]
unset mainline($victim)
}
}
set dlevel [lsearch -exact $displist $id]
# If we are reducing, put in a null entry
if {$displ < $oldnlines} {
# does the next line look like a merge?
# i.e. does it have > 1 new parent?
if {$nnewparents($id) > 1} {
set i [expr {$dlevel + 1}]
} elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
set i $olddlevel
if {$nullentry >= 0 && $nullentry < $i} {
incr i -1
}
} elseif {$nullentry >= 0} {
set i $nullentry
while {$i < $displ
&& [lindex $olddisplist $i] == [lindex $displist $i]} {
incr i
}
} else {
set i $olddlevel
if {$dlevel >= $i} {
incr i
}
}
if {$i < $displ} {
set displist [linsert $displist $i {}]
incr displ
if {$dlevel >= $i} {
incr dlevel
}
}
}
# decide on the line spacing for the next line
set lj [expr {$lineno + 1}]
set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
set n [llength $todo]
if {$n <= 1 || $canvx0 + $n * $xspc2 <= $maxw} {
if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
set xspc1($lj) $xspc2
} else {
set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($n - 1)}]
set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
if {$xspc1($lj) < $lthickness} {
set xspc1($lj) $lthickness
}
}
set y1 [expr $canvy - $linespc]
set y2 $canvy
foreach idi $reins {
set id [lindex $idi 0]
set j [lsearch -exact $displist $id]
set xj [xcoord $j $dlevel $lj]
set mainline($id) [list $xj $y2]
set mainlinearrow($id) first
}
set i -1
foreach id $oldtodo {
foreach id $olddisplist {
incr i
if {$id == {}} continue
set xi [xcoord $i $oldlevel $lineno]
if {$i == $oldlevel} {
if {$onscreen($id) <= 0} continue
set xi [xcoord $i $olddlevel $lineno]
if {$i == $olddlevel} {
foreach p $currentparents {
set j [lsearch -exact $todo $p]
set j [lsearch -exact $displist $p]
set coords [list $xi $y1]
set xj [xcoord $j $level $lj]
set xj [xcoord $j $dlevel $lj]
if {$xj < $xi - $linespc} {
lappend coords [expr {$xj + $linespc}] $y1
notecrossings $p $j $i [expr {$j + 1}]
......@@ -1029,9 +1189,10 @@ proc drawslants {level} {
if {[lsearch -exact $dupparents $p] >= 0} {
# draw a double-width line to indicate the doubled parent
lappend coords $xj $y2
lappend sidelines($p) [list $coords 2]
lappend sidelines($p) [list $coords 2 none]
if {![info exists mainline($p)]} {
set mainline($p) [list $xj $y2]
set mainlinearrow($p) none
}
} else {
# normal case, no parent duplicated
......@@ -1045,24 +1206,25 @@ proc drawslants {level} {
lappend coords $xj $yb
}
set mainline($p) $coords
set mainlinearrow($p) none
} else {
lappend coords $xj $yb
if {$yb < $y2} {
lappend coords $xj $y2
}
lappend sidelines($p) [list $coords 1]
lappend sidelines($p) [list $coords 1 none]
}
}
}
} else {
set j $i
if {[lindex $todo $i] != $id} {
set j [lsearch -exact $todo $id]
if {[lindex $displist $i] != $id} {
set j [lsearch -exact $displist $id]
}
if {$j != $i || $xspc1($lineno) != $xspc1($lj)
|| ($oldlevel <= $i && $i <= $level)
|| ($level <= $i && $i <= $oldlevel)} {
set xj [xcoord $j $level $lj]
|| ($olddlevel <= $i && $i <= $dlevel)
|| ($dlevel <= $i && $i <= $olddlevel)} {
set xj [xcoord $j $dlevel $lj]
set dx [expr {abs($xi - $xj)}]
set yb $y2
if {0 && $dx < $linespc} {
......@@ -1072,21 +1234,152 @@ proc drawslants {level} {
}
}
}
return $dlevel
}
# search for x in a list of lists
proc llsearch {llist x} {
set i 0
foreach l $llist {
if {$l == $x || [lsearch -exact $l $x] >= 0} {
return $i
}
incr i
}
return -1
}
proc drawmore {reading} {
global displayorder numcommits ncmupdate nextupdate
global stopped nhyperspace parents commitlisted
global maxwidth onscreen displist currentparents olddlevel
set n [llength $displayorder]
while {$numcommits < $n} {
set id [lindex $displayorder $numcommits]
set ctxend [expr {$numcommits + 10}]
if {!$reading && $ctxend > $n} {
set ctxend $n
}
set dlist {}
if {$numcommits > 0} {
set dlist [lreplace $displist $olddlevel $olddlevel]
set i $olddlevel
foreach p $currentparents {
if {$onscreen($p) == 0} {
set dlist [linsert $dlist $i $p]
incr i
}
}
}
set nohs {}
set reins {}
set isfat [expr {[llength $dlist] > $maxwidth}]
if {$nhyperspace > 0 || $isfat} {
if {$ctxend > $n} break
# work out what to bring back and
# what we want to don't want to send into hyperspace
set room 1
for {set k $numcommits} {$k < $ctxend} {incr k} {
set x [lindex $displayorder $k]
set i [llsearch $dlist $x]
if {$i < 0} {
set i [llength $dlist]
lappend dlist $x
}
if {[lsearch -exact $nohs $x] < 0} {
lappend nohs $x
}
if {$reins eq {} && $onscreen($x) < 0 && $room} {
set reins [list $x $i]
}
set newp {}
if {[info exists commitlisted($x)]} {
set right 0
foreach p $parents($x) {
if {[llsearch $dlist $p] < 0} {
lappend newp $p
if {[lsearch -exact $nohs $p] < 0} {
lappend nohs $p
}
if {$reins eq {} && $onscreen($p) < 0 && $room} {
set reins [list $p [expr {$i + $right}]]
}
}
set right 1
}
}
set l [lindex $dlist $i]
if {[llength $l] == 1} {
set l $newp
} else {
set j [lsearch -exact $l $x]
set l [concat [lreplace $l $j $j] $newp]
}
set dlist [lreplace $dlist $i $i $l]
if {$room && $isfat && [llength $newp] <= 1} {
set room 0
}
}
}
set dlevel [drawslants $id $reins $nohs]
drawcommitline $dlevel
if {[clock clicks -milliseconds] >= $nextupdate
&& $numcommits >= $ncmupdate} {
doupdate $reading
if {$stopped} break
}
}
}
# level here is an index in todo
proc updatetodo {level noshortcut} {
global ncleft todo nnewparents
global commitlisted parents onscreen
set id [lindex $todo $level]
set olds {}
if {[info exists commitlisted($id)]} {
foreach p $parents($id) {
if {[lsearch -exact $olds $p] < 0} {
lappend olds $p
}
}
}
if {!$noshortcut && [llength $olds] == 1} {
set p [lindex $olds 0]
if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
set ncleft($p) 0
set todo [lreplace $todo $level $level $p]
set onscreen($p) 0
set nnewparents($id) 1
return 0
}
}
set todo [lreplace $todo $level $level]
set i $level
set n 0
foreach p $olds {
incr ncleft($p) -1
set k [lsearch -exact $todo $p]
if {$k < 0} {
set todo [linsert $todo $i $p]
set onscreen($p) 0
incr i
incr n
}
}
set nnewparents($id) $n
return 1
}
proc decidenext {{noread 0}} {
global parents children nchildren ncleft todo
global canv canv2 canv3 mainfont namefont canvy linespc
global ncleft todo
global datemode cdate
global commitinfo
global currentparents oldlevel oldnlines oldtodo
global lineno lthickness
# remove the null entry if present
set nullentry [lsearch -exact $todo {}]
if {$nullentry >= 0} {
set todo [lreplace $todo $nullentry $nullentry]
}
# choose which one to do next time around
set todol [llength $todo]
......@@ -1122,73 +1415,43 @@ proc decidenext {{noread 0}} {
return -1
}
# If we are reducing, put in a null entry
if {$todol < $oldnlines} {
if {$nullentry >= 0} {
set i $nullentry
while {$i < $todol
&& [lindex $oldtodo $i] == [lindex $todo $i]} {
incr i
}
} else {
set i $oldlevel
if {$level >= $i} {
incr i
}
}
if {$i < $todol} {
set todo [linsert $todo $i {}]
if {$level >= $i} {
incr level
}
}
}
return $level
}
proc drawcommit {id} {
global phase todo nchildren datemode nextupdate
global startcommits numcommits ncmupdate
global numcommits ncmupdate displayorder todo onscreen
if {$phase != "incrdraw"} {
set phase incrdraw
set todo $id
set startcommits $id
set displayorder {}
set todo {}
initgraph
drawcommitline 0
updatetodo 0 $datemode
} else {
if {$nchildren($id) == 0} {
lappend todo $id
lappend startcommits $id
}
if {$nchildren($id) == 0} {
lappend todo $id
set onscreen($id) 0
}
set level [decidenext 1]
if {$level == {} || $id != [lindex $todo $level]} {
return
}
while 1 {
lappend displayorder [lindex $todo $level]
if {[updatetodo $level $datemode]} {
set level [decidenext 1]
if {$level == {}} break
}
set level [decidenext 1]
if {$level == {} || $id != [lindex $todo $level]} {
return
}
while 1 {
drawslants $level
drawcommitline $level
if {[updatetodo $level $datemode]} {
set level [decidenext 1]
if {$level == {}} break
}
set id [lindex $todo $level]
if {![info exists commitlisted($id)]} {
break
}
if {[clock clicks -milliseconds] >= $nextupdate
&& $numcommits >= $ncmupdate} {
doupdate 1
if {$stopped} break
}
set id [lindex $todo $level]
if {![info exists commitlisted($id)]} {
break
}
}
drawmore 1
}
proc finishcommits {} {
global phase
global startcommits
global canv mainfont ctext maincursor textcursor
if {$phase != "incrdraw"} {
......@@ -1197,9 +1460,7 @@ proc finishcommits {} {
-font $mainfont -tags textitems
set phase {}
} else {
set level [decidenext]
drawslants $level
drawrest $level [llength $startcommits]
drawrest
}
. config -cursor $maincursor
settextcursor $textcursor
......@@ -1217,54 +1478,38 @@ proc settextcursor {c} {
}
proc drawgraph {} {
global nextupdate startmsecs startcommits todo ncmupdate
global nextupdate startmsecs ncmupdate
global displayorder onscreen
if {$startcommits == {}} return
if {$displayorder == {}} return
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr $startmsecs + 100]
set ncmupdate 1
initgraph
set todo [lindex $startcommits 0]
drawrest 0 1
foreach id $displayorder {
set onscreen($id) 0
}
drawmore 0
}
proc drawrest {level startix} {
proc drawrest {} {
global phase stopped redisplaying selectedline
global datemode currentparents todo
global datemode todo displayorder
global numcommits ncmupdate
global nextupdate startmsecs startcommits idline
global nextupdate startmsecs idline
set level [decidenext]
if {$level >= 0} {
set phase drawgraph
set startid [lindex $startcommits $startix]
set startline -1
if {$startid != {}} {
set startline $idline($startid)
}
while 1 {
if {$stopped} break
drawcommitline $level
lappend displayorder [lindex $todo $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 $level
}
if {[clock clicks -milliseconds] >= $nextupdate
&& $numcommits >= $ncmupdate} {
doupdate 0
}
}
drawmore 0
}
set phase {}
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
......@@ -1776,7 +2021,7 @@ proc commit_descriptor {p} {
proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
global lineid linehtag linentag linedtag
global canvy0 linespc parents nparents children nchildren
global canvy0 linespc parents nparents children
global cflist currentid sha1entry
global commentend idtags idline
......@@ -2700,12 +2945,13 @@ proc listboxsel {} {
proc setcoords {} {
global linespc charspc canvx0 canvy0 mainfont
global xspc1 xspc2
global xspc1 xspc2 lthickness
set linespc [font metrics $mainfont -linespace]
set charspc [font measure $mainfont "m"]
set canvy0 [expr 3 + 0.5 * $linespc]
set canvx0 [expr 3 + 0.5 * $linespc]
set lthickness [expr {int($linespc / 9) + 1}]
set xspc1(0) $linespc
set xspc2 $linespc
}
......@@ -3216,6 +3462,7 @@ set textfont {Courier 9}
set findmergefiles 0
set gaudydiff 0
set maxgraphpct 50
set maxwidth 16
set colors {green red blue magenta darkgrey brown orange}
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册