DIRECTORY
Ascii USING [Lower],
Atom USING [MakeAtom],
Basics,
Convert USING [RopeFromInt],
EditNotify,
NameSymbolTable,
NodeProps,
NodeStyle,
NodeStyleObsolete USING [EvalFreeVars],
NodeStyleOps,
NodeStyleWorks,
Rope USING [Cat, Concat, Flatten, Text, Translate, ROPE],
TextNode,
TextLooks,
TJaMBasic USING [Object],
TJaMInternal USING [Frame],
TJaMOps USING [Execute, Get];

NodeStyleOpsImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, Basics, Convert, EditNotify, NameSymbolTable, NodeProps, NodeStyle, NodeStyleObsolete, NodeStyleWorks, Rope, TextNode, TJaMOps
EXPORTS NodeStyleOps
= BEGIN OPEN NodeStyle, NodeStyleOps;
Frame: TYPE = TJaMInternal.Frame;
Object: TYPE = TJaMBasic.Object;
Create: PUBLIC PROC RETURNS [Ref] = {
RETURN [NEW[StyleBody]];
};

Copy: PUBLIC PROC [dest, source: Ref] = {
dest^ _ source^;
};

Alloc: PUBLIC ENTRY PROC RETURNS [s: Ref] = {
ENABLE UNWIND => NULL;
IF s3 # NIL THEN { s _ s3; s3 _ NIL }
ELSE IF s2 # NIL THEN { s _ s2; s2 _ NIL }
ELSE IF s1 # NIL THEN { s _ s1; s1 _ NIL }
ELSE s _ Create[];
};
s1, s2, s3: Ref; -- the small cache!

Free: PUBLIC ENTRY PROC [s: Ref] = {
ENABLE UNWIND => NULL;
IF s3 = NIL THEN s3 _ s
ELSE IF s2 = NIL THEN s2 _ s
ELSE IF s1 = NIL THEN s1 _ s;
};

LoadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
frame: Frame _ NodeStyleWorks.GetFrame[NIL, NameSymbolTable.nullName, screen];
[] _ NodeStyleWorks.GetStyleDict[frame, name, screen];
NodeStyleWorks.FreeFrame[frame, NameSymbolTable.nullName, screen];
RETURN [TRUE];
};

DefineStyle: PUBLIC SAFE PROC [name: Name, def: Rope.ROPE]
RETURNS [ok: BOOL] = TRUSTED {
frame: Frame _ NodeStyleWorks.GetFrame[NIL, NameSymbolTable.nullName, screen];
IF def=NIL THEN NodeStyleWorks.BadStyleFile[frame, name]
ELSE [] _ NodeStyleWorks.GetStyleDict[frame, name, screen, def];
NodeStyleWorks.FreeFrame[frame, NameSymbolTable.nullName, screen];
RETURN [TRUE];
};

ReloadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
ForceLowerName: PROC [name: Name] RETURNS [Name] ~ TRUSTED {
RETURN [NameSymbolTable.MakeNameFromRope[
ForceRopeLower[NameSymbolTable.RopeFromName[name]]]];
};
frame: Frame _ NodeStyleWorks.GetFrame[NIL, NameSymbolTable.nullName, screen];
name _ ForceLowerName[name];
ok _ NodeStyleWorks.RunStyle[frame, name];
IF ~ok THEN NodeStyleWorks.BadStyleFile[frame, name];
NodeStyleWorks.FreeFrame[frame, NameSymbolTable.nullName, screen ];
};

defaultStyleRope: Rope.Text;
defaultStyleName: PUBLIC Name;
defaultStylesForExtensions: PUBLIC LIST OF ExtObjPair;

SetDefaultStyle: PUBLIC PROC [name: Rope.ROPE] = TRUSTED {
defaultStyleRope _ Rope.Flatten[name];
defaultStyleName _ NameSymbolTable.MakeName[
LOOPHOLE[Rope.Flatten[ForceRopeLower[defaultStyleRope]]]];
defaultStyle.name[style] _ defaultStyleName;
FlushCaches[];
};

ForceRopeLower: PROC [r: Rope.ROPE] RETURNS [Rope.ROPE] = TRUSTED {
ForceCharLower: SAFE PROC [old: CHAR] RETURNS [new: CHAR] = TRUSTED {
RETURN [Ascii.Lower[old]] };
RETURN [Rope.Translate[base: r, translator: ForceCharLower]];
};

SetExtensionStyles: PUBLIC PROC [value: LIST OF Rope.ROPE] = TRUSTED {
defaultStylesForExtensions _ NIL;
UNTIL value=NIL OR value.rest=NIL DO
ext: ATOM _ Atom.MakeAtom[ForceRopeLower[value.first]]; -- the extension
styleObject: NameSymbolTable.Object _
NameSymbolTable.MakeObject[LOOPHOLE[Rope.Flatten[
Rope.Cat["\"", ForceRopeLower[value.rest.first], "\" style"]]]];
defaultStylesForExtensions _ CONS[[ext, styleObject], defaultStylesForExtensions];
value _ value.rest.rest;
ENDLOOP;
FlushCaches[];
};

localStyleNumber: INT _ 0;
ReadSpecsProc: PROC [name: ATOM, specs: Rope.ROPE] RETURNS [value: REF] = TRUSTED {
GenLocalName: ENTRY PROC RETURNS [gen: Rope.ROPE] = TRUSTED {
localStyleNumber _ localStyleNumber + 1;
gen _ Rope.Concat["LocalStyle-", Convert.RopeFromInt[localStyleNumber]];
};
localStyle: LocalStyle _ NEW[LocalStyleRec];
localStyleName: Rope.ROPE = GenLocalName[];
localStyle.name _ NameSymbolTable.MakeNameFromRope[localStyleName];
localStyle.def _ specs;
[] _ DefineStyle[localStyle.name, specs];
RETURN [localStyle];
};

