DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName, MakeAtomFromRefText],
IO USING [PutRope, STREAM],
MessageWindow USING [Append],
NodeStyle USING [DataEntry, DataList, Ref],
NodeStyleExtras USING [ConsDataListObject],
NodeStyleWorks USING [bindingDict, StyleError, StyleForFrame],
ProcessProps USING [GetProp],
RefText USING [AppendRope, ObtainScratch, ReleaseScratch],
Rope USING [ActionType, Cat, Fetch, Length, Map, ROPE, Translate],
RuntimeError USING [UNCAUGHT],
TJaM USING [APut, Array, AtomFromRope, Cmd, CommandProc, CvLit, CvX, Def, Dict, Execute, Frame, Load, NewArray, Object, Pop, PopAtom, PopInt, PopReal, PopRope, Push, PushBool, PushInt, PushReal, PushRope, Put, Register, RopeFromAtom, StackIsEmpty, TopType, TryToLoad];

NodeStyleWorks2Impl: CEDAR MONITOR
IMPORTS Ascii, Atom, IO, MessageWindow, NodeStyleExtras, NodeStyleWorks, ProcessProps, RefText, Rope, RuntimeError, TJaM
EXPORTS NodeStyleWorks
~ BEGIN OPEN NodeStyle, NodeStyleWorks;

WhoIsExecuting: PUBLIC SIGNAL RETURNS [executingName: ATOM _ NIL] ~ CODE;
Where: PUBLIC SIGNAL RETURNS [ROPE _ NIL] ~ CODE;

Frame: TYPE ~ TJaM.Frame;
Object: TYPE ~ TJaM.Object;
ROPE: TYPE ~ Rope.ROPE;
GetCommand: PUBLIC PROC [frame: Frame, name: ATOM] RETURNS [TJaM.Cmd] ~ {
known: BOOL _ FALSE;
obj: Object;
[known, obj] _ TJaM.TryToLoad[frame, name];
IF NOT known THEN ERROR;
RETURN [TypeCheckCommand[obj]];
};

ForceLowerName: PUBLIC PROC [n: ATOM] RETURNS [ATOM] ~ {
IF n#NIL THEN {
rope: ROPE ~ Atom.GetPName[n];
CheckLower: Rope.ActionType ~ {quit _ c IN ['A..'Z]};
IF Rope.Map[base: rope, action: CheckLower] THEN {
len: NAT ~ Rope.Length[rope];
text: REF TEXT ~ RefText.ObtainScratch[len];
FOR i: NAT IN[0..len) DO text[i] _ Ascii.Lower[Rope.Fetch[rope, i]] ENDLOOP;
text.length _ len;
n _ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
};
RETURN [n];
};

ForceLowerRope: PUBLIC PROC [r: ROPE] RETURNS [ROPE] ~ {
ForceCharLower: PROC [old: CHAR] RETURNS [new: CHAR] ~ {
RETURN [Ascii.Lower[old]] };
RETURN [Rope.Translate[base: r, translator: ForceCharLower]];
};

PopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM] ~ {
ok: BOOL _ TRUE;
obj: Object _ NIL;
IF TJaM.StackIsEmpty[frame] THEN ok _ FALSE;
IF ok THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [TJaM.PopAtom[frame]];
rope => RETURN [TJaM.AtomFromRope[TJaM.PopRope[frame]]]
ENDCASE => { ok _ FALSE; obj _ TJaM.Pop[frame]; };
IF NOT ok THEN {
TJaM.Push[frame, obj];
TJaM.PushRope[frame, " -- found where a name was expected."];
StyleError[frame, 2];
};
};

TryToPopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [name: TJaM.PopAtom[frame], ok: TRUE];
rope => RETURN [name: TJaM.AtomFromRope[TJaM.PopRope[frame]], ok: TRUE];
ENDCASE;
RETURN[name: NIL, ok: FALSE];
};

