DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName, MakeAtom],
Checksum USING [ComputeChecksum],
Convert USING [RopeFromInt],
NodeProps USING [Is],
NodeStyle USING [DataEntry, DataList, GetStyleName, IntegerValue, MaxNestingLevel, RealCode, Style, SetReal, StyleBody],
NodeStyleOps USING [ExtObjPair, LocalStyle, LocalStyleRec, OfStyle],
NodeStyleWorks USING [BadStyleFile, ExecuteLooksInStyle, ExecuteNameInStyle, ExecuteObjectInStyle, FreeFrame, GetFrame, GetStyleDict, RunStyle, StyleParamKey],
Rope USING [Cat, Concat, ROPE, Translate],
Tioga,
TiogaPrivate USING [AddEditNotifyProc, Change, ChangeSet],
TJaM USING [Frame, NumberRep, Object, TryToLoad];

NodeStyleOpsImpl: CEDAR MONITOR LOCKS env USING env: Env
IMPORTS Ascii, Atom, Checksum, Convert, NodeProps, NodeStyle, NodeStyleWorks, Rope, Tioga, TiogaPrivate, TJaM
EXPORTS NodeStyleOps
~ BEGIN OPEN NodeStyle, NodeStyleOps;
ROPE: TYPE ~ Rope.ROPE;
Frame: TYPE ~ TJaM.Frame;
Object: TYPE ~ TJaM.Object;
Env: TYPE ~ REF EnvRep;
EnvRep: TYPE ~ MONITORED RECORD [
s1, s2, s3: Style _ NIL, -- small cache of styles

defaultStyleName: ATOM,
defaultStylesForExtensions: LIST OF ExtObjPair,
localStyleNumber: INT _ 0,

defaultStyle: Style _ NIL,
rootFormatName: ATOM,
defaultFormatName: ATOM,
applyCache: ApplyCache _ NIL,
ruleCache: RuleCache _ NIL,

looksCache: LooksCache _ NIL,

objectCache: ObjectCache _ NIL,

defaultFrame: Frame,
sysdict: TJaM.Dict,
userdict: TJaM.Dict,
styledict: TJaM.Dict,
styleLockProcess: UNSAFE PROCESS _ NIL,
styleLockCount: CARDINAL _ 0,
styleLockFree: CONDITION,
fileForStyle: RefTab.Ref,
runNesting: CARDINAL _ 0,  -- to decide whether to clear message window.
bindingDictName: ATOM,
attachmentsDictName: ATOM,
styledictName: ATOM,

bindingDict: TJaM.Dict,
attachmentsDict: TJaM.Dict,
stylesDictsNames: REF ARRAY OfStyle OF ATOM,
stylesDicts: REF ARRAY OfStyle OF TJaM.Dict,
nodeStyleFonts: BOOL _ FALSE;

executingName: ATOM _ NIL;
frame1, frame2, frame3, frame4: Frame _ NIL, -- small cache of active frames
frameAlloc: INT _ 0, -- number of frames allocated from TJaM
frameFree: INT _ 0, -- number of frames freed by TJaM
allocFrameCalls: INT _ 0, -- number of times called AllocFrame
freeFrameCalls: INT _ 0, -- number of times called FreeFrame. should = allocFrameCalls
style1, style2, style3, style4: Style,  -- style bodies associated with active frames 1,2,3,4
frameList: FrameInfo, -- chain of known frames beyond the small cache here
freeFrame1, freeFrame2, freeFrame3, freeFrame4: Frame _ NIL,
styleName1, styleName2, styleName3, styleName4: ATOM _ NIL,
styleKind1, styleKind2, styleKind3, styleKind4: OfStyle _ screen,
debugFlag: BOOL _ TRUE,
debugStyle: Style,

load: TJaM.Cmd,
get: TJaM.Cmd,
run: TJaM.Cmd,

opsList: LIST OF RECORD[name: ATOM, op: TJaM.CommandProc] _ NIL;


];

InitEnv: PROC [env: Env] ~ {
env.applyCache _ NEW[ApplyCacheRep];
env.ruleCache _ NEW[RuleCacheRep];

env.looksCache _ NEW[LooksCacheRep];

env.objectCache _ NEW[ObjectCacheRep];
env.fileForStyle _ RefTab.Create[5];
stylesDictsNames _ NEW[ARRAY OfStyle OF ATOM],
stylesDicts _ NEW[ARRAY OfStyle OF TJaM.Dict],
};

Create: PUBLIC PROC RETURNS [Style] ~ {
RETURN [NEW[StyleBody]];
};

Copy: PUBLIC PROC [dest, source: Style] ~ {
dest^ _ source^;
};

Alloc: PUBLIC ENTRY PROC [env: Env] RETURNS [s: Style] ~ { OPEN env;
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[];
};