WriteSpecsProc: PROC [name: ATOM, value: REF] RETURNS [specs: Rope.ROPE] = TRUSTED {
localStyle: LocalStyle _ NARROW[value];
RETURN [IF localStyle=NIL THEN NIL ELSE localStyle.def];
};

CopyInfoProc: PROC [name: ATOM, value: REF] RETURNS [new: REF] = TRUSTED {
RETURN [value] };
defaultStyle: PUBLIC Ref _ NIL;
defaultFormatName: Name;
rootFormatName: Name;

ApplyAll: PUBLIC PROC [ref: Ref, node: TextNode.Ref, kind: OfStyle _ screen] = {
[] _ DoApplyAll[ref, node, kind];
};

DoApplyAll: PROC [ref: Ref, node: TextNode.Ref, kind: OfStyle] RETURNS [depth: CARDINAL] = {
found: BOOL;
parent: TextNode.Ref;
alt: Name;
IF node=NIL THEN { ref^ _ defaultStyle^; RETURN [0] };
[found, depth] _ FindInApplyAllCache[ref, node, kind];
IF found THEN RETURN [depth+1];
parent _ TextNode.Parent[node];
alt _ IF parent=NIL THEN rootFormatName ELSE defaultFormatName;
depth _ DoApplyAll[ref, parent, kind];
ApplyForNode[ref, node, alt, kind];
EnterInApplyAllCache[ref, node, depth];
RETURN [depth+1];
};

ApplyForNode: PUBLIC PROC [ref: Ref, node: TextNode.Ref, alt: Name, kind: OfStyle] = {
text: TextNode.RefTextNode = TextNode.NarrowToTextNode[node];
ext: ATOM;
ref.isComment _ IF text # NIL THEN text.comment ELSE FALSE;
ref.print _ (kind=print);
ref.nestingLevel _ MIN[TextNode.Level[node], MaxNestingLevel];
NodeStyleObsolete.EvalFreeVars[ref, node];
IF node.hasstyledef THEN {
localStyle: LocalStyle _ NARROW[NodeProps.GetProp[node, $StyleDef]];
IF localStyle # NIL THEN ref.name[style] _ localStyle.name;
};
IF node.hasprefix THEN ApplyObject[ref, NodeProps.GetPrefixObject[node], kind]
ELSE IF ref.nestingLevel=0 -- root node -- AND -- check for file extension default
(ext _ NARROW[NodeProps.GetProp[node, $FileExtension]])#NIL THEN
FOR list: LIST OF ExtObjPair _ defaultStylesForExtensions, list.rest UNTIL list=NIL DO
IF list.first.fileExtension # ext THEN LOOP;
ApplyObject[ref, list.first.styleObject, kind];
EXIT;
ENDLOOP;
ApplyFormat[ref, node.formatName, alt, kind];
IF node.haspostfix THEN ApplyObject[ref, NodeProps.GetPostfixObject[node], kind];
};

applyCacheInfo: REF ApplyCacheRecord _ NEW[ApplyCacheRecord];
ApplyCacheRecord: TYPE = RECORD [
applyCacheDepth: CARDINAL _ 0,  -- next free entry
applyCacheResults: REF ApplyCacheResults,
applyCacheNodes: REF ApplyCacheNodes,
applyCacheProbes, applyCacheHits, applyCacheSaves: INT _ 0 ];
applyCacheSize: CARDINAL = 8; -- number of levels deep in tree
ApplyCacheNodes: TYPE = ARRAY [0..applyCacheSize) OF TextNode.Ref;
ApplyCacheResults: TYPE = ARRAY [0..applyCacheSize) OF StyleBody; 

InitApplyCacheRecord: PROC = { OPEN applyCacheInfo;
applyCacheResults _ NEW[ApplyCacheResults];
applyCacheNodes _ NEW[ApplyCacheNodes];
};

RemoveAllFromApplyAllCache: PUBLIC PROC = { FlushApplyAllCache[] };

FlushApplyAllCache: PUBLIC ENTRY PROC [init: BOOL _ FALSE] = {
ENABLE UNWIND => NULL;
ClearApplyAllCache[init];
};

ClearApplyAllCache: PROC [init: BOOL] = {
OPEN applyCacheInfo;
nodes: REF ApplyCacheNodes _ applyCacheNodes;
FOR i:CARDINAL IN [0..applyCacheSize) DO nodes[i] _ NIL; ENDLOOP;
applyCacheDepth _ 0;
};

RemoveNodeFromApplyAllCache: PUBLIC ENTRY PROC [node: TextNode.Ref] = {
OPEN applyCacheInfo;
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCacheNodes;
FOR i:CARDINAL IN [0..applyCacheDepth) DO 
IF nodes[i]=node THEN { -- clear from here on
FOR j:CARDINAL IN [i..applyCacheSize) DO
nodes[j] _ NIL; ENDLOOP;
applyCacheDepth _ i; EXIT };
ENDLOOP;
};

FindInApplyAllCache: ENTRY PROC [ref: Ref, node: TextNode.Ref, kind: OfStyle] 
RETURNS [found: BOOL, depth: CARDINAL] = {
OPEN applyCacheInfo;
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCacheNodes;
print: BOOL = (kind=print); -- if true, then find result with print true also
applyCacheProbes _ applyCacheProbes+1;
FOR i:CARDINAL DECREASING IN [0..applyCacheDepth) DO
IF nodes[i]=node AND print=applyCacheResults[i].print THEN { -- found it
applyCacheHits _ applyCacheHits+1;
applyCacheSaves _ applyCacheSaves+i+1;
ref^ _ applyCacheResults[i];
RETURN [TRUE, i] };
ENDLOOP;
RETURN [FALSE, 0];
};

EnterInApplyAllCache: ENTRY PROC [ref: Ref, node: TextNode.Ref, depth: CARDINAL] = {
OPEN applyCacheInfo;
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCacheNodes;
IF depth >= applyCacheSize THEN RETURN;
nodes[depth] _ node;
applyCacheResults[depth] _ ref^;
FOR i:CARDINAL IN [depth+1..applyCacheSize) DO nodes[i] _ NIL; ENDLOOP;
applyCacheDepth _ depth+1;
};