TryToPopReal: PUBLIC PROC [frame: Frame] RETURNS [value: REAL, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
number => RETURN [value: TJaM.PopReal[frame], ok: TRUE];
ENDCASE;
RETURN[value: 0, ok: FALSE];
};

TryToPopRope: PUBLIC PROC [frame: Frame] RETURNS [rope: ROPE, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [rope: TJaM.RopeFromAtom[TJaM.PopAtom[frame]], ok: TRUE];
rope => RETURN [rope: TJaM.PopRope[frame], ok: TRUE];
ENDCASE;
RETURN[rope: NIL, ok: FALSE];
};

TypeCheckName: PUBLIC PROC [obj: Object] RETURNS [ATOM] ~ {
WITH obj SELECT FROM
x: ATOM => RETURN [x];
x: ROPE => RETURN [TJaM.AtomFromRope[x]];
ENDCASE;
ERROR;
};

TypeCheckDict: PUBLIC PROC [obj: Object] RETURNS [TJaM.Dict] ~ {
WITH obj SELECT FROM
x: TJaM.Dict => RETURN [x];
ENDCASE;
ERROR;
};

TypeCheckCommand: PUBLIC PROC [obj: Object] RETURNS [TJaM.Cmd] ~ {
WITH obj SELECT FROM
x: TJaM.Cmd => RETURN [x];
ENDCASE;
ERROR;
};

IsCommentOp: TJaM.CommandProc ~ { 
style: Ref _ StyleForFrame[frame];
TJaM.PushBool[frame, style.isComment];
};

IsPrintOp: TJaM.CommandProc ~ { 
style: Ref _ StyleForFrame[frame];
TJaM.PushBool[frame, style.print];
};

NestingLevelOp: TJaM.CommandProc ~ { 
style: Ref _ StyleForFrame[frame];
TJaM.PushInt[frame, style.nestingLevel];
};
StyleParamOp: TJaM.CommandProc ~ {
initialValue: Object _ TJaM.Pop[frame]; -- the initial value
name: ATOM _ PopName[frame]; -- the parameter name
key: ATOM;
array: TJaM.Array;
[key, array] _ SpecialOpArray[name, $SpecialOp];
TJaM.Def[frame, name, TJaM.CvX[array]]; -- store the definition
TJaM.Def[frame, key, initialValue]; -- store the initial value
};

SpecialOpArray: PUBLIC PROC [name: ATOM, op: Object] RETURNS [key: ATOM, array: TJaM.Array] ~ {
key _ StyleParamKey[name];
array _ TJaM.NewArray[2];
TJaM.APut[array, 0, TJaM.CvLit[key]];
TJaM.APut[array, 1, op];
};

StyleParamKey: PUBLIC PROC [name: ATOM] RETURNS [key: ATOM] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[50];
text: REF TEXT _ scratch;
text _ RefText.AppendRope[text, "!!"];
text _ RefText.AppendRope[text, Atom.GetPName[name]];
key _ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[scratch];
};