Free: PUBLIC ENTRY PROC [env: Env, s: Style] ~ { OPEN env;
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 PROC [name: ATOM] RETURNS [ok: BOOL] ~ {
frame: Frame _ NodeStyleWorks.GetFrame[NIL, NIL, screen];
[] _ NodeStyleWorks.GetStyleDict[frame, name, screen];
NodeStyleWorks.FreeFrame[frame, NIL, screen];
RETURN [TRUE];
};

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

ReloadStyle: PUBLIC PROC [name: ATOM] RETURNS [ok: BOOL] ~ {
ForceLowerName: PROC [name: ATOM] RETURNS [ATOM] ~ {
RETURN [Atom.MakeAtom[ForceRopeLower[Atom.GetPName[name]]]];
};
name _ ForceLowerName[name];
FOR kind: NodeStyleOps.OfStyle IN NodeStyleOps.OfStyle DO
frame: Frame _ NodeStyleWorks.GetFrame[NIL, NIL, kind];
ok _ NodeStyleWorks.RunStyle[frame, name];
IF ~ok THEN NodeStyleWorks.BadStyleFile[frame, name];
NodeStyleWorks.FreeFrame[frame, NIL, kind];
ENDLOOP;
};

SetDefaultStyle: PUBLIC PROC [name: ROPE] ~ {
defaultStyleName _ Atom.MakeAtom[ForceRopeLower[name]];
defaultStyle.name[style] _ defaultStyleName;
FlushCaches[];
};

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

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

ReadStyleDef: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
GenLocalName: ENTRY PROC RETURNS [gen: ROPE] ~ {
localStyleNumber _ localStyleNumber + 1;
gen _ Rope.Concat["LocalStyle-", Convert.RopeFromInt[localStyleNumber]];
};
localStyle: LocalStyle _ NEW[LocalStyleRec];
localStyleName: ROPE ~ GenLocalName[];
localStyle.name _ Atom.MakeAtom[localStyleName];
localStyle.def _ specs;
[] _ DefineStyle[localStyle.name, specs];
RETURN [localStyle];
};

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

CopyStyleDef: PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ {
RETURN [value];
};
ApplyAll: PUBLIC PROC [ref: Style, node: Tioga.Node, kind: OfStyle _ screen] ~ {
[] _ DoApplyAll[ref, node, kind];
};

DoApplyAll: PROC [ref: Style, node: Tioga.Node, kind: OfStyle]
RETURNS [depth: CARDINAL] ~ {
found: BOOL;
parent: Tioga.Node;
alt: ATOM;
IF node = NIL THEN { ref^ _ defaultStyle^; RETURN [0] };
[found, depth] _ FindInApplyAllCache[ref, node, kind];
IF found THEN RETURN [depth+1];
parent _ Tioga.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: Style, node: Tioga.Node, alt: ATOM, kind: OfStyle] ~ {
ext: ATOM;
ref.isComment _ IF node # NIL THEN node.comment ELSE FALSE;
ref.print _ (kind = print);
ref.nestingLevel _ MIN[Tioga.Level[node], MaxNestingLevel];
IF node.hasstyledef THEN {
localStyle: LocalStyle _ NARROW[Tioga.GetProp[node, $StyleDef]];
IF localStyle # NIL THEN ref.name[style] _ localStyle.name;
};
IF node.hasprefix
THEN ApplyObject[ref, Tioga.GetProp[node, $Prefix], kind]
ELSE IF ref.nestingLevel=0 -- root node -- AND -- check for file extension default
(ext _ NARROW[Tioga.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, Tioga.GetProp[node, $Postfix], kind];
};

ApplyCacheRep: TYPE ~ RECORD [
depth: CARDINAL _ 0,  -- next free entry
results: REF ApplyCacheResults,
nodes: REF ApplyCacheNodes,
probes, hits, saves: INT _ 0
];
applyCacheSize: CARDINAL ~ 8; -- number of levels deep in tree
ApplyCacheNodes: TYPE ~ ARRAY [0..applyCacheSize) OF Tioga.Node;
ApplyCacheResults: TYPE ~ ARRAY [0..applyCacheSize) OF StyleBody; 

InitApplyCacheRecord: PROC ~ {
applyCache.results _ NEW[ApplyCacheResults];
applyCache.nodes _ NEW[ApplyCacheNodes];
};

RemoveAllFromApplyAllCache: PUBLIC PROC ~ { FlushApplyAllCache[] };

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

ClearApplyAllCache: INTERNAL PROC [init: BOOL] ~ {
FOR i: CARDINAL IN [0..applyCacheSize) DO applyCache.nodes[i] _ NIL; ENDLOOP;
applyCache.depth _ 0;
};

RemoveNodeFromApplyAllCache: PUBLIC ENTRY PROC [node: Tioga.Node] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCache.nodes;
FOR i: CARDINAL IN [0..applyCache.depth) DO 
IF nodes[i]=node THEN { -- clear from here on
FOR j: CARDINAL IN [i..applyCacheSize) DO
nodes[j] _ NIL;
ENDLOOP;
applyCache.depth _ i;
EXIT;
};
ENDLOOP;
};