prefixAtom: ATOM = NodeProps.PrefixAtom[];
postfixAtom: ATOM = NodeProps.PostfixAtom[];

Notify: PROC [change: REF READONLY EditNotify.Change] = TRUSTED {
DoNode: PROC [node: TextNode.Ref] = TRUSTED {
IF TextNode.FirstChild[node] # NIL THEN FlushApplyAllCache
ELSE RemoveNodeFromApplyAllCache[node] };
WITH x:change SELECT FROM
InsertingNode => IF TextNode.FirstChild[x.new] # NIL THEN FlushApplyAllCache;
MovingNodes => FlushApplyAllCache;
NodeNesting => IF x.first = x.last -- only changing one node
AND TextNode.FirstChild[x.first] = NIL -- node has no children
THEN SELECT x.change FROM
1 => -- increasing nesting in tree
IF TextNode.Next[x.first] = NIL THEN RemoveNodeFromApplyAllCache[x.first]
ELSE FlushApplyAllCache;
-1 => -- decreasing nesting in tree
RemoveNodeFromApplyAllCache[x.first];
ENDCASE => FlushApplyAllCache
ELSE FlushApplyAllCache;
ChangingFormat => DoNode[x.node];
ChangingProp => SELECT x.propAtom FROM
prefixAtom, postfixAtom, $Comment, $StyleDef => DoNode[x.node];
ENDCASE;
ENDCASE => ERROR; -- not expecting notify for any other kinds of changes
};

ApplyFormat: PUBLIC PROC [ref: Ref, name, alt: Name, kind: OfStyle _ screen] = {
OPEN ruleCacheInfo;
names: REF RuleCacheNames _ ruleCacheNames;
inputs: REF RuleCacheBodies _ ruleCacheInputs;
input: StyleBody;
initloc, loc: CARDINAL;
FindInRuleCache: ENTRY PROC RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
ruleCacheProbes _ ruleCacheProbes+1;
DO -- search cache
SELECT names[loc] FROM
name => IF inputs[loc] = ref^ THEN {
ref^ _ ruleCacheResults[loc];
ruleCacheHits _ ruleCacheHits+1;
RETURN [TRUE] };
TextNode.nullFormatName => RETURN [FALSE]; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
ruleCacheSize => IF (loc _ 0)=initloc THEN RETURN [FALSE];
initloc => RETURN [FALSE];
ENDCASE;
ENDLOOP;
};
PutInRuleCache: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF ruleCacheCount = ruleCacheMax THEN ClearRuleCache[];
loc _ initloc;
DO -- search cache for place to put the entry
SELECT names[loc] FROM
name => IF inputs[loc] = input THEN RETURN; -- already in cache
TextNode.nullFormatName => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
ruleCacheSize => IF (loc _ 0)=initloc THEN ERROR; -- cache full
initloc => ERROR; -- cache full
ENDCASE;
ENDLOOP;
ruleCacheCount _ ruleCacheCount+1;
inputs[loc] _ input;
ruleCacheResults[loc] _ ref^;
names[loc] _ name;
};
IF name = TextNode.nullFormatName AND
(name _ alt) = TextNode.nullFormatName THEN RETURN;
loc _ initloc _ Basics.BITXOR[LOOPHOLE[name, CARDINAL], HashStyle[ref]] MOD ruleCacheSize;
IF FindInRuleCache[] THEN RETURN;
input _ ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteNameInStyle[ref, kind, name]
THEN PutInRuleCache[]
ELSE IF name # alt THEN ApplyFormat[ref, alt, TextNode.nullFormatName];
};

ruleCacheInfo: REF RuleCacheInfoRecord _ NEW[RuleCacheInfoRecord];
RuleCacheInfoRecord: TYPE = RECORD [
ruleCacheCount: CARDINAL _ 0, -- number of entries currently in use
ruleCacheNames: REF RuleCacheNames,
ruleCacheInputs: REF RuleCacheBodies,
ruleCacheResults: REF RuleCacheBodies,
ruleCacheProbes, ruleCacheHits: INT _ 0
];
ruleCacheSize: CARDINAL = 64; -- should be a power of 2
ruleCacheMax: CARDINAL = (ruleCacheSize*4)/5; -- don't fill too full
RuleCacheNames: TYPE = ARRAY [0..ruleCacheSize) OF TextNode.FormatName;
RuleCacheBodies: TYPE = ARRAY [0..ruleCacheSize) OF StyleBody;

InitRuleCacheInfo: PROC = {
OPEN ruleCacheInfo;
ruleCacheNames _ NEW[RuleCacheNames];
ruleCacheInputs _ NEW[RuleCacheBodies];
ruleCacheResults _ NEW[RuleCacheBodies];
};

FlushRuleCache: ENTRY PROC [init: BOOL _ FALSE] = {
ENABLE UNWIND => NULL;
ClearRuleCache[];
};

ClearRuleCache: PROC [init: BOOL _ FALSE] = {
OPEN ruleCacheInfo;
names: REF RuleCacheNames _ ruleCacheNames;
IF ~init AND ruleCacheCount = 0 THEN RETURN;
ruleCacheCount _ 0;
FOR i: CARDINAL IN [0..ruleCacheSize) DO names[i] _ TextNode.nullFormatName; ENDLOOP;
};

HashStyle: PROC [ref: Ref] RETURNS [CARDINAL] = { 
RETURN [LOOPHOLE[
Basics.BITXOR[LOOPHOLE[ref.name[style]],
Basics.BITXOR[LOOPHOLE[ref.name[fontFamily], CARDINAL],
Basics.BITXOR[ref.real[fontSize],
Basics.BITXOR[ref.real[leftIndent],
ref.real[leading]]]]], CARDINAL]];
};