SpecialOp: TJaM.CommandProc ~ {
aName: BOOL;
name: ATOM;
var: ATOM;
style: Ref _ StyleForFrame[frame];
Error: PROC ~ INLINE {
TJaM.Push[frame, var];
TJaM.PushRope[frame, "has illegal qualifier:"];
TJaM.Push[frame, name];
StyleError[frame, 3];
};
FindObject: PROC RETURNS [Object] ~ INLINE {
FOR x: DataList _ style.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.object => IF xx.name = var THEN RETURN [xx.object];
ENDCASE => NULL;
ENDLOOP;
TJaM.Push[frame, var];
TJaM.Execute[frame, load]; -- get the initial value
RETURN [TJaM.Pop[frame]];
};
Store: PROC [ob: Object] ~ INLINE {
style.dataList _ NodeStyleExtras.ConsDataListObject[var, ob, style.dataList];
};
Load: PROC ~ { TJaM.Push[frame, FindObject[]] };
SetReal: PROC [x: REAL] ~ INLINE {
TJaM.PushReal[frame, x];
Store[TJaM.Pop[frame]];
};
AddReal: PROC [inc: REAL] ~ INLINE {
value: REAL _ 0.0;
Load[];
value _ TJaM.PopReal[frame];
SetReal[value+inc];
};
SetName: PROC [n: ATOM] ~ INLINE {
TJaM.Push[frame, n];
Store[TJaM.Pop[frame]];
};
Percent: PROC [percent: REAL] ~ INLINE {
value: REAL _ 0.0;
Load[];
value _ TJaM.PopReal[frame];
SetReal[(percent*0.01)*value];
};
var _ PopName[frame]; -- the name of the special parameter
[name, aName] _ TryToPopName[frame];
IF NOT aName
THEN Store[TJaM.Pop[frame]] --store the object as new value
ELSE {
SELECT name FROM
$the => Load[];
$bigger => {
[name, aName] _ TryToPopName[frame];
IF NOT aName
THEN AddReal[TJaM.PopReal[frame]]
ELSE IF name = $percent THEN Percent[100+TJaM.PopReal[frame]] ELSE { Error; RETURN };
};
$smaller => {
[name, aName] _ TryToPopName[frame];
IF NOT aName
THEN AddReal[-TJaM.PopReal[frame]]
ELSE IF name = $percent THEN Percent[100-TJaM.PopReal[frame]] ELSE { Error; RETURN };
};
$percent => Percent[TJaM.PopReal[frame]];
ENDCASE => SetName[name];
};
};
RegisterStyleCommand: PUBLIC PROC [frame: Frame, name: ATOM,
proc: TJaM.CommandProc]  ~ {
TJaM.Register[frame, name, proc];
TJaM.Put[bindingDict, name, TJaM.Load[frame, name]];
};

RegisterStyleLiteral: PUBLIC PROC [frame: Frame, name: ATOM] ~ {
TJaM.Put[bindingDict, name, name];
TJaM.Def[frame, name, TJaM.CvLit[name]];
};

GetExecutingName: PROC RETURNS [executingName: ATOM] ~ -- must not be INLINE for PrincOps -- {
executingName _ SIGNAL WhoIsExecuting[];
};

GetWhere: PROC RETURNS [msg: ROPE] ~ -- must not be INLINE for PrincOps -- {
msg _ SIGNAL Where[];
};

ReportStyleErrorOp: TJaM.CommandProc ~ {
num: INT _ TJaM.PopInt[frame];
msg1: ROPE _ NIL;
msg: ROPE _ NIL;
executingName: ATOM _ NIL;
where: ROPE _ NIL;
executingName _ GetExecutingName[ ! RuntimeError.UNCAUGHT => CONTINUE];
where _ GetWhere[ ! RuntimeError.UNCAUGHT => CONTINUE];
msg1 _ Rope.Cat[
"Style error ",
IF executingName # NIL THEN Rope.Cat["in \"", Atom.GetPName[executingName], "\" rule "] ELSE NIL,
IF where # NIL THEN Rope.Cat["at ", where, " in doc "] ELSE NIL,
"- "
];
UNTIL num=0 DO
m: ROPE;
ok: BOOL;
[m, ok] _ TryToPopRope[frame];
IF NOT ok THEN EXIT;
msg _ IF msg = NIL THEN m ELSE Rope.Cat[m, " ", msg];
num _ num-1;
ENDLOOP;
WITH ProcessProps.GetProp[$StdOut] SELECT FROM
errout: IO.STREAM => {
IO.PutRope[errout, "\n *** "];
IO.PutRope[errout, msg1];
IO.PutRope[errout, msg];
IO.PutRope[errout, "\n"];
};
ENDCASE => { MessageWindow.Append[msg1, TRUE]; MessageWindow.Append[msg] };
};

load: PUBLIC TJaM.Cmd;
get: PUBLIC TJaM.Cmd;
run: PUBLIC TJaM.Cmd;

