~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
Color:
TYPE ~ ImagerColor.Color;
StripQuotes:
PROC [text:
REF
TEXT] ~ {
Does not handle multi-character escaped things.
i, j: NAT ¬ 0;
UNTIL i = text.length
DO
SELECT text[i]
FROM
'" => { i ¬ i + 1 };
'\\ => { i ¬ i + 1; IF i = text.length THEN ERROR; text[j] ¬ text[i]; i ¬ i+1; j ¬ j+1 };
ENDCASE => { text[j] ¬ text[i]; i ¬ i + 1; j ¬ j + 1 };
ENDLOOP;
text.length ¬ j;
};
Canon:
PROC [rope:
ROPE]
RETURNS [
ROPE] ~ {
RETURN [Atom.GetPName[Atom.MakeAtom[rope]]];
};
ReadAny:
PROC [stream:
IO.
STREAM]
RETURNS [
REF] ~ {
buffer: REF TEXT ¬ NEW[TEXT[80]];
tokenKind: IO.TokenKind;
charsSkipped: INT;
error: IO.TokenError;
stack: LIST OF LIST OF REF ¬ NIL;
head: LIST OF REF ¬ LIST[NIL];
last: LIST OF REF ¬ head;
DO
v: REF ¬ NIL;
[tokenKind, buffer, charsSkipped, error] ¬ IO.GetCedarToken[stream: stream, buffer: buffer, flushComments: FALSE];
SELECT tokenKind
FROM
tokenSINGLE => {
SELECT buffer[0]
FROM
'; => { [] ¬ IO.GetLine[stream, buffer]; LOOP };
'( => {
head.first ¬ last;
stack ¬ CONS[head, stack];
last ¬ head ¬ LIST[NIL];
LOOP;
};
') => {
v ¬ head.rest;
head ¬ stack.first;
stack ¬ stack.rest;
last ¬ NARROW[head.first];
head.first ¬ NIL;
};
ENDCASE => GOTO ParseFailed;
};
tokenDECIMAL => {
v ¬ NEW[CARD ¬ Convert.CardFromRope[RefText.TrustTextAsRope[buffer]]];
};
tokenID => {
v ¬ Atom.MakeAtomFromRefText[buffer];
};
tokenROPE => {
StripQuotes[buffer];
We canonicalize these, because we expect lots of repeats.
v ¬ Atom.GetPName[Atom.MakeAtomFromRefText[buffer]];
};
ENDCASE => GOTO ParseFailed;
IF stack = NIL THEN RETURN [v];
last ¬ last.rest ¬ LIST[v];
ENDLOOP;
EXITS ParseFailed => CommanderOps.Failed[IO.PutFR1["Parse error near %g", [integer[IO.GetIndex[stream]]]]];
};
STCount:
PROC [st:
ST]
RETURNS [
CARD] ~ {
IF st.first = $Merged
THEN {
i: CARD ¬ 0;
FOR tail:
LIST
OF
REF ¬ st.rest, tail.rest
UNTIL tail =
NIL
DO
i ¬ i + STCount[NARROW[tail.first]];
ENDLOOP;
RETURN [i];
};
WITH st.first
SELECT
FROM
c: REF CARD => RETURN [c];
c: REF REF CARD => RETURN [c];
ENDCASE => ERROR;
};
STName:
PROC [st:
ST]
RETURNS [
ROPE] ~ {
RETURN [IF st.first = $Merged THEN "*" ELSE NARROW[st.rest.first]];
};
STEntryPC:
PROC [st:
ST]
RETURNS [
CARD] ~ {
RETURN [IF st.first = $Merged THEN 0 ELSE NARROW[st.rest.rest.first, REF CARD]];
};
STOffset:
PROC [st:
ST]
RETURNS [
CARD] ~ {
RETURN [IF st.first = $Merged THEN 0 ELSE NARROW[st.rest.rest.rest.first, REF CARD]];
};
STChildren:
PROC [st:
ST]
RETURNS [
LIST
OF
REF] ~ {
RETURN [IF st.first = $Merged THEN st.rest ELSE st.rest.rest.rest.rest];
};
STLocalCount:
PROC [st:
ST]
RETURNS [
CARD] ~ {
IF st.first = $Merged
THEN
RETURN [0]
ELSE {
i: CARD ¬ STCount[st];
FOR tail:
LIST
OF
REF ¬ STChildren[st], tail.rest
UNTIL tail =
NIL
DO
i ¬ i - STCount[NARROW[tail.first]];
ENDLOOP;
RETURN [i]
};
};
STDeleted:
PROC [st:
ST]
RETURNS [
BOOL] ~ {
WITH st.first
SELECT
FROM
c: REF CARD => RETURN [FALSE];
c: REF REF CARD => RETURN [TRUE];
ENDCASE => {
FOR tail:
LIST
OF
REF ¬ STChildren[st], tail.rest
UNTIL tail =
NIL
DO
IF NOT STDeleted[NARROW[tail.first]] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]
};
};
STDelete:
PROC [st:
ST] ~ {
IF st.first = $Merged
THEN {
FOR tail:
LIST
OF
REF ¬ STChildren[st], tail.rest
UNTIL tail =
NIL
DO
STDelete[NARROW[tail.first]];
ENDLOOP;
}
ELSE {
WITH st.first
SELECT
FROM
c: REF CARD => st.first ¬ NEW[REF CARD ¬ c];
ENDCASE;
};
};
STUnDelete:
PROC [st:
ST] ~ {
WITH st.first
SELECT
FROM
c: REF REF CARD => st.first ¬ c;
ENDCASE;
FOR tail:
LIST
OF
REF ¬ STChildren[st], tail.rest
UNTIL tail =
NIL
DO
STUnDelete[NARROW[tail.first]];
ENDLOOP;
};
ReadTreeFromFile:
PROC [fileName:
ROPE]
RETURNS [
ST] ~ {
ENABLE PFS.Error => { CommanderOps.Failed[error.explanation] };
stream: IO.STREAM ~ PFS.StreamOpen[PFS.PathFromRope[fileName]];
spyTree: ST ¬ NARROW[ReadAny[stream]];
IO.Close[stream];
RETURN [spyTree]
};
CookedNode: TYPE ~ REF CookedNodeRep;
CookedNodeRep:
TYPE ~
RECORD [
st: ST,
ep: CARD,
name: ROPE,
cumulativeCount: CARD,
localCount: CARD,
counted: BOOL,
mergeTarget: BOOL ¬ FALSE,
mergedNodes: CARD ¬ 0,
mergedCount: CARD ¬ 0,
children: LIST OF CookedNode,
merged: CookedNode ¬ NIL
];
enableName:
ROPE ¬ Canon["SignalsImpl.←XR𡤎nable"];
Control: TYPE ~ { pruneJunk, collapseEnables, collapseSelfRecursion, collapseThreads, unmerged, stackChains };
Controls: TYPE ~ PACKED ARRAY Control OF TrueBool;
TrueBool: TYPE ~ BOOL ¬ TRUE;
controlNames:
ARRAY Control
OF
ATOM ¬ [
pruneJunk: $Junk,
collapseEnables: $Enables,
collapseSelfRecursion: $SelfCalls,
collapseThreads: $Threads,
unmerged: $Merge,
stackChains: $Chains
];
junk:
LIST
OF
ROPE ¬
LIST[
Canon["Threads2.←XR←Yield"],
Canon["sigpause.←sigpause"],
Canon["ThreadsQueues.←XR←WaitCV"],
Canon["ThreadsQueues.←XR←MonitorEntryOutOfLine"],
Canon["ThreadsQueues.←XR←MonitorExitOutOfLine"],
Canon["Threads1.←XR𡤎xitJumpee"],
Canon["ThreadsMachDep.←XR←MonitorEntry"],
Canon["select.←select"],
Canon["sigsetmask.←sigsetmask"],
Canon["ThreadsInlines.←XR𡤌heckReschedRequest"]
];
SetCountedJunk:
PROC [cooked: CookedNode, counted:
BOOL] ~ {
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
SetCountedJunk[tail.first, counted];
ENDLOOP;
FOR tail:
LIST
OF
ROPE ¬ junk, tail.rest
UNTIL tail =
NIL
DO
IF tail.first = cooked.name
THEN {
cooked.counted ¬ counted;
};
ENDLOOP;
};
MergeData: TYPE ~ REF MergeDataRep;
MergeDataRep:
TYPE ~
RECORD [
nest: CARD ¬ 0,
maxNest: CARD ¬ 0,
count: CARD ¬ 0,
max: CookedNode ¬ NIL
];
MergeSimilarNodes:
PROC [root: CookedNode] ~ {
tab: CardTab.Ref ~ CardTab.Create[];
merged: LIST OF CookedNode ¬ NIL;
Get:
PROC [ep:
CARD]
RETURNS [data: MergeData] ~ {
Action: CardTab.UpdateAction ~ {
PROC [found: BOOL, val: Val] RETURNS [op: UpdateOperation ← none, new: Val ← NIL]
IF found
THEN data ¬ NARROW[val]
ELSE { op ¬ store; new ¬ data ¬ NEW[MergeDataRep] }
};
CardTab.Update[tab, ep, Action];
};
Pass1:
PROC [cooked: CookedNode] ~ {
data: MergeData ~ Get[cooked.ep];
data.nest ¬ data.nest + 1;
data.maxNest ¬ MAX[data.nest, data.maxNest];
data.count ¬ data.count + 1;
IF data.max = NIL OR data.max.cumulativeCount < cooked.cumulativeCount THEN data.max ← cooked;
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
Pass1[tail.first];
ENDLOOP;
data.nest ¬ data.nest - 1;
};
Pass2:
PROC [cooked: CookedNode] ~ {
data: MergeData ~ Get[cooked.ep];
IF cooked.ep # 0
AND data.maxNest = 1
AND data.count > 1
THEN {
copy: CookedNode ¬ NEW[CookedNodeRep ¬ cooked];
merged ¬ MergeAdjacentSiblings[MergeLists[merged, LIST[copy]]];
cooked.merged ¬ copy;
cooked.children ¬ NIL;
cooked.localCount ¬ cooked.cumulativeCount;
};
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
Pass2[tail.first];
ENDLOOP;
};
[] ¬ Accumulate[root];
Pass1[root];
Pass2[root];
IF merged #
NIL
THEN {
copy: CookedNode ¬ NEW[CookedNodeRep ¬ root];
FOR tail:
LIST
OF CookedNode ¬ merged, tail.rest
UNTIL tail =
NIL
DO
data: MergeData ~ Get[tail.first.ep];
tail.first.mergedNodes ¬ data.count;
ENDLOOP;
root.children ¬ CONS[copy, merged];
root.localCount ¬ 0;
[] ¬ Accumulate[root];
root.mergedCount ¬ root.cumulativeCount - copy.cumulativeCount;
};
CardTab.Erase[tab];
};
Cook:
PROC [spyTree:
ST, controls: Controls]
RETURNS [CookedNode] = {
cooked: CookedNode ~ ReallyCook[spyTree, controls];
SetCountedJunk[cooked, NOT controls[pruneJunk]];
IF
NOT controls[unmerged]
THEN {
MergeSimilarNodes[cooked];
};
RETURN [cooked]
};
ReallyCook:
PROC [spyTree:
ST, controls: Controls]
RETURNS [CookedNode] = {
ep: CARD ¬ STEntryPC[spyTree];
localCount: CARD ¬ 0;
children: LIST OF CookedNode ¬ NIL;
last: LIST OF CookedNode ¬ NIL;
Adopt:
PROC [new:
LIST
OF CookedNode] ~ {
children ¬ MergeLists[children, new];
last ¬ children;
IF last # NIL THEN UNTIL last.rest = NIL DO last ¬ last.rest ENDLOOP;
};
IF
NOT STDeleted[spyTree]
THEN {
localCount ¬ STLocalCount[spyTree];
FOR tail:
LIST
OF
REF ¬ STChildren[spyTree], tail.rest
UNTIL tail =
NIL
DO
child: CookedNode ¬ ReallyCook[NARROW[tail.first], controls];
SELECT
TRUE
FROM
controls[collapseThreads]
AND (child.ep
MOD 2 # 0) => {
Enable clause - do some merging
Adopt[child.children];
localCount ¬ localCount + child.localCount;
};
controls[collapseEnables]
AND (child.name = enableName
AND child.children #
NIL
AND child.children.rest =
NIL) => {
Enable clause - do some merging
Adopt[child.children.first.children];
localCount ¬ localCount + child.localCount + child.children.first.localCount;
};
controls[collapseSelfRecursion]
AND (child.ep = ep) => {
Direct recursion - collapse into parent.
Adopt[child.children];
localCount ¬ localCount + child.localCount;
};
ENDCASE => {
Normal case
new: LIST OF CookedNode ¬ LIST[child];
IF last = NIL THEN last ¬ children ¬ new ELSE last ¬ last.rest ¬ new;
};
ENDLOOP;
children ¬ MergeAdjacentSiblings[children];
};
RETURN [
NEW[CookedNodeRep ¬ [
st: spyTree,
ep: ep,
name: STName[spyTree],
cumulativeCount: 0, -- filled in later
localCount: localCount,
counted: TRUE,
children: children
]]]
};
MergeSTs:
PROC [a, b:
ST]
RETURNS [
ST] ~ {
aSet: LIST OF REF ~ IF a.first = $Merged THEN NARROW[a.rest] ELSE LIST[a];
bSet: LIST OF REF ~ IF b.first = $Merged THEN NARROW[b.rest] ELSE LIST[b];
RETURN [CONS[$Merged, List.Append[aSet, bSet]]]
};
MergeAdjacentSiblings:
PROC [nodes:
LIST
OF CookedNode]
RETURNS [
LIST
OF CookedNode] ~ {
rest: LIST OF CookedNode ¬ NIL;
FOR tail:
LIST
OF CookedNode ¬ nodes, rest
UNTIL tail =
NIL
DO
rest ¬ tail.rest;
IF rest #
NIL
AND rest.first.ep = tail.first.ep
AND
NOT (tail.first.mergeTarget
AND rest.first.mergeTarget)
THEN {
IF rest.first.mergeTarget
THEN {
Do not lose a mergeTarget!
t: CookedNode ¬ rest.first;
rest.first ¬ tail.first;
tail.first ¬ t;
};
IF rest.first.merged =
NIL
THEN {
tail.first.localCount ¬ tail.first.localCount + rest.first.localCount;
tail.first.children ¬ MergeAdjacentSiblings[MergeLists[tail.first.children, rest.first.children]];
}
ELSE {
IF rest.first.merged = tail.first
THEN {
tail.first.mergedCount ¬ tail.first.mergedCount - MIN[tail.first.mergedCount, tail.first.localCount];
};
};
tail.first.st ¬ MergeSTs[tail.first.st, rest.first.st];
tail.rest ¬ rest.rest;
rest ¬ tail;
};
ENDLOOP;
RETURN [nodes]
};
MergeLists:
PROC [a, b:
LIST
OF CookedNode]
RETURNS [
LIST
OF CookedNode] ~ {
IF a = NIL THEN RETURN[b];
IF b = NIL THEN RETURN[a];
IF a.first.ep <= b.first.ep
THEN RETURN [CONS[a.first, MergeLists[a.rest, b]]]
ELSE RETURN [CONS[b.first, MergeLists[a, b.rest]]]
};
Accumulate:
PROC [cooked: CookedNode]
RETURNS [
CARD] ~ {
Fills in the cumulativeCount fields.
sum: CARD ¬ 0;
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
sum ¬ sum + Accumulate[tail.first];
ENDLOOP;
IF cooked.counted THEN sum ¬ sum + cooked.localCount;
cooked.cumulativeCount ¬ sum;
RETURN [sum - MIN[cooked.mergedCount, sum]]
};
GetReal:
PROC [viewer: ViewerClasses.Viewer, key:
ATOM, default:
REAL]
RETURNS [
REAL] ~ {
IF viewer #
NIL
THEN
WITH ViewerOps.FetchProp[viewer, key]
SELECT
FROM
r: REF REAL => RETURN [r];
ENDCASE;
RETURN [default]
};
ShortenName:
PROC [rope:
ROPE]
RETURNS [
ROPE] ~ {
text: REF TEXT ¬ RefText.AppendRope[to: RefText.ObtainScratch[Rope.Size[rope]], from: rope];
i, j, u, d: NAT ¬ 0;
UNTIL i = text.length
DO
c: CHAR ~ text[i];
IF c = '← THEN {IF i > 0 AND text[i-1] = '. THEN { i ¬ i + 1; LOOP } ELSE u ¬ j };
d ¬ IF c IN ['0..'9] THEN d + 1 ELSE 0;
text[j] ¬ c; i ¬ i + 1; j ¬ j + 1;
ENDLOOP;
text.length ¬ IF u + 2 + d = j AND text[u + 1] = 'P THEN u ELSE j;
rope ¬ Atom.GetPName[Atom.MakeAtomFromRefText[text]];
RefText.ReleaseScratch[text];
RETURN [rope]
};
GrapherFromCooked:
PROC [cooked: CookedNode, data: TreeGrapherViewer.ViewerData, viewer: ViewerClasses.Viewer]
RETURNS [TreeGrapher.Node] = {
textFormat: TreeGrapherViewer.TextFormat ~ TreeGrapherViewer.FindFormat[data, $spynode];
sum: CARD ¬ Accumulate[cooked];
scale: REAL ¬ 200.0/MAX[sum, 1];
threshold: REAL ~ sum*GetReal[viewer, $SpyCutoff, 0.03];
c: REF Controls ~ IF viewer # NIL THEN NARROW[ViewerOps.FetchProp[viewer, $SpyToolControls]] ELSE NIL;
Inner:
PROC [cooked: CookedNode]
RETURNS [n: TreeGrapher.Node] = {
IF cooked.cumulativeCount < threshold
THEN
RETURN [
NIL]
ELSE {
name: ROPE ¬ ShortenName[cooked.name];
children: LIST OF TreeGrapher.Node ¬ NIL;
IF cooked.mergedNodes # 0 THEN name ¬ IO.PutFR["%g *(%g)", [rope[name]], [cardinal[cooked.mergedNodes]]];
IF cooked.merged # NIL THEN name ¬ Rope.Concat[name, "--> *"];
IF cooked.children #
NIL
AND cooked.children.rest =
NIL
AND cooked.localCount = 0
AND (c =
NIL
OR c[stackChains])
THEN {
Collapse long call chains...
n ¬ Inner[cooked.children.first];
IF n #
NIL
THEN {
d: TreeGrapherViewer.TextData ~ NARROW[n.data];
d.clientData ¬ cooked;
d.lines ¬ CONS[name, d.lines];
};
}
ELSE {
clippedCount: CARD ¬ 0;
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
child: TreeGrapher.Node ~ Inner[tail.first];
IF child #
NIL
THEN { children ¬ CONS[child, children] }
ELSE { clippedCount ¬ clippedCount + (tail.first.cumulativeCount - MIN[tail.first.mergedCount, tail.first.cumulativeCount]) };
ENDLOOP;
{
nested: CARD ¬ cooked.cumulativeCount;
Detract:
PROC [otherCount:
CARD]
RETURNS [
CARD] ~
INLINE {
IF otherCount > nested THEN otherCount ¬ 0;
nested ¬ nested - otherCount;
RETURN [otherCount]
};
merged: CARD ~ Detract[cooked.mergedCount];
local: CARD ~ Detract[IF cooked.counted THEN cooked.localCount ELSE 0];
clipped: CARD ~ Detract[clippedCount];
counts: ROPE ~ Rope.Cat["(", Convert.RopeFromCard[cooked.cumulativeCount], "/", Convert.RopeFromCard[sum], ")" ];
n ¬ TreeGrapherViewer.NodeFromText[
lines: LIST[name, counts],
textFormat: textFormat,
fillSizes:
LIST[
REAL[merged]*scale,
REAL[local]*scale,
REAL[clipped]*scale,
REAL[nested]*scale
],
clientData: cooked,
click: data.click];
};
n.children ¬ children;
};
};
};
RETURN [Inner[cooked]]
};
SetCounted:
PROC [cooked: CookedNode, counted:
BOOL] ~ {
FOR tail:
LIST
OF CookedNode ¬ cooked.children, tail.rest
UNTIL tail =
NIL
DO
SetCounted[tail.first, counted];
ENDLOOP;
cooked.counted ¬ counted;
};
MenuClick: ViewerClasses.ClickProc ~ {
PROC [parent: Viewer, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
repaint: BOOL ¬ FALSE;
Inner:
PROC ~ {
ENABLE UNCAUGHT => { Spy.SampleMyStack[]; ViewerOps.BlinkDisplay[]; IF NOT debug THEN CONTINUE };
WITH parent.data
SELECT
FROM
data: TreeGrapherViewer.ViewerData => {
cooked: CookedNode ¬ NARROW[NARROW[data.tree.data, TreeGrapherViewer.TextData].clientData];
tree: TreeGrapher.Node ¬ data.tree;
SetCutoff:
PROC [r:
REAL] ~ {
repaint ¬ TRUE;
ViewerOps.AddProp[parent, $SpyCutoff, NEW[REAL ¬ r]];
};
SELECT clientData
FROM
$UnDelete => {
c: REF Controls ~ NARROW[ViewerOps.FetchProp[parent, $SpyToolControls]];
STUnDelete[cooked.st];
cooked ¬ Cook[cooked.st, c];
repaint ¬ TRUE;
};
$PrevRoot => {
c: REF Controls ~ NARROW[ViewerOps.FetchProp[parent, $SpyToolControls]];
old: LIST OF ST ¬ NARROW[ViewerOps.FetchProp[parent, $SpyPreviousRoot]];
IF old #
NIL
THEN {
ViewerOps.AddProp[parent, $SpyPreviousRoot, old.rest];
cooked ¬ Cook[old.first, c];
repaint ¬ TRUE;
};
};
$C10 => {SetCutoff[0.10]};
$C5 => {SetCutoff[0.05]};
$C3 => {SetCutoff[0.03]};
$C1 => {SetCutoff[0.01]};
$C0 => {SetCutoff[0.00001]}; -- not quite zero, because we want zero counts to vanish.
ENDCASE => {
FOR control: Control
IN Control
DO
IF clientData = controlNames[control]
THEN {
val: BOOL ~ mouseButton # red;
c: REF Controls ~ NARROW[ViewerOps.FetchProp[parent, $SpyToolControls]];
IF c[control] # val
THEN {
c[control] ¬ val;
cooked ¬ Cook[cooked.st, c];
repaint ¬ TRUE;
};
EXIT;
};
ENDLOOP;
};
IF repaint
THEN {
cooked.counted ¬ TRUE;
tree ¬ GrapherFromCooked[cooked, data, parent];
TreeGrapher.DoLayout[tree, data.lp];
data.tree ¬ tree;
data.origin ¬ [1.0-tree.layout.treeBox.xmin, parent.ch/2 - 0.5*(tree.layout.bounds.ymax+tree.layout.bounds.ymin)];
};
};
ENDCASE;
};
ViewerLocks.CallUnderWriteLock[Inner, parent];
IF repaint THEN ViewerOps.PaintViewer[parent, client];
};
TreeClick: ViewerClasses.ClickProc ~ {
PROC [parent: Viewer, clientData: REF ANY ← NIL, mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
repaint: BOOL ¬ FALSE;
normalize: BOOL ¬ FALSE;
input: LIST OF REF ¬ LIST[NIL];
last: LIST OF REF ¬ input;
Inner:
PROC ~ {
ENABLE UNCAUGHT => { Spy.SampleMyStack[]; ViewerOps.BlinkDisplay[]; IF NOT debug THEN CONTINUE };
WITH parent.data
SELECT
FROM
data: TreeGrapherViewer.ViewerData => {
tree: TreeGrapher.Node ¬ data.tree;
root: CookedNode ¬ NARROW[NARROW[data.tree.data, TreeGrapherViewer.TextData].clientData];
WITH clientData
SELECT
FROM
node: TreeGrapher.Node => {
WITH node.data
SELECT
FROM
textData: TreeGrapherViewer.TextData => {
WITH textData.clientData
SELECT
FROM
cooked: CookedNode => {
SELECT
TRUE
FROM
control
AND shift => {
IF cooked # root
THEN {
c: REF Controls ~ NARROW[ViewerOps.FetchProp[parent, $SpyToolControls]];
list: LIST OF ST ¬ NARROW[ViewerOps.FetchProp[parent, $SpyPreviousRoot]];
list ¬ CONS[root.st, list];
ViewerOps.AddProp[parent, $SpyPreviousRoot, list];
normalize ¬ repaint ¬ TRUE;
cooked ¬ Cook[cooked.st, c];
root ¬ cooked;
};
};
control
AND
NOT shift => {
c: REF Controls ~ NARROW[ViewerOps.FetchProp[parent, $SpyToolControls]];
STDelete[cooked.st];
root ¬ Cook[root.st, c];
repaint ¬ TRUE;
};
shift
AND
NOT control => {
dlm: ROPE ¬ " ";
FOR tail:
LIST
OF
ROPE ¬ textData.lines, tail.rest
UNTIL tail =
NIL
DO
last ¬ last.rest ¬ LIST[tail.first];
IF tail.rest # NIL THEN last ¬ last.rest ¬ LIST[dlm];
ENDLOOP;
};
ENDCASE;
};
ENDCASE;
};
ENDCASE;
};
ENDCASE;
IF repaint
THEN {
root.counted ¬ TRUE;
tree ¬ GrapherFromCooked[root, data, parent];
TreeGrapher.DoLayout[tree, data.lp];
data.tree ¬ tree;
IF normalize THEN data.origin ¬ [1.0-tree.layout.treeBox.xmin, parent.ch/2 - 0.5*(tree.layout.bounds.ymax+tree.layout.bounds.ymin)];
};
};
ENDCASE;
};
ViewerLocks.CallUnderWriteLock[Inner, parent];
IF input.rest #
NIL
THEN {
focus: InputFocus.Focus ~ InputFocus.GetInputFocus[];
Inner:
PROC ~ {
ViewerOps.NotifyViewer[focus.owner, input.rest];
};
ViewerLocks.CallUnderWriteLock[Inner, focus.owner];
};
IF repaint THEN ViewerOps.PaintViewer[parent, client];
};
MakeMenu:
PROC
RETURNS [ViewerClasses.Menu] ~ {
menu: ViewerClasses.Menu ¬ Menus.CreateMenu[1];
Item:
PROC [atom:
ATOM] ~ {
Menus.InsertMenuEntry[menu, Menus.CreateEntry[name: Atom.GetPName[atom], proc: MenuClick, clientData: atom]];
};
Item[$UnDelete];
Item[$PrevRoot];
FOR control: Control
DECREASING
IN Control
DO
Item[controlNames[control]];
ENDLOOP;
Item[$C10];
Item[$C5];
Item[$C3];
Item[$C1];
Item[$C0];
RETURN [menu]
};
InitStyle:
PROC [style: RefTab.Ref] ~ {
Def:
PROC [formatName:
ATOM, fontName:
ROPE, textColor: Color ¬ Imager.black, fillColors:
LIST
OF Color ¬
NIL] ~ {
[] ¬ RefTab.Insert[style, formatName,
NEW[TreeGrapherViewer.TextFormatRep ¬ [
font: LIST[Imager.FindFontScaled[fontName, 1]],
textColor: textColor,
fillColors: fillColors,
propList: NIL
]]];
};
Def[
$spynode,
"xerox/tiogafonts/tioga10",
Imager.black,
LIST[
ImagerColor.ColorFromRGB[[0.619,0.861,0.873]], -- light cyan (merged)
ImagerColor.ColorFromRGB[[0.873,0.68,0.619]], -- light orange (local counts)
ImagerColor.ColorFromRGB[[0.659,0.659,0.659]], -- light gray (clipped children)
ImagerColor.ColorFromRGB[[1,1,0.8]] -- very pale yellow (children)
]];
Def[
$spynode,
"xerox/tiogafonts/tioga10",
Imager.black,
LIST[
ImagerColor.ColorFromRGB[[0.94, 0.76, 0.94]], -- violet (merged)
ImagerColor.ColorFromRGB[[0.873,0.68,0.619]], -- light orange (local counts)
ImagerColor.ColorFromRGB[[0.659,0.659,0.659]], -- light gray (clipped children)
ImagerColor.ColorFromRGB[[0.7, 1.0, 1.0]] -- light cyan (children)
]];
};
SpyToolCommand: Commander.CommandProc ~ {
fileName: ROPE ~ CommanderOps.NextArgument[cmd];
IF fileName =
NIL
THEN CommanderOps.Failed[cmd.procData.doc]
ELSE {
data: TreeGrapherViewer.ViewerData ¬ TreeGrapherViewer.NewViewerData[];
spyTree: ST ¬ ReadTreeFromFile[fileName];
cooked: CookedNode ¬ Cook[spyTree, []];
InitStyle[data.style];
data.click ¬ TreeClick;
data.tree ¬ GrapherFromCooked[cooked, data, NIL];
TreeGrapher.DoLayout[data.tree, data.lp];
data.origin ¬ [1.0-data.tree.layout.treeBox.xmin, 1.0-data.tree.layout.treeBox.ymin];
{
v: ViewerClasses.Viewer ¬ ViewerOps.CreateViewer[flavor: $TreeGrapher, info: [name: fileName, hscrollable: TRUE, data: data, menu: MakeMenu[]]];
CommanderOps.PutProp[cmd, $TreeGrapherViewer, v];
ViewerOps.AddProp[v, $SpyToolControls, NEW[Controls ¬ []]];
};
};
};
Commander.Register["SpyTool", SpyToolCommand, "<filename> - create a tool to anaylze data created with SpyStart/SpyStop commands"];