ApplyLooks: PUBLIC PROC [ref: Ref, looks: TextLooks.Looks, kind: OfStyle] = {
OPEN looksCacheInfo;
lks: REF LooksCacheLooks _ looksCacheLooks;
inputs: REF LooksCacheBodies _ looksCacheInputs;
initloc, loc: CARDINAL;
input: StyleBody;

FindInLooksCache: ENTRY PROC RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
looksCacheProbes _ looksCacheProbes+1;
DO -- search cache
SELECT lks[loc] FROM
looks => IF inputs[loc] = ref^ THEN {
ref^ _ looksCacheResults[loc];
looksCacheHits _ looksCacheHits+1;
RETURN [TRUE] };
TextLooks.noLooks => RETURN [FALSE]; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
looksCacheSize => IF (loc _ 0)=initloc THEN RETURN [FALSE];
initloc => RETURN [FALSE];
ENDCASE;
ENDLOOP;
};

PutInLooksCache: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF looksCacheCount = looksCacheMax THEN ClearLooksCache[];
loc _ initloc;
DO -- search cache
SELECT lks[loc] FROM
looks => IF inputs[loc] = input THEN RETURN; -- already in cache
TextLooks.noLooks => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
looksCacheSize => IF (loc _ 0)=initloc THEN ERROR; -- cache full
initloc => ERROR; -- cache full
ENDCASE;
ENDLOOP;
looksCacheResults[loc] _ ref^;
lks[loc] _ looks;
inputs[loc] _ input;
looksCacheCount _ looksCacheCount+1;
};

IF looks = TextLooks.noLooks THEN RETURN;
loc _ initloc _
Basics.BITXOR[LOOPHOLE[looks, TextLooks.LooksBytes].byte0,
Basics.BITXOR[LOOPHOLE[looks, TextLooks.LooksBytes].byte1,
Basics.BITXOR[LOOPHOLE[looks, TextLooks.LooksBytes].byte2,
HashStyle[ref]]]] MOD looksCacheSize;
IF FindInLooksCache[] THEN RETURN;
input _ ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteLooksInStyle[ref, kind, looks] THEN PutInLooksCache[];
};

looksCacheInfo: REF LooksCacheInfoRecord _ NEW[LooksCacheInfoRecord];
LooksCacheInfoRecord: TYPE = RECORD [
looksCacheCount: CARDINAL _ 0,
looksCacheLooks: REF LooksCacheLooks,
looksCacheInputs: REF LooksCacheBodies,
looksCacheResults: REF LooksCacheBodies,
looksCacheProbes, looksCacheHits: INT _ 0
];
looksCacheSize: CARDINAL = 16; -- should be a power of 2
looksCacheMax: CARDINAL = (looksCacheSize*4)/5; -- don't fill too full
LooksCacheLooks: TYPE = ARRAY [0..looksCacheSize) OF TextLooks.Looks;
LooksCacheBodies: TYPE = ARRAY [0..looksCacheSize) OF StyleBody;

InitLooksCacheInfo: PROC = {
OPEN looksCacheInfo;
looksCacheLooks _ NEW[LooksCacheLooks];
looksCacheInputs _ NEW[LooksCacheBodies];
looksCacheResults _ NEW[LooksCacheBodies];
};

FlushLooksCache: ENTRY PROC [init: BOOL _ FALSE] = {
ENABLE UNWIND => NULL;
ClearLooksCache[];
};

ClearLooksCache: PROC [init: BOOL _ FALSE] = {
OPEN looksCacheInfo;
IF ~init AND looksCacheCount = 0 THEN RETURN;
looksCacheCount _ 0;
FOR i: CARDINAL IN [0..looksCacheSize) DO looksCacheLooks[i] _ TextLooks.noLooks; ENDLOOP;
};

ApplyObject: PUBLIC PROC [ref: Ref, object: NameSymbolTable.Object,
kind: OfStyle _ screen] = {
OPEN objectCacheInfo;
objects: REF ObjectCacheObjects _ objectCacheObjects;
inputs: REF ObjectCacheBodies _ objectCacheInputs;
input: StyleBody;
initloc, loc: CARDINAL;
obj: Object _ LOOPHOLE[object];
FindInObjectCache: ENTRY PROC RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
objectCacheProbes _ objectCacheProbes+1;
DO -- search cache
SELECT objects[loc] FROM
object => IF inputs[loc] = ref^ THEN {
ref^ _ objectCacheResults[loc];
objectCacheHits _ objectCacheHits+1;
RETURN [TRUE] };
nullObject => RETURN [FALSE]; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
objectCacheSize => IF (loc _ 0)=initloc THEN RETURN [FALSE];
initloc => RETURN [FALSE];
ENDCASE;
ENDLOOP;
};
PutInObjectCache: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF objectCacheCount = objectCacheMax THEN ClearObjectCache[];
loc _ initloc;
DO -- search cache for place to put the entry
SELECT objects[loc] FROM
object => IF inputs[loc] = input THEN RETURN; -- already in cache
nullObject => EXIT; -- this is an unused entry
ENDCASE;
SELECT (loc _ loc+1) FROM
objectCacheSize => IF (loc _ 0)=initloc THEN ERROR; -- cache full
initloc => ERROR; -- cache full
ENDCASE;
ENDLOOP;
objectCacheCount _ objectCacheCount+1;
inputs[loc] _ input;
objectCacheResults[loc] _ ref^;
objects[loc] _ object;
};
HashObject: PROC RETURNS [CARDINAL] = {
ob: RECORD [ a, b, c, d: CARDINAL ] _ LOOPHOLE[object];
RETURN [ob.b];
};
IF object = nullObject THEN RETURN;
loc _ initloc _ Basics.BITXOR[HashObject[], HashStyle[ref]] MOD objectCacheSize;
IF FindInObjectCache[] THEN RETURN;
IF NodeStyleWorks.ExecuteObjectInStyle[ref, kind, obj] THEN PutInObjectCache[];
};

objectCacheInfo: REF ObjectCacheInfoRecord _ NEW[ObjectCacheInfoRecord];
ObjectCacheInfoRecord: TYPE = RECORD [
objectCacheCount: CARDINAL,
objectCacheObjects: REF ObjectCacheObjects,
objectCacheInputs: REF ObjectCacheBodies,
objectCacheResults: REF ObjectCacheBodies,
objectCacheProbes, objectCacheHits: INT _ 0
];