FindInApplyAllCache: ENTRY PROC [ref: Style, node: Tioga.Node, kind: OfStyle] 
RETURNS [found: BOOL, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCache.nodes;
print: BOOL ~ (kind=print); -- if true, then find result with print true also
applyCache.probes _ applyCache.probes+1;
FOR i: CARDINAL DECREASING IN [0..applyCache.depth) DO
IF nodes[i]=node AND print=applyCache.results[i].print THEN { -- found it
applyCache.hits _ applyCache.hits+1;
applyCache.saves _ applyCache.saves+i+1;
ref^ _ applyCache.results[i];
RETURN [TRUE, i]
};
ENDLOOP;
RETURN [FALSE, 0];
};

EnterInApplyAllCache: ENTRY PROC [ref: Style, node: Tioga.Node, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes _ applyCache.nodes;
IF depth >= applyCacheSize THEN RETURN;
nodes[depth] _ node;
applyCache.results[depth] _ ref^;
FOR i: CARDINAL IN [depth+1..applyCacheSize) DO nodes[i] _ NIL; ENDLOOP;
applyCache.depth _ depth+1;
};

Change: TYPE ~ TiogaPrivate.Change;
Notify: PROC [change: REF READONLY Change] ~ {
DoNode: PROC [node: Tioga.Node] ~ {
IF Tioga.FirstChild[node] # NIL THEN FlushApplyAllCache[]
ELSE RemoveNodeFromApplyAllCache[node]
};
WITH change SELECT FROM
x: REF READONLY Change.InsertingNode => IF Tioga.FirstChild[x.new] # NIL THEN FlushApplyAllCache[];
x: REF READONLY Change.MovingNodes => FlushApplyAllCache[];
x: REF READONLY Change.NodeNesting => IF x.first = x.last -- only changing one node
AND Tioga.FirstChild[x.first] = NIL -- node has no children
THEN SELECT x.change FROM
+1 => -- increasing nesting in tree
IF Tioga.Next[x.first] = NIL THEN RemoveNodeFromApplyAllCache[x.first]
ELSE FlushApplyAllCache[];
-1 => -- decreasing nesting in tree
RemoveNodeFromApplyAllCache[x.first];
ENDCASE => FlushApplyAllCache[]
ELSE FlushApplyAllCache[];
x: REF READONLY Change.ChangingFormat => DoNode[x.node];
x: REF READONLY Change.ChangingProp => {
IF NodeProps.Is[x.propAtom, $Visible] THEN DoNode[x.node];
};
ENDCASE => ERROR; -- not expecting notify for any other kinds of changes
};

HashStyle: PROC [ref: Style, looks: Tioga.Looks _ Tioga.noLooks, anotherRef: REF _ NIL]
RETURNS [CARDINAL] ~ TRUSTED { 
Bits: TYPE ~ MACHINE DEPENDENT RECORD [
REF, REF, REF, REF, RealCode, RealCode, RealCode, RealCode, Tioga.Looks];
bits: Bits _ [ref.name[style], ref.name[fontPrefix], ref.name[fontFamily], anotherRef,
ref.real[fontSize], ref.real[leftIndent], ref.real[leading], 0, looks];
RETURN [Checksum.ComputeChecksum[3145, SIZE[Bits], @bits]];
};

ruleCacheSize: CARDINAL ~ 64; -- should be a power of 2
ruleCacheMax: CARDINAL ~ (ruleCacheSize*4)/5; -- don't fill too full
RuleCacheLoc: TYPE ~ CARDINAL[0..ruleCacheSize);
RuleCacheNames: TYPE ~ ARRAY RuleCacheLoc OF ATOM;
RuleCacheBodies: TYPE ~ ARRAY RuleCacheLoc OF StyleBody;

RuleCache: TYPE ~ REF RuleCacheRep;
RuleCacheRep: TYPE ~ RECORD [
count: CARDINAL _ 0, -- number of entries currently in use
names: REF RuleCacheNames,
inputs: REF RuleCacheBodies,
results: REF RuleCacheBodies,
probes, hits: INT _ 0
];

InitRuleCacheInfo: PROC ~ {
ruleCache.names _ NEW[RuleCacheNames];
ruleCache.inputs _ NEW[RuleCacheBodies];
ruleCache.results _ NEW[RuleCacheBodies];
};

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

ClearRuleCache: INTERNAL PROC [init: BOOL _ FALSE] ~ {
IF init OR ruleCache.count#0 THEN {
ruleCache.count _ 0;
FOR i: RuleCacheLoc IN RuleCacheLoc DO ruleCache.names[i] _ NIL; ENDLOOP;
};
};