RegisterWorks2: PUBLIC PROC [frame: Frame] ~ {
TJaM.Register[frame, $isComment, IsCommentOp];
TJaM.Register[frame, $isPrint, IsPrintOp];
TJaM.Register[frame, $nestingLevel, NestingLevelOp];
TJaM.Register[frame, $StyleParam, StyleParamOp];
TJaM.Register[frame, $SpecialOp, SpecialOp];
TJaM.Register[frame, $ReportStyleError, ReportStyleErrorOp];
};


END.
hNodeStyleWorks2Impl.mesa
Copyright Σ 1985, 1987 by Xerox Corporation.  All rights reserved.
Written by Bill Paxton, January 1981
Paxton, June 3, 1983 3:35 pm
Maxwell, January 6, 1983 10:05 am
Russ Atkinson, March 7, 1985 3:37:01 am PST
Paul Rovner, August 10, 1983 4:43 pm
Rick Beach, March 28, 1985 9:56:35 am PST
Michael Plass, November 20, 1987 4:54:00 pm PST
Doug Wyatt, September 14, 1986 5:19:50 pm PDT

Support Procs
Readonly Style Variables
StyleParam Implementation
called to declare a special style parameter
create a 2-element array with (name, objectToExecute)
create a key which is "!!name" (sort of unique, don't you think)
like DoStyleOperation, but for special parameters

-- add it to the binding dictionary
-- add it to the binding dictionary
-- add it to the current dictionary
register the various style commands and JaM commands in this module
Κi˜
codeš
œ™Kš
œB™BKš
œ$™$Kš
œ™Kš
œ!™!K™+K™$K™)K™/K™-—K™š
Οk	˜	Kšœœ	˜Kšœœ!˜+Kšœ
œœ˜Kšœœ
˜Kšœ
œ˜+Kšœœ˜+Kšœœ*˜>Kšœ
œ˜Kšœœ-˜:Kšœœ'œ
˜BKšœ
œœ˜Kšœœ‚˜Œ—K˜KšΠblœœ
˜"Kšœœa˜xKšœ˜šœœ
œ˜'K˜KšΟnœœ
œ
œœœœ
˜IšŸœœ
œ
œœœœ
˜1K˜—Kšœœ˜Kšœœ˜Kšœœœ
˜—
headš
œ
™
š
Ÿ
œœ
œœ
œ˜IKšœœœ
˜K˜K˜+Kšœ
œœ
œ
˜Kšœ˜Kš
œ˜K˜—š
Ÿœœœœœ˜8šœœ
œ˜Kšœœ˜KšŸ
œœ˜5šœ*œ˜2Kšœœ˜Kšœœ
œ˜,Kš
œœ
œ	œ,œ
˜LKš
œ˜K˜#K˜K˜—Kš
œ˜—Kšœ˜Kš
œ˜K˜—š
Ÿœœœœœ˜8š
Ÿœœœœœ˜8Kšœ˜—Kšœ7˜=Kš
œ˜K˜—š
Ÿœœ
œœœ˜<Kšœœœ
˜Kšœœ
˜Kšœœœ
˜,šœœ
œ˜*Kšœœ˜%Kšœœ)˜7Kšœœ˜2—šœ
œœ˜K˜K˜=K˜K˜—Kš
œ˜K˜—šŸœœ
œœœœ˜Kš	œ
œœ
œ˜DKšœœ!œ˜5Kšœœ4œ˜HKšœ
˜—Kšœœœ˜š
œ˜K˜——šŸœœ
œœ	œœ˜Lš	œ
œœ
œ˜DKšœ
œ"œ˜8Kšœ
˜—Kšœœ˜š
œ˜K˜——šŸœœ
œœœœ˜Kš	œ
œœ
œ˜DKšœœ4œ˜HKšœœ!œ˜5Kšœ
˜—Kšœœœ˜š
œ˜K˜——š
Ÿ
œœ
œœœ˜;šœœ
˜Kšœœœ˜Kšœœœ˜)Kšœ
˜—Kšœ
˜Kš
œ˜K˜—šŸ
œœ
œœ˜@šœœ
˜Kšœœ˜Kšœ
˜—Kšœ
˜Kš
œ˜K˜—šŸœœ
œœ˜Bšœœ
˜Kšœœ˜Kšœ
˜—Kšœ
˜Kš
œ˜K˜——š
œ™šŸœ˜"K˜"K˜&K˜K˜—šŸ	œ˜ K˜"K˜"K˜K˜—šŸœ˜%K˜"Kš
œ(˜(K˜——™šŸœ˜"Kš
œ+™+Kšœ(Οc˜<Kšœœ ˜2Kšœœ
˜
K˜Kš
œ0˜0Kšœ( ˜?Kšœ$ ˜>K˜K˜—š
Ÿœœœ
œœ˜_K™5K˜Kš
œ˜Kš
œ%˜%Kš
œ˜K˜K˜—šŸ
œœ
œœœœ˜?K™@Kšœ	œ
œ˜.Kšœœ
œ˜K˜&Kš
œ5˜5Kš
œ%˜%K˜ K˜K˜—šŸ	œ˜Kš
œ1™1Kšœœ
˜Kšœœ
˜Kšœœ
˜
K˜"šŸœœœ˜K˜Kš
œ/˜/K˜K˜K˜—šŸ
œœ
œœ˜,šœ&œœ
˜7šœœ
˜Kš	œœœœ
œ
˜EKšœœ
˜—Kšœ
˜—K˜Kšœ ˜3Kšœ˜Kš
œ˜—šŸœœœ˜#Kš
œM˜MK˜—KšŸœœ&˜0šŸœœœœ˜"Kš
œ˜Kš
œ˜Kš
œ˜—šŸœœœœ˜$Kšœœ˜K˜K˜K˜K˜—šŸœœœœ˜"Kš
œ˜Kš
œ˜Kš
œ˜—šŸœœœœ˜(Kšœœ˜K˜K˜K˜K˜—Kšœ $˜:K˜$šœ
œ˜Kšœ ˜;šœ˜šœ˜K˜š
œ˜K˜$šœ
œ˜Kšœ˜!Kš
œ
œœ!œ
œ˜U—Kš
œ˜—š
œ
˜
Kš
œ$˜$šœ
œ˜Kšœ˜"Kš
œ
œœ"œ
œ˜U—Kš
œ˜—K˜)Kšœ˜—Kš
œ˜——K˜K™—šŸœœ
œœ˜YKš
œ!˜!Kš
œ#™#Kš
œ4˜4š
œ˜K˜——šŸœœ
œœ˜@Kš
œ#™#K˜"Kš
œ#™#K˜(K˜K˜—š
Ÿœœ
œœ %œ˜^Kšœœ˜(Kš
œ˜K˜—š
Ÿœœ
œœ %œ˜LKšœœ	˜Kš
œ˜K˜—šŸœ˜(Kšœœ˜Kšœœœ
˜Kšœœœ
˜Kšœœœ
˜Kšœœœ
˜Kšœ1œœ˜GKšœ!œœ˜7š
œ˜Kš
œ˜Kš
œœ
œ=œ
œ
˜aKš
œ	œ
œ$œ
œ
˜@K˜K˜—šœ˜Kšœœ
˜Kšœœ
˜	Kš
œ˜Kšœ
œœ
œ
˜Kš	œœœ
œœ˜5K˜Kšœ
˜—šœœ
˜.šœœ
œ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kš
œ˜—Kšœ!œ˜K—K˜K˜—Kšœœ
˜Kšœœ
˜Kšœœ
˜K˜šŸœœ
œ˜.Kš
œC™CK˜.K˜*K˜4K˜0Kš
œ,˜,K˜<š
œ˜K˜———K˜Kšœ
˜—…—",1ύ