objectCacheSize: CARDINAL = 16; -- should be a power of 2
objectCacheMax: CARDINAL = (objectCacheSize*4)/5; -- don't fill too full
ObjectCacheObjects: TYPE = ARRAY [0..objectCacheSize) OF NameSymbolTable.Object;
ObjectCacheBodies: TYPE = ARRAY [0..objectCacheSize) OF StyleBody;

nullObject: NameSymbolTable.Object = NameSymbolTable.NullObject[];

InitObjectCacheInfo: PROC = {
OPEN objectCacheInfo;
objectCacheObjects _ NEW[ObjectCacheObjects];
objectCacheInputs _ NEW[ObjectCacheBodies];
objectCacheResults _ NEW[ObjectCacheBodies];
};

FlushObjectCache: ENTRY PROC [init: BOOL _ FALSE] = {
ENABLE UNWIND => NULL;
ClearObjectCache[];
};

ClearObjectCache: PROC [init: BOOL _ FALSE] = {
OPEN objectCacheInfo;
IF ~init AND objectCacheCount = 0 THEN RETURN;
objectCacheCount _ 0;
FOR i: CARDINAL IN [0..objectCacheSize) DO objectCacheObjects[i] _ nullObject; ENDLOOP;
};

FlushCaches: PUBLIC ENTRY PROC = {
ENABLE UNWIND => NULL;
ClearCaches[FALSE];
};

ClearCaches: PROC [init: BOOL] = {
ClearApplyAllCache[init];
ClearRuleCache[init];
ClearLooksCache[init];
ClearObjectCache[init];
};

nonNumeric: PUBLIC ERROR = CODE;

GetSpecial: PUBLIC PROC [s: Ref, name: Name] RETURNS [r: REAL] = {
obj: Object = GetSpecialObj[s, name];
WITH x:obj SELECT FROM
real => r _ x.rvalue;
integer => r _ x.ivalue;
ENDCASE => ERROR nonNumeric;
};

GetSpecialI: PUBLIC PROC [s: Ref, name: Name] RETURNS [val: INTEGER] = {
obj: Object = GetSpecialObj[s, name];
WITH x:obj SELECT FROM
real => val _ IntegerValue[x.rvalue];
integer => val _ x.ivalue;
ENDCASE => ERROR nonNumeric;
};

GetSpecialObj: PUBLIC PROC [s: Ref, name: Name] RETURNS [obj: Object] = TRUSTED {
key: Name _ NodeStyleWorks.StyleParamKey[name];
FOR x: DataList _ s.dataList, x.next UNTIL x=NIL DO
xx: REF DataEntry.object = NARROW[x];
IF xx.name = key THEN RETURN [LOOPHOLE[xx.object]];
ENDLOOP;
RETURN [TJaMOps.Get[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[key]]];
};

GetStyleParam: PUBLIC PROC [s: Ref, name: Name, styleName: Name, kind: OfStyle]
RETURNS [val: REAL] = TRUSTED {
obj: Object _ GetStyleParamObj[s, name, styleName, kind];
WITH x:obj SELECT FROM
real => val _ x.rvalue;
integer => val _ x.ivalue;
ENDCASE => ERROR nonNumeric;
RETURN [val];
};

GetStyleParamI: PUBLIC PROC [s: Ref, name: Name, styleName: Name, kind: OfStyle]
RETURNS [val: INTEGER] = TRUSTED {
obj: Object _ GetStyleParamObj[s, name, styleName, kind];
WITH x:obj SELECT FROM
real => val _ IntegerValue[x.rvalue];
integer => val _ x.ivalue;
ENDCASE => ERROR nonNumeric;
RETURN [val];
};

GetStyleParamObj: PUBLIC PROC [s: Ref, name: Name, styleName: Name, kind: OfStyle]
RETURNS [obj: Object] = TRUSTED {
frame: Frame;
key: Name _ NodeStyleWorks.StyleParamKey[name];
FOR x: DataList _ s.dataList, x.next UNTIL x=NIL DO
xx: REF DataEntry.object = NARROW[x];
IF xx.name = key THEN RETURN [LOOPHOLE[xx.object]];
ENDLOOP;
frame _ NodeStyleWorks.GetFrame[s, styleName, kind];
NodeStyleWorks.PushName[frame, key];  
TJaMOps.Execute[frame, NodeStyleWorks.load]; -- get the initial value
obj _ LOOPHOLE[NodeStyleWorks.PopObject[frame]];
NodeStyleWorks.FreeFrame[frame, styleName, kind];
RETURN [obj];
};

StyleNameForNode: PUBLIC PROC [node: TextNode.Ref] RETURNS [name: Name] = {
s: Ref _ Alloc[];
ApplyAll[s, node];
name _ GetStyleName[s];
Free[s];
};

Start: PUBLIC PROC = {
changeSet: EditNotify.ChangeSet;
PointsPerInch: REAL = 1.0/0.0138370;

changeSet[ChangingProp] _ TRUE;
changeSet[ChangingFormat] _ TRUE;
changeSet[MovingNodes] _ TRUE;
changeSet[NodeNesting] _ TRUE;
changeSet[InsertingNode] _ TRUE;
EditNotify.AddNotifyProc[Notify, after, high, changeSet];

InitApplyCacheRecord[];
InitRuleCacheInfo[];
InitLooksCacheInfo[];
InitObjectCacheInfo[];
ClearCaches[TRUE];

defaultStyle _ Create[];
defaultFormatName _ NameSymbolTable.MakeName["default"];
rootFormatName _ NameSymbolTable.MakeName["root"];

SetDefaultStyle["Cedar"];  -- wired in default
defaultStyle.name[fontFamily] _ NameSymbolTable.MakeName["Helvetica"];
SetReal[defaultStyle, fontSize, 10];
SetReal[defaultStyle, leading, 12];
SetReal[defaultStyle, tabStops, 4];
SetReal[defaultStyle, pageWidth, 8.5*PointsPerInch];
SetReal[defaultStyle, pageLength, 11*PointsPerInch];
SetReal[defaultStyle, leftMargin, 1*PointsPerInch];
SetReal[defaultStyle, rightMargin, 1*PointsPerInch];
SetReal[defaultStyle, topMargin, 1*PointsPerInch];
SetReal[defaultStyle, bottomMargin, 1*PointsPerInch];
SetReal[defaultStyle, lineLength, 6.5*PointsPerInch];

[] _ LoadStyle[defaultStyleName];

NodeProps.Register[name: $StyleDef, 
reader: ReadSpecsProc, writer: WriteSpecsProc, copier: CopyInfoProc];
};