ApplyFormat: PUBLIC PROC [ref: Style, name, alt: ATOM, kind: OfStyle] ~ {
input: StyleBody;
initloc: RuleCacheLoc;
FindInRuleCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: RuleCacheLoc _ initloc;
ruleCache.probes _ ruleCache.probes+1;
DO -- search ruleCache
SELECT ruleCache.names[loc] FROM
name => IF ruleCache.inputs[loc] = ref^ THEN {
ref^ _ ruleCache.results[loc];
ruleCache.hits _ ruleCache.hits+1;
RETURN [TRUE];
};
NIL => RETURN [FALSE]; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD ruleCacheSize;
IF loc=initloc THEN RETURN [FALSE];
ENDLOOP;
};
PutInRuleCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: RuleCacheLoc _ initloc;
IF ruleCache.count = ruleCacheMax THEN ClearRuleCache[];
DO -- search ruleCache for place to put the entry
SELECT ruleCache.names[loc] FROM
name => IF ruleCache.inputs[loc] = input THEN RETURN; -- already in cache
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD ruleCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
ruleCache.names[loc] _ name;
ruleCache.inputs[loc] _ input;
ruleCache.results[loc] _ ref^;
ruleCache.count _ ruleCache.count+1;
};
IF name=NIL AND (name _ alt)=NIL THEN RETURN;
initloc _ HashStyle[ref, , name] 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, NIL, kind];
};

looksCacheSize: CARDINAL ~ 16; -- should be a power of 2
looksCacheMax: CARDINAL ~ (looksCacheSize*4)/5; -- don't fill too full
LooksCacheLoc: TYPE ~ CARDINAL[0..looksCacheSize);
LooksCacheLooks: TYPE ~ ARRAY LooksCacheLoc OF Tioga.Looks;
LooksCacheBodies: TYPE ~ ARRAY LooksCacheLoc OF StyleBody;
LooksCache: TYPE ~ REF LooksCacheRep;
LooksCacheRep: TYPE ~ RECORD [
count: CARDINAL _ 0,
looks: REF LooksCacheLooks,
inputs: REF LooksCacheBodies,
results: REF LooksCacheBodies,
probes, hits: INT _ 0
];

InitLooksCacheInfo: PROC ~ {
looksCache.looks _ NEW[LooksCacheLooks];
looksCache.inputs _ NEW[LooksCacheBodies];
looksCache.results _ NEW[LooksCacheBodies];
};

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

ClearLooksCache: PROC [init: BOOL _ FALSE] ~ {
IF ~init AND looksCache.count = 0 THEN RETURN;
looksCache.count _ 0;
FOR i: LooksCacheLoc IN LooksCacheLoc DO looksCache.looks[i] _ Tioga.noLooks; ENDLOOP;
};


ApplyLooks: PUBLIC PROC [ref: Style, looks: Tioga.Looks, kind: OfStyle] ~ {
initloc: LooksCacheLoc;
input: StyleBody;
FindInLooksCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: LooksCacheLoc _ initloc;
looksCache.probes _ looksCache.probes+1;
DO -- search looksCache
SELECT looksCache.looks[loc] FROM
looks => IF looksCache.inputs[loc] = ref^ THEN {
ref^ _ looksCache.results[loc];
looksCache.hits _ looksCache.hits+1;
RETURN [TRUE];
};
Tioga.noLooks => EXIT; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD looksCacheSize;
IF loc=initloc THEN EXIT;
ENDLOOP;
RETURN [FALSE];
};
PutInLooksCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: LooksCacheLoc _ initloc;
IF looksCache.count = looksCacheMax THEN ClearLooksCache[];
DO -- search looksCache for place to put the entry
SELECT looksCache.looks[loc] FROM
looks => IF looksCache.inputs[loc] = input THEN RETURN; -- already in cache
Tioga.noLooks => EXIT; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD looksCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
looksCache.looks[loc] _ looks;
looksCache.inputs[loc] _ input;
looksCache.results[loc] _ ref^;
looksCache.count _ looksCache.count+1;
};
IF looks = Tioga.noLooks THEN RETURN;
initloc _ HashStyle[ref, looks] MOD looksCacheSize;
IF FindInLooksCache[] THEN RETURN;
input _ ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteLooksInStyle[ref, kind, looks] THEN PutInLooksCache[];
};

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

ObjectCacheRep: TYPE ~ RECORD [
count: CARDINAL[0..objectCacheMax],
objects: REF ObjectCacheObjects,
inputs: REF ObjectCacheBodies,
results: REF ObjectCacheBodies,
probes, hits: INT _ 0
];

InitObjectCacheInfo: PROC ~ {
objectCache.objects _ NEW[ObjectCacheObjects];
objectCache.inputs _ NEW[ObjectCacheBodies];
objectCache.results _ NEW[ObjectCacheBodies];
};

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

ClearObjectCache: PROC [init: BOOL _ FALSE] ~ {
IF ~init AND objectCache.count = 0 THEN RETURN;
objectCache.count _ 0;
FOR i: ObjectCacheLoc IN ObjectCacheLoc DO objectCache.objects[i] _ NIL; ENDLOOP;
};

ApplyObject: PUBLIC PROC [ref: Style, object: Object, kind: OfStyle _ screen] ~ {
input: StyleBody;
initloc: ObjectCacheLoc;
FindInObjectCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: ObjectCacheLoc _ initloc;
objectCache.probes _ objectCache.probes+1;
DO -- search objectCache
SELECT objectCache.objects[loc] FROM
object => IF objectCache.inputs[loc] = ref^ THEN {
ref^ _ objectCache.results[loc];
objectCache.hits _ objectCache.hits+1;
RETURN [TRUE];
};
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD objectCacheSize;
IF loc=initloc THEN EXIT;
ENDLOOP;
RETURN [FALSE];
};
PutInObjectCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: ObjectCacheLoc _ initloc;
IF objectCache.count = objectCacheMax THEN ClearObjectCache[];
DO -- search objectCache for place to put the entry
SELECT objectCache.objects[loc] FROM
object => IF objectCache.inputs[loc] = input THEN RETURN; -- already in cache
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc _ (loc+1) MOD objectCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
objectCache.objects[loc] _ object;
objectCache.inputs[loc] _ input;
objectCache.results[loc] _ ref^;
objectCache.count _ objectCache.count+1;
};
IF object = nullObject THEN RETURN;
initloc _ HashStyle[ref, , object] MOD objectCacheSize;
IF FindInObjectCache[] THEN RETURN;
input _ ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteObjectInStyle[ref, kind, object] THEN PutInObjectCache[];
};

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;
GetStyleParam: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [r: REAL] ~ {
obj: Object _ GetStyleParamObj[s, name, styleName, kind];
WITH obj SELECT FROM
x: REF TJaM.NumberRep.int => r _ x.int;
x: REF TJaM.NumberRep.real => r _ x.real;
ENDCASE => ERROR nonNumeric;
RETURN [r];
};

GetStyleParamI: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [i: INTEGER] ~ {
obj: Object _ GetStyleParamObj[s, name, styleName, kind];
WITH obj SELECT FROM
x: REF TJaM.NumberRep.int => i _ x.int;
x: REF TJaM.NumberRep.real => i _ NodeStyle.IntegerValue[x.real];
ENDCASE => ERROR nonNumeric;
RETURN [i];
};

GetStyleParamObj: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [obj: Object] ~ {
frame: Frame;
key: ATOM _ NodeStyleWorks.StyleParamKey[name];
FOR x: DataList _ s.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF NodeStyle.DataEntry.object => IF xx.name = key THEN RETURN[xx.object];
ENDCASE;
ENDLOOP;
frame _ NodeStyleWorks.GetFrame[s, styleName, kind];
obj _ TJaM.TryToLoad[frame, key].val;
NodeStyleWorks.FreeFrame[frame, styleName, kind];
RETURN [obj];
};

StyleNameForNode: PUBLIC PROC [node: Tioga.Node] RETURNS [name: ATOM] ~ {
s: Style _ Alloc[];
ApplyAll[s, node];
name _ GetStyleName[s];
Free[s];
};

InitializeDefaultStyle: PUBLIC PROC [world: Tioga.World, suggestedStyle: ROPE] ~ {
changeSet: TiogaPrivate.ChangeSet;
PointsPerInch: REAL ~ 1.0/0.0138370;

changeSet[ChangingProp] _ TRUE;
changeSet[ChangingFormat] _ TRUE;
changeSet[MovingNodes] _ TRUE;
changeSet[NodeNesting] _ TRUE;
changeSet[InsertingNode] _ TRUE;
TiogaPrivate.AddEditNotifyProc[world, Notify, after, high, changeSet];

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

defaultStyle _ Create[];
defaultFormatName _ $default;
rootFormatName _ $root;

defaultStyle.name[fontFamily] _ $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];
SetReal[defaultStyle, underlineThickness, 1];
SetReal[defaultStyle, underlineDescent, 1];
SetReal[defaultStyle, strikeoutThickness, 1];
SetReal[defaultStyle, strikeoutAscent, 4];

Tioga.RegisterProp[name: $StyleDef, reader: ReadStyleDef, writer: WriteStyleDef, copier: CopyStyleDef];

SetDefaultStyle[suggestedStyle];
};

END.
ŒNodeStyleOpsImpl.mesa
Copyright Σ 1985, 1986 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
Russ Atkinson, March 7, 1985 3:29:21 am PST
Michael Plass, May 9, 1986 12:27:55 pm PDT
Rick Beach, March 27, 1985 10:54:03 am PST
Doug Wyatt, September 24, 1986 7:02:31 pm PDT


Style Environment
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
NodeStyleObsolete.EvalFreeVars[ref, node];
ApplyAll Cache
when clearing, go all the way to applyCacheSize rather than stopping at applyCache.depth
Update ApplyAll Cache due to Editing Operations
if change invalidates one node only, remove that node
else clear entire cache
Hashing
Style Rule Cache
Looks Cache
Object Cache
Flush Caches
Style Parameter Extensions

May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
Miscellaneous
Does an ApplyAll and then returns the style name
Initialization
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
register the special handling procedures for the local style property: StyleDef
Κ˜
codeš
œ™Kš
œB™BKš
œ$™$Kš
œ!™!K™ K™+K™*J™*K™-—K™š
Οk	˜	Kšœœ	˜Kšœœ˜ Kšœ	œ˜!Kšœœ˜Kšœ
œ˜Kšœ
œi˜xKšœ
œ2˜DKšœœ‹
˜Ÿ
Kšœœœ
˜*Kš
œ˜Kšœ
œ(˜:Kšœœ'˜1—K˜Kš
Ρblnœœ
œ
œœ	˜8Kšœf˜mKšœ
˜šœœ
œ˜%K™Kšœœœ
˜Kšœœ˜Kšœœ˜—
headš
œ™Kšœœœ˜šœœ	œ
œ˜!šœœΟc˜1K˜—Kšœœ
˜Kšœœ
œ˜/šœœ˜K˜—Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜šœœ
˜K˜—šœœ
˜K˜—Kšœœ
˜K˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœœœ
˜'Kšœœ˜Kšœ	œ
˜Kš
œ˜KšœœŸ-˜HKšœœ
˜Kšœœ
˜šœœ
˜K˜—Kš
œ˜Kš
œ˜Kš	œœ
œ	œ
œ
˜,Kšœ
œ
œ	œ˜,šœœœ
˜K˜—Kšœœœ
˜Kšœ(œŸ˜LKšœœŸ'˜<KšœœŸ!˜5KšœœŸ$˜>KšœœŸ=˜VKšœ(Ÿ5˜]KšœŸ4˜JKšœ8œ
˜<Kšœ0œœ
˜;K˜AKšœœœ
˜K˜K˜Kš
œ˜Kš
œ˜Kš
œ˜K˜Kšœ	œ
œ
œœœ
˜@˜K˜—K˜K˜—šΟnœœ˜Kšœœ˜$šœœ˜"K˜—šœœ˜$K˜—Kšœœ˜&Kš
œ$˜$Kš	œœ
œ	œ
œ˜.Kšœœ
œ	œ˜.K˜K˜——š
œ™š œœ
œ
œ˜'Kš
œ™Kšœœ
˜Kš
œ˜K˜—š œœ
œ˜+Kš
œ™K˜K˜K˜—š œœ
œ
œœœ˜DKš
œ™Kšœ
œœ
˜Kšœœ
œœ˜%Kš
œ
œœ
œœ˜*Kš
œ
œœ
œœ˜*Kšœ˜Kš
œ˜—K˜š
 œœ
œ
œœ˜:Kš
œ&™&Kšœ
œœ
˜Kšœœ
œ˜Kšœ
œœ
œ˜Kšœ
œœ
œ˜Kš
œ˜K˜—š 	œœ
œœœœ˜:Kšœ'œœ
˜9K˜6Kšœ œ
˜-Kšœœ˜Kš
œ˜K˜—š œœ
œœœœœ˜GKšœ'œœ
˜9šœ˜Kšœ)˜-Kšœ<˜@—Kšœ œ
˜-Kšœœ˜Kš
œ˜K˜—š œœ
œœœœ˜<š
 œœœœœ˜4Jšœ6˜<J˜—K˜šœœ˜9Kšœ'œœ˜7K˜*Kšœœ*˜5Kšœ œ˜+Kšœ
˜—K˜K˜——™š œœ
œœ˜-Kš
œ7˜7K˜,Kš
œ˜Kš
œ˜K˜—š
 œœœœœ˜1š
 œœœœœ˜8Kšœ˜—Kšœ7˜=Kš
œ˜K˜—š œœ
œ	œ
œ
œ˜9Kšœœ
˜!š	œœ
œœ
˜$Kšœœ/Ÿ˜HKš
œS˜SKšœœ1˜RK˜Kšœ
˜—Kš
œ˜Kš
œ˜K˜—š œœœ	œœ	œ˜Eš
 œœ
œ
œœ˜0Kš
œ(˜(Kš
œH˜HK˜—Kšœœ˜,Kšœœ˜&Kš
œ0˜0K˜Kš
œ)˜)Kšœ˜Kš
œ˜—K˜š 
œœœ	œœ	œ˜FKšœœ˜'Kšœœœ
œ
œ
œ˜8Kš
œ˜—K˜š œœœ	œœœ˜BKšœ	˜Kš
œ˜——š
œ™š œœ
œ;˜PK˜!K˜K˜—š 
œœ/œ	œ˜\Kšœœ
˜K˜Kšœœ
˜
Kšœœ
œœ˜8K˜6Kšœœ
œ˜K˜Kš	œœœ
œœ˜?K˜&K˜#K˜'Kšœ˜Kš
œ˜K˜—š œœ
œ%œ˜VKšœœ
˜
Kšœœœ
œœ
œ
˜;Kš
œ˜Kšœœ%˜;K™*šœœ˜Kšœœ!˜@Kšœœ
œ#˜;Kš
œ˜—šœ˜Kšœ5˜9šœ
œŸœ
œ
Ÿ#œœ)œ
˜‘
šœœ
œ4œœ
˜XKšœ œ
œ
˜,Kš
œ/˜/Kšœ
˜Kšœ
˜———Kš
œ-˜-Kšœœ7˜Nš
œ˜K˜———™šœœœ˜KšœœŸ˜(Kšœ	œ˜Kšœœ˜Kšœœ˜Kš
œ˜—KšœœŸ ˜>Kšœœœœ˜@Kšœœœœ˜BK˜š œœ˜Kšœœ˜,Kšœœ˜(Kš
œ˜K˜—š œœ
œ˜CK˜—š œœ
œ
œœœ˜>Kšœ
œœ
˜K˜K˜K˜—š œœ
œœ˜2Kš
œX™XKšœœ
œœœœ
˜MKš
œ˜K˜K˜—š œœ
œ
œ˜EKšœ
œœ
˜Kšœœ$˜.šœœ
œœ
˜,šœœŸ˜-šœœ
œ˜)Kšœœ
˜Kšœ
˜—Kš
œ˜Kšœ
˜Kš
œ˜—Kšœ
˜—Kš
œ˜K˜—š œœ
œ0œ	œ	œ˜yKšœ
œœ
˜Kšœœ$˜.KšœœŸ1˜MKš
œ(˜(š	œœ

œ
œ˜6šœœ#œŸ˜IKš
œ$˜$Kš
œ(˜(Kš
œ˜Kšœœ˜Kš
œ˜—Kšœ
˜—Kšœœ˜Kš
œ˜K˜—š œœ
œ'œ˜TKšœ
œœ
˜Kšœœ$˜.Kšœœ
œ
˜'K˜Kš
œ!˜!Kšœœ
œœœœ
˜HKš
œ˜K˜K˜——™/Kšœœ˜#š œœ
œ
œ˜.Kš
œ5™5Kš
œ™š œœ˜#Kšœœ
œ˜9Kšœ"˜&Kš
œ˜—šœœ
˜Kšœœ
œœœ
œ˜cKšœœ
œ,˜;šœœ
œœŸ˜SKšœœ
Ÿ˜;šœ
œ
˜šœŸ˜#Kšœœ
œ%˜FKšœ˜—šœŸ˜#K˜%—Kšœ˜—Kšœ˜—Kšœœ
œ)˜8šœœ
œ˜(Kšœ$œ˜:Kš
œ˜—KšœœŸ6˜H—K˜K˜——™š 	œœ>œœœœœ˜wKšœœœ
	œ
œœœœœ7˜qKš
œž
˜ž
Kšœ!œ˜;š
œ˜K˜———™KšœœŸ˜7KšœœŸ˜DKšœœœ˜0Kš	œœœœ
œ
˜2šœœœœ˜8K˜—Kšœœœ˜#šœœœ˜KšœœŸ%˜:Kšœœ˜Kšœœ˜Kšœ	œ˜Kšœœ˜Kš
œ˜K˜—š œœ˜Kšœœ˜&Kšœœ˜(Kšœœ˜)Kš
œ˜K˜—š
 œœ
œœœ˜3Kšœ
œœ
˜Kš
œ˜K˜K˜—š
 œœ
œœœ˜6šœœœ˜#K˜Kš
œœœœœ
˜IK˜—Kš
œ˜K˜—K˜š œœ
œœ˜IK˜Kš
œ˜š
 œœ
œ
œœ˜.Kšœ
œœ
˜Kš
œ˜K˜&šœ
Ÿ˜šœ˜ šœœœ˜.K˜K˜"Kšœœ˜Kš
œ˜—KšœœœŸ˜1Kšœ
˜—Kšœœ˜ Kšœ
œ
œœ˜#Kšœ
˜—Kš
œ˜—š œœ
œ˜Kšœ
œœ
˜Kš
œ˜Kšœ œ˜8šœ
Ÿ.˜1šœ˜ Kšœœœ
œŸ˜IKšœœŸ˜'Kšœ
˜—Kšœœ˜ Kšœ
œ
œŸ
˜(Kšœ
˜—K˜K˜K˜K˜$K˜—Kšœœ
œ
œ
œ
œ
˜-Kšœ!œ˜3Kšœœ
œ
˜!KšœŸ%˜3Kšœ4œ˜KKšœ
œ
œœ˜7Kš
œ˜K˜——™KšœœŸ˜8KšœœŸ˜FKšœœœ˜2Kšœœœœ
˜;Kšœœœœ˜:Kšœœœ˜%šœœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœ	œ˜Kšœœ˜Kš
œ˜K˜—š œœ˜Kšœœ˜(Kšœœ˜*Kšœœ˜+K˜K˜—š
 œœ
œœœ˜4Kšœ
œœ
˜K˜K˜K˜—š œœœœ˜.Kšœœœ
œ
˜.K˜Kšœœœ&œ
˜VKš
œ˜K˜—K˜š 
œœ
œ4˜KKš
œ˜K˜š
 œœ
œ
œœ˜/Kšœ
œœ
˜Kš
œ˜K˜(šœ
Ÿ˜šœ˜!šœ	œœ˜0K˜K˜$Kšœœ˜Kš
œ˜—KšœœŸ˜1Kšœ
˜—Kšœœ˜!Kšœ
œ
œ
˜Kšœ
˜—Kšœœ˜Kš
œ˜—š œœ
œ˜Kšœ
œœ
˜Kš
œ˜Kšœ"œ˜;šœ
Ÿ/˜2šœ˜!Kšœ	œ œ
œŸ˜KKšœœŸ˜1Kšœ
˜—Kšœœ˜!Kšœ
œ
œŸ
˜(Kšœ
˜—K˜K˜K˜K˜&K˜—Kšœœ
œ
˜%Kšœ œ˜3Kšœœ
œ
˜"KšœŸ%˜3Kšœ5œ˜OK˜K˜——™KšœœŸ˜9KšœœŸ˜HKšœœœ˜4Kšœœœœ˜@šœœœœ˜BK˜—šœœœ˜Kšœœ˜#Kšœ	œ˜ Kšœœ˜Kšœ	œ˜Kšœœ˜Kš
œ˜K˜—š œœ˜Kšœœ˜.Kšœœ˜,Kšœœ˜-Kš
œ˜K˜—š
 œœ
œœœ˜5Kšœ
œœ
˜K˜K˜K˜—š œœœœ˜/Kšœœœ
œ
˜/Kš
œ˜Kš
œœœœœ
˜QKš
œ˜K˜—š œœ
œ9˜QK˜Kš
œ˜š
 œœ
œ
œœ˜0Kšœ
œœ
˜Kš
œ˜K˜*šœ
Ÿ˜šœ˜$šœ
œ œ˜2K˜ K˜&Kšœœ˜Kš
œ˜—KšœœŸ˜'Kšœ
˜—Kšœœ˜"Kšœ
œ
œ
˜Kšœ
˜—Kšœœ˜Kš
œ˜—š œœ
œ˜ Kšœ
œœ
˜Kš
œ˜Kšœ$œ˜>šœ
Ÿ0˜3šœ˜$Kšœ
œ!œ
œŸ˜MKšœœŸ˜'Kšœ
˜—Kšœœ˜"Kšœ
œ
œŸ
˜(Kšœ
˜—K˜"K˜ K˜ K˜(K˜—Kšœœ
œ
˜#Kšœ#œ˜7Kšœœ
œ
˜#KšœŸ%˜3Kšœ7œ˜RKš
œ˜K˜——™š œœ
œ
œ˜"Kšœ
œœ
˜Kšœœ˜Kš
œ˜K˜—š œœœ˜"K˜K˜K˜K˜K˜K˜——™šœœ
œœ
˜ K™—š 
œœ
œœ
œœœ˜gKš
œ:™:Kš
œ9˜9šœœ
˜Jšœœ!˜'Jšœœ#˜)Jšœœ˜—Kšœ˜Kš
œ˜K˜—š œœ
œœ
œœœ˜kKš
œ:™:Kš
œ9˜9šœœ
˜Jšœœ!˜'Jšœœ;˜AJšœœ˜—Kšœ˜Kš
œ˜K˜—š œœ
œœ
œœ˜nK˜
Kšœœ&˜/šœ"œœ
˜3šœœ
˜Jš	œœœœ
œ˜NJšœ
˜—Kšœ
˜—K˜4Kš
œ%˜%K˜1Kšœ˜
Kš
œ˜K˜——š
œ
™
š
 œœ
œœœ˜IKš
œ0™0K˜K˜K˜K˜K˜K˜——š
œ™š œœ
œ&œ˜RK˜"Kšœœ˜$K˜Kš
œG™GKšœœ
˜Kšœœ
˜!Kšœœ
˜Kšœœ
˜Kšœœ
˜ Kš
œF˜FK˜Kš
œ™K˜K˜K˜K˜Kšœœ˜K˜Kš
œ-™-K˜K˜K˜K˜Kš
œS™SK˜+K˜$K˜#K˜#K˜4K˜4K˜3K˜4K˜2K˜5K˜5Kš
œ-˜-Kš
œ+˜+Kš
œ-˜-Kš
œ*˜*K˜Kš
œO™OKš
œg˜gK˜Kš
œ ˜ Kš
œ˜——K˜Kšœ
˜—…—TΈwT