NodeStyleWorks2Impl.mesa
Copyright © 1985 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
Doug Wyatt, March 5, 1985 10:51:57 am PST
Micheal Plass, March 14, 1985 4:26:04 pm PST
Rick Beach, March 19, 1985 5:28:22 pm PST
Support Procs
GetCommand:
PUBLIC
PROC [frame: Frame, name: Name]
RETURNS [command Object] =
TRUSTED {
known: BOOL;
obj: Object;
[known, obj] ← TJaMOps.TryToLoad[frame, name];
IF NOT known THEN ERROR;
RETURN [TypeCheckCommand[obj]];
};
GetObject:
PUBLIC
PROC [frame: Frame, name: Name]
RETURNS [ob: Object] =
TRUSTED {
RETURN [TJaMOps.Load[frame, name]];
};
ForceLowerName:
PUBLIC PROC [n: Name]
RETURNS [Name] =
TRUSTED {
nameObj: Object = NameToObject[n];
name: name Object = WITH x:nameObj SELECT FROM name => x, ENDCASE => ERROR;
str: string Object = TJaMOps.NameToString[name];
ForceChar:
PROC [c:
CHAR]
RETURNS [stop:
BOOL] =
TRUSTED {
string[i] ← IF c IN ['A..'Z] THEN c-'A+'a ELSE c;
i ← i+1;
RETURN [FALSE];
};
string: STRING ← [100];
i: CARDINAL ← 0;
TJaMOps.StringForAll[str, ForceChar];
string.length ← i;
RETURN [TypeCheckName[TJaMOps.MakeName[string, name.tag]]];
};
PushText:
PUBLIC
PROC [frame: Frame, txt:
LONG
STRING] =
TRUSTED {
TJaMOps.Push[frame.opstk, TJaMOps.MakeString[txt]];
};
PushObject:
PUBLIC
PROC [frame: Frame, ob: Object] =
TRUSTED {
TJaMOps.Push[frame.opstk, ob];
};
PopObject:
PUBLIC
PROC [frame: Frame]
RETURNS [Object] =
TRUSTED {
RETURN[TJaMOps.Pop[frame.opstk]];
};
PushName:
PUBLIC
PROC [frame: Frame, name: Name] =
TRUSTED {
TJaMOps.Push[frame.opstk, NameToObject[name]];
};
stringToNameCount: LONG INTEGER ← 0; -- for debugging
PopName:
PUBLIC
PROC [frame: Frame]
RETURNS [Name] =
TRUSTED {
obj: Object ← TJaMOps.Pop[frame.opstk];
WITH x:obj
SELECT
FROM
name => RETURN [LOOPHOLE[x.id]];
string => {
nameObj: name Object ← TJaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
RETURN [LOOPHOLE[nameObj.id]] };
ENDCASE => {
PushText[frame, " -- found where expected a name"L];
PushObject[frame, obj];
StyleError[frame, 2] };
ERROR;
};
TryToPopReal:
PUBLIC
PROC [frame: Frame]
RETURNS [value:
REAL ← 0.0, ok:
BOOL] =
TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN RETURN [0.0, FALSE];
obj ← TJaMOps.Top[frame.opstk];
WITH x:obj
SELECT
FROM
integer => { [] ← PopObject[frame]; RETURN [x.ivalue, TRUE] };
real => { [] ← PopObject[frame]; RETURN [x.rvalue, TRUE] };
ENDCASE => RETURN [0.0, FALSE];
TryToPopString:
PUBLIC
PROC [frame: Frame]
RETURNS [string: string TJaMBasic.Object, ok: BOOL] = TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN { ok ← FALSE; RETURN };
obj ← TJaMOps.Top[frame.opstk];
WITH x:obj
SELECT
FROM
name => { [] ← PopObject[frame]; RETURN [TJaMOps.NameToString[x], TRUE] };
string => { [] ← PopObject[frame]; RETURN [x, TRUE] };
ENDCASE => ok ← FALSE;
TryToPopName:
PUBLIC
PROC [frame: Frame]
RETURNS [name: Name, ok:
BOOL] =
TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN RETURN [NameSymbolTable.nullName, FALSE];
obj ← TJaMOps.Top[frame.opstk];
WITH x:obj
SELECT
FROM
name => { [] ← PopObject[frame]; RETURN [LOOPHOLE[x.id], TRUE] };
string => {
nameObj: name Object ← TJaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
[] ← PopObject[frame];
RETURN [LOOPHOLE[nameObj.id], TRUE] };
ENDCASE => RETURN [NameSymbolTable.nullName, FALSE];
TypeCheckName:
PUBLIC
PROC [obj: Object]
RETURNS [Name] =
TRUSTED {
WITH x:obj
SELECT
FROM
name => RETURN [LOOPHOLE[x.id]];
string => {
nameObj: name Object ← TJaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
RETURN [LOOPHOLE[nameObj.id]] };
ENDCASE;
ERROR;
};
TypeCheckDict:
PUBLIC
PROC
[obj: Object] RETURNS [dict Object] = TRUSTED {
WITH x:obj
SELECT
FROM
dict => RETURN [x];
ENDCASE;
ERROR;
};
TypeCheckCommand:
PUBLIC
PROC
[obj: Object] RETURNS [command Object] = TRUSTED {
WITH x:obj
SELECT
FROM
command => RETURN [x];
ENDCASE;
ERROR;
};
StyleParam Implementation
StyleParamOp:
PROC [frame: Frame] =
TRUSTED {
called to declare a special style parameter
initialValue: Object ← PopObject[frame]; -- the initial value
name: Name ← PopName[frame]; -- the parameter name
key: Name;
array: array Object;
[key, array] ← SpecialOpArray[name, specialOp];
TJaMOps.Def[frame, NameToObject[name], array]; -- store the definition
TJaMOps.Def[frame, NameToObject[key], initialValue]; -- store the initial value
};
SpecialOpArray:
PUBLIC PROC [name: Name, op: Object]
RETURNS [key: Name, array: array Object] =
TRUSTED {
create a 2-element array with (name, objectToExecute)
key ← StyleParamKey[name];
array ← TJaMOps.Array[2]; -- create a 2 element array
array.tag ← X; -- make it executable
TJaMOps.APut[array, 0, CVLit[NameToObject[key]]];
TJaMOps.APut[array, 1, CVX[op]];
};
StyleParamKey:
PUBLIC ENTRY
PROC [name: Name]
RETURNS [key: Name] =
TRUSTED {
create a key which is "!!name" (sort of unique, don't you think)
[I wondered why this uses REF TEXT and not ROPE. RJB]
ENABLE UNWIND => NULL;
text.length ← 0;
NameSymbolTable.FromName[name, text];
FOR i:
NAT
DECREASING
IN [0..text.length)
DO
-- make room for prefix
text[i+2] ← text[i]; ENDLOOP;
text[0] ← text[1] ← '!; -- prefix for keys is double bang
text.length ← text.length+2;
key ← NameSymbolTable.MakeName[LOOPHOLE[text, REF READONLY TEXT]];
};
text: REF TEXT ← NEW[TEXT[64]]; -- to hold the name for StyleParamKey
DefineSpecialOp:
PUBLIC
PROC [frame: Frame, text:
REF
READONLY
TEXT, proc:
PROC [Frame]]
RETURNS [op: Object] =
TRUSTED {
TJaMOps.RegisterExplicit[frame, LOOPHOLE[text, LONG STRING], proc];
PushName[frame, NameSymbolTable.MakeName[text]];
TJaMOps.Execute[frame, load];
op ← PopObject[frame];
};
specialOp: PUBLIC Object;
SpecialOp:
PROC [frame: Frame] = {
like DoStyleOperation, but for special parameters
nameflag: BOOL;
name: Name;
var: Name;
style: Ref ← StyleForFrame[frame];
Error:
PROC = {
PushName[frame, name];
PushText[frame, "has illegal qualifier:"L];
PushName[frame, var];
StyleError[frame, 3];
};
FindObject:
PROC
RETURNS [NameSymbolTable.Object] =
TRUSTED {
FOR x: DataList ← style.dataList, x.next
UNTIL x=
NIL
DO
xx: REF DataEntry.object = NARROW[x];
IF xx.name = var THEN RETURN [xx.object];
ENDLOOP;
PushName[frame, var];
TJaMOps.Execute[frame, load]; -- get the initial value
RETURN [LOOPHOLE[PopObject[frame]]];
};
Store:
PROC [ob: NameSymbolTable.Object] = {
style.dataList ← NEW[DataEntry ← [style.dataList, object[var, ob]]];
};
Load: PROC = { PushObject[frame, LOOPHOLE[FindObject[]]] };
AddReal:
PROC [inc:
REAL] = {
value: REAL;
Load[];
value ← PopReal[frame];
SetReal[value+inc];
};
SetReal:
PROC [x:
REAL] = {
PushReal[frame, x];
Store[LOOPHOLE[PopObject[frame]]];
};
SetName:
PROC [n: Name] = {
PushName[frame, n];
Store[LOOPHOLE[PopObject[frame]]];
};
Percent:
PROC [percent:
REAL] = {
value: REAL;
Load[];
value ← PopReal[frame];
SetReal[(percent/100)*value];
};
var ← PopName[frame]; -- the name of the special parameter
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag
THEN Store[
LOOPHOLE[PopObject[frame]]]
store the object as new value
ELSE
SELECT name
FROM
the => Load[];
bigger =>
BEGIN
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag THEN AddReal[PopReal[frame]]
ELSE IF name=percent THEN Percent[100+PopReal[frame]]
ELSE { Error; RETURN };
END;
smaller =>
BEGIN
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag THEN AddReal[-PopReal[frame]]
ELSE IF name=percent THEN Percent[100-PopReal[frame]]
ELSE { Error; RETURN };
END;
percent => Percent[PopReal[frame]];
ENDCASE => SetName[name];
};
RegisterStyleCommand:
PUBLIC
PROC [frame: Frame, text:
REF
READONLY
TEXT,
proc:
PROC [Frame]]
RETURNS [name: Name] =
TRUSTED {
name ← NameSymbolTable.MakeName[text];
TJaMOps.RegisterExplicit[frame, LOOPHOLE[text, LONG STRING], proc];
-- add it to the binding dictionary
TJaMOps.Put[bindingDict, NameToObject[name], CVX[TJaMOps.Load[frame, NameToObject[name]]]];
RegisterStyleLiteral:
PUBLIC
PROC [frame: Frame, name: Name] =
TRUSTED {
-- add it to the binding dictionary
TJaMOps.Put[bindingDict, name, Atom.GetPName[name]]];
-- add it to the current dictionary
TJaMOps.Def[frame, name, Atom.GetPName[name]]];
};
ReportStyleErrorOp:
PROC [frame: Frame] =
TRUSTED {
num: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
string: string TJaMBasic.Object;
ok: BOOL;
MessageWindow.Clear[];
IF executingName # NameSymbolTable.nullName
THEN {
PushText[frame, "style rule. "L];
PushName[frame, executingName];
PushText[frame, "Error in"L];
num ← num+3;
};
UNTIL num=0
DO
GetChar:
PROC
RETURNS [c:
CHAR] =
TRUSTED {
c ← TJaMVM.GetChar[string, i]; i ← i+1 };
i: CARDINAL;
[string, ok] ← TryToPopString[frame];
IF ~ok THEN EXIT;
i ← 0;
MessageWindow.Append[Rope.FromProc[string.length, GetChar]];
num ← num-1;
IF num # 0 THEN MessageWindow.Append[" "];
ENDLOOP;
};
load: PUBLIC command Object;
get: PUBLIC command Object;
run: PUBLIC command Object;
start: PUBLIC command Object;
StartWorks2:
PUBLIC
PROC =
TRUSTED {
InitLookNames[];
[] ← RegCom[frame, $ReportStyleError, ReportStyleErrorOp];
[] ← RegCom[frame, $StyleName, StyleNameOp];
[] ← RegCom[frame, $StyleRuleDict, StyleRuleDictOp];
[] ← RegCom[frame, $PrintRuleDict, PrintRuleDictOp];
[] ← RegCom[frame, $ScreenRuleDict, ScreenRuleDictOp];
[] ← RegCom[frame, $OpenPrintStyle, OpenPrintStyleOp];
[] ← RegCom[frame, $OpenScreenStyle, OpenScreenStyleOp];
[] ← RegCom[frame, $ResetTestStyle, ResetTestStyleOp];
[] ← RegisterStyleCommand[frame, $BeginStyle, BeginStyleOp];
[] ← RegisterStyleCommand[frame, $EndStyle, EndStyleOp];
[] ← RegisterStyleCommand[frame, $StyleRule, StyleRuleOp];
[] ← RegisterStyleCommand[frame, $PrintRule, PrintRuleOp];
[] ← RegisterStyleCommand[frame, $ScreenRule, ScreenRuleOp];
[] ← RegisterStyleCommand[frame, $AttachStyle, AttachStyleOp];
specialOp ← DefineSpecialOp[frame, $SpecialOp, SpecialOp];
TJaMOps.RegisterExplicit[frame, $StyleParam, StyleParamOp];
TJaMOps.RegisterExplicit[frame, $isComment, IsCommentOp];
TJaMOps.RegisterExplicit[frame, $isPrint, IsPrintOp];
TJaMOps.RegisterExplicit[frame, $nestingLevel, NestingLevelOp];
-- allocate and free some frames to initialize the cache
frame1 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame2 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame3 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame4 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
FreeFrame[frame1, NameSymbolTable.nullName, screen];
FreeFrame[frame2, NameSymbolTable.nullName, screen];
FreeFrame[frame3, NameSymbolTable.nullName, screen];
FreeFrame[frame4, NameSymbolTable.nullName, screen];