Start[];
END.
<NodeStyleOpsImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
written by Bill Paxton, January 1981
Paxton, December 21, 1982 9:55 am
Maxwell, January 6, 1983 9:50 am
Doug Wyatt, March 5, 1985 10:53:24 am PST
Russ Atkinson, March 7, 1985 3:29:21 am PST
Michael Plass, March 14, 1985 1:35:49 pm PST
Rick Beach, March 19, 1985 12:20:30 pm PST


Style Operations
create a style body
copy a style body
get from a small cache 
don't free more than once or disaster!
Local Styles
Apply Style to Node
ApplyAll Cache
-- when clearing, go all the way to applyCacheSize rather than stopping at applyCacheDepth
Update ApplyAll Cache due to Editing Operations
if change invalidates one node only, remove that node
else clear entire cache
Style Rule Cache
Looks Cache
Object Cache
Flush Caches
Special Parameter Extensions
Style Parameter Extensions
Miscellaneous
Does an ApplyAll and then returns the style name
Initialization (must be done after NodeStyleWorks)
register the notify proc that updates the style caches when edits occur
initialize all the style caches
establish the default styles wired into Tioga
provide some basic style attribute values in case no style gets loaded successfully
expect to find Cedar.style when Tioga is loaded
register the special handling procedures for the local style property: StyleDef

Κe˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ$™$Kš
œ!™!K™ K™)K™+K™,J™*—K™š
Οk	˜	Kšœžœ	˜Kšœžœ˜K˜Kšœžœ˜K˜K˜K˜
K˜
Kšœžœ˜'K˜
K˜Kšœžœ)žœ˜9K˜	K˜
Kšœ
žœ
˜Kšœ
žœ	˜Kšœžœ˜—K˜KšΠblœžœ
ž˜KšžœŒ
˜“
Kšžœ
˜šœžœ
žœ˜%K™Kšœžœ˜!Kšœžœ˜ —
headš
œ™šΟnœžœ
žœ
žœ
˜%Kš
œ™Kšžœžœ
˜Kš
œ˜K˜—š œžœ
žœ˜)Kš
œ™K˜K˜K˜—š
 œžœ
žœ
žœ
žœ
˜-Kš
œ™Kšžœ
žœžœ
˜Kšžœžœ
žœžœ˜%Kš
žœ
žœžœ
žœžœ˜*Kš
žœ
žœžœ
žœžœ˜*Kšžœ˜Kš
œ˜—KšœΟc˜$K˜š œžœ
žœ
žœ
˜$Kš
œ&™&Kšžœ
žœžœ
˜Kšžœžœ
žœ˜Kšžœ
žœžœ
žœ˜Kšžœ
žœžœ
žœ˜Kš
œ˜K˜—š 	œžœ
žœ
žœžœžœžœ˜GKšœ'žœ$˜NK˜6K˜BKšžœžœ˜Kš
œ˜K˜—š œžœ
žœ
žœžœžœžœžœ˜YKšœ'žœ$˜NKšžœžœ
žœ)˜8Kšžœ<˜@K˜BKšžœžœ˜Kš
œ˜K˜—š œžœ
žœ
žœžœžœžœ˜Iš œžœžœ
žœ˜<JšžœY˜_J˜—Kšœ'žœ$˜NK˜K˜*Kšžœžœ*˜5K˜CK˜K˜——™K˜Kšœžœ˜Kšœžœ
žœ
žœ˜6K˜š
 œžœ
žœ
žœžœ˜:Kš
œ&˜&Kšœ,ž	œ2˜gK˜,Kš
œ˜Kš
œ˜K˜—š œžœ
žœžœžœžœ˜Cš œžœ
žœžœžœžœžœ˜EKšžœ˜—Kšžœ7˜=Kš
œ˜K˜—š œžœ
žœ	žœ
žœžœžœ˜FKšœžœ
˜!š	žœžœ
žœžœ
ž˜$Kšœžœ/‘˜HKšœAžœO˜˜
Kšœžœ1˜RK˜Kšžœ
˜—Kš
œ˜Kš
œ˜K˜—Kšœžœ˜š 
œžœžœžœžœ	žœžœ˜Sš œžœ
žœ
žœžœžœ˜=Kš
œ(˜(Kš
œH˜HK˜—Kšœžœ˜,Kšœžœ˜+Kš
œC˜CK˜Kš
œ)˜)Kšžœ˜Kš
œ˜—K˜š œžœžœ	žœžœžœžœ˜TKšœžœ˜'Kšžœžœžœ
žœ
žœ
žœ˜8Kš
œ˜—K˜š œžœžœ	žœžœžœžœ˜JKšžœ˜——š
œ™Kšœžœžœ
˜K˜K˜K˜š œžœ
žœ;˜PK˜!K˜K˜—š 
œžœ/žœ	žœ˜\Kšœžœ
˜K˜K˜
Kšžœžœ
žœžœ˜6K˜6Kšžœžœ
žœ˜K˜Kš	œžœžœ
žœžœ˜?K˜&K˜#K˜'Kšžœ˜Kš
œ˜K˜—š œžœ
žœ=˜VK˜=Kšœžœ
˜
Kšœžœžœ
žœžœ
žœ
˜;Kš
œ˜Kšœžœ(˜>K˜*šžœžœ˜Kšœžœ%˜DKšžœžœ
žœ#˜;Kš
œ˜—Kšžœžœ8˜Nšžœ
žœ‘œ
žœ
‘#œžœ+žœ
ž˜“
šžœžœ
žœ4žœžœ
ž˜VKšžœ žœ
žœ
˜,Kš
œ/˜/Kšžœ
˜Kšžœ
˜——Kš
œ-˜-Kšžœžœ:˜Qš
œ˜K˜———™Kšœžœžœ˜=šœžœžœ˜!Kšœžœ‘˜2Kšœžœ˜)Kšœžœ˜%Kšœ3žœ˜=—Kšœžœ‘ ˜>Kšœžœžœžœ˜BKšœžœžœžœ˜BK˜š œžœžœ˜3Kšœžœ˜+Kšœžœ˜'Kš
œ˜K˜—š œžœ
žœ˜CK˜—š œžœ
žœ
žœžœžœ˜>Kšžœ
žœžœ
˜K˜K˜K˜—š œžœžœ˜)Kšžœ˜Kšœžœ#˜-Kš
œZ™ZKšžœžœ
žœžœžœžœ
˜AK˜K˜K˜—š œžœ
žœ
žœ˜GKšžœ˜Kšžœ
žœžœ
˜Kšœžœ#˜-šžœžœ
žœžœ
˜*šžœžœ‘˜-šžœžœ
žœž˜(Kšœžœžœ
˜—Kšœžœ˜—Kšžœ
˜—Kš
œ˜K˜—š œžœ
žœ0žœ	žœ	žœ˜yKšžœ˜Kšžœ
žœžœ
˜Kšœžœ#˜-Kšœžœ‘1˜MK˜&š	žœžœ
ž
œ
žœž˜4šžœžœ"žœ‘˜HK˜"K˜&K˜Kšžœžœ˜—Kšžœ
˜—Kšžœžœ˜Kš
œ˜K˜—š œžœ
žœ'žœ˜TKšžœ˜Kšžœ
žœžœ
˜Kšœžœ#˜-Kšžœžœ
žœ
˜'K˜K˜ Kšžœžœ
žœžœžœžœ
˜GK˜K˜K˜——™/Kšœžœ˜*Kšœ
žœ˜,K˜š
 œžœ
žœ
žœžœ˜AKš
œ5™5Kš
œ™š œžœžœ˜-Kšžœžœ
žœ˜:Kšžœ%˜)—Kšžœ
žœ
ž˜Kšœžœžœ
žœ˜MK˜"šœžœ‘˜<Kšžœ žœ
‘˜>šžœ
žœ
ž˜šœ‘˜"Kšžœžœ
žœ%˜IKšžœ˜—šœ‘˜#K˜%—Kšžœ˜—Kšžœ˜—K˜!šœžœž˜&K˜?Kšžœ
˜—Kšžœžœ‘6˜HK˜K˜——™š œžœ
žœ8˜PKšžœ˜Kšœžœ!˜+Kšœžœ#˜.K˜Kšœžœ
˜š
 œžœ
žœ
žœžœ˜.Kšžœ
žœžœ
˜K˜$šžœ
‘˜šžœž˜šœžœžœ˜$K˜K˜ Kšžœžœ˜—Kšœžœžœ‘˜EKšžœ
˜—šžœž˜Kš	œžœžœ
žœžœ˜:Kšœžœžœ˜Kšžœ
˜—Kšžœ
˜—Kš
œ˜—š œžœ
žœ˜Kšžœ
žœžœ
˜Kšžœžœ˜7K˜šžœ
‘*˜-šžœž˜Kšœžœžœ
žœ‘˜?Kšœžœ‘˜;Kšžœ
˜—šžœž˜Kšœžœžœ
žœ‘
˜?Kšœžœ‘
˜Kšžœ
˜—Kšžœ
˜—K˜"K˜K˜K˜K˜—šžœ ž˜%Kšœ'žœ
žœ
˜3—Kš	œžœ
žœžœžœ˜ZKšžœžœ
žœ
˜!Kšœ‘%˜3šžœ3˜5Kšžœ˜Kšžœ
žœžœ0˜G—Kš
œ˜K˜—Kšœžœžœ˜Bšœžœžœ˜$Kšœžœ‘%˜CKšœžœ˜#Kšœžœ˜%Kšœžœ˜&Kšœ žœ˜'Kš
œ˜—Kšœžœ‘˜7Kšœžœ‘˜DKšœžœžœžœ˜GKšœžœžœžœ˜>K˜š œžœ˜Kšžœ˜Kšœžœ˜%Kšœžœ˜'Kšœžœ˜(Kš
œ˜K˜—š
 œžœ
žœžœžœ˜3Kšžœ
žœžœ
˜K˜K˜K˜—š œžœžœžœ˜-Kšžœ˜Kšœžœ!˜+Kšžœžœžœ
žœ
˜,K˜Kš
žœžœ
žœžœ%žœ
˜UKš
œ˜K˜—š 	œžœžœžœ˜2šžœžœ
˜šœžœ
žœ˜(šœžœ
žœžœ˜7šœžœ˜!šœžœ˜#Kšœžœ˜"—————š
œ˜K˜———™š 
œžœ
žœ6˜MKšžœ˜Kšœžœ#˜+Kšœžœ%˜0Kšœžœ
˜K˜K˜š
 œžœ
žœ
žœžœ˜/Kšžœ
žœžœ
˜K˜&šžœ
‘˜šžœ
ž˜šœ	žœžœ˜%K˜K˜"Kšžœžœ˜—Kšœžœžœ‘˜?Kšžœ
˜—šžœž˜Kš	œžœžœ
žœžœ˜;Kšœžœžœ˜Kšžœ
˜—Kšžœ
˜—š
œ˜K˜——š œžœ
žœ˜Kšžœ
žœžœ
˜Kšžœ!žœ˜:K˜šžœ
‘˜šžœ
ž˜Kšœ	žœžœ
žœ‘˜@Kšœžœ‘˜5Kšžœ
˜—šžœž˜Kšœžœžœ
žœ‘
˜@Kšœžœ‘
˜Kšžœ
˜—Kšžœ
˜—K˜K˜K˜K˜$K˜K˜—Kšžœžœ
žœ
˜)š
œ˜šœžœ
žœ$˜:šœžœ
žœ$˜:šœžœ
žœ$˜:Kšœžœ˜%————Kšžœžœ
žœ
˜"Kšœ‘%˜3Kšžœ5žœ˜OK˜K˜—Kšœžœžœ˜Ešœžœžœ˜%Kšœžœ˜Kšœžœ˜%Kšœžœ˜'Kšœžœ˜(Kšœ"žœ˜)Kš
œ˜—Kšœžœ‘˜8Kšœžœ‘˜FKšœžœžœžœ˜EKšœžœžœžœ˜@K˜š œžœ˜Kšžœ˜Kšœžœ˜'Kšœžœ˜)Kšœžœ˜*K˜K˜—š
 œžœ
žœžœžœ˜4Kšžœ
žœžœ
˜K˜K˜K˜—š œžœžœžœ˜.Kšžœ˜Kšžœžœžœ
žœ
˜-K˜Kš
žœžœ
žœžœ)žœ
˜ZKš
œ˜K˜——™š œžœ
žœG˜_Kšžœ˜Kšœ	žœ)˜5Kšœžœ'˜2K˜Kšœžœ
˜Kšœžœ	˜š
 œžœ
žœ
žœžœ˜0Kšžœ
žœžœ
˜K˜(šžœ
‘˜šžœž˜šœ
žœžœ˜&K˜K˜$Kšžœžœ˜—Kšœžœžœ‘˜8Kšžœ
˜—šžœž˜Kš	œžœžœ
žœžœ˜<Kšœžœžœ˜Kšžœ
˜—Kšžœ
˜—Kš
œ˜—š œžœ
žœ˜ Kšžœ
žœžœ
˜Kšžœ#žœ˜=K˜šžœ
‘*˜-šžœž˜Kšœ
žœžœ
žœ‘˜AKšœžœ‘˜.Kšžœ
˜—šžœž˜Kšœžœžœ
žœ‘
˜AKšœžœ‘
˜Kšžœ
˜—Kšžœ
˜—K˜&K˜K˜K˜K˜—š 
œžœ
žœžœ˜'Kšœžœžœžœ	˜7Kšžœ˜Kš
œ˜—Kšžœžœ
žœ
˜#Kšœžœžœ˜PKšžœžœ
žœ
˜#Kšžœ4žœ˜OKš
œ˜K˜—Kšœžœžœ˜Hšœžœžœ˜&Kšœžœ
˜Kšœžœ˜+Kšœžœ˜)Kšœžœ˜*Kšœ$žœ˜+Kš
œ˜K˜—Kšœžœ‘˜9Kšœžœ‘˜HKšœžœžœžœ˜PKšœžœžœžœ˜BK˜K˜BK˜š œžœ˜Kšžœ˜Kšœžœ˜-Kšœžœ˜+Kšœžœ˜,Kš
œ˜K˜—š
 œžœ
žœžœžœ˜5Kšžœ
žœžœ
˜K˜K˜K˜—š œžœžœžœ˜/Kšžœ˜Kšžœžœžœ
žœ
˜.K˜Kš
žœžœ
žœžœ%žœ
˜WKš
œ˜K˜——™š œžœ
žœ
žœ˜"Kšžœ
žœžœ
˜Kšœžœ˜Kš
œ˜K˜—š œžœžœ˜"K˜K˜K˜K˜K˜K˜——š
œ™Kšœžœ
žœžœ
˜ K˜š
 
œžœ
žœžœžœ˜BKš
œ%˜%šžœžœ
ž˜K˜K˜Kšžœžœ˜—Kš
œ˜K˜—š
 œžœ
žœžœžœ˜HKš
œ%˜%šžœžœ
ž˜Kš
œ%˜%Kš
œ˜Kšžœžœ˜—Kš
œ˜K˜—š
 
œžœ
žœžœžœ˜QK˜/šžœ"žœžœ
ž˜3Kšœžœžœ˜%Kšžœžœ
žœžœ
˜3Kšžœ
˜—KšžœK˜QKš
œ˜K˜——™š 
œžœ
žœ6žœžœžœ˜oKš
œ9˜9šžœžœ
ž˜Kš
œ˜Kš
œ˜Kšžœžœ˜—Kšžœ˜
Kš
œ˜K˜—š œžœ
žœ6žœžœžœ˜sKš
œ9˜9šžœžœ
ž˜Kš
œ%˜%Kš
œ˜Kšžœžœ˜—Kšžœ˜
Kš
œ˜K˜—š
 œžœ
žœ5žœžœ˜tK˜
K˜/šžœ"žœžœ
ž˜3Kšœžœžœ˜%Kšžœžœ
žœžœ
˜3Kšžœ
˜—K˜4K˜&Kšœ-‘˜EKšœžœ"˜0K˜1Kšžœ˜
Kš
œ˜K˜——š
œ
™
š œžœ
žœžœ˜KKš
œ0™0K˜K˜K˜K˜K˜K˜——š
œ2™2š œžœ
žœ˜K˜ Kšœžœ˜$K˜Kš
œG™GKšœžœ
˜Kšœžœ
˜!Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜ K˜9K˜Kš
œ™K˜K˜K˜K˜Kšœžœ˜K˜Kš
œ-™-K˜K˜8K˜2K˜Kš
œS™SKšœ‘˜.K˜FK˜$K˜#K˜#K˜4K˜4K˜3K˜4K˜2K˜5K˜5K˜Kš
œ/™/Kš
œ!˜!K˜Kš
œO™OKš
œj˜jKš
œ˜K˜—J˜—K™Kšžœ
˜—…—V,wΝ