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
Doug Wyatt, March 5, 1985 10:53:24 am PST
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
DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName, MakeAtom],
Checksum USING [ComputeChecksum],
Convert USING [RopeFromInt],
EditNotify USING [AddNotifyProc, Change, ChangeSet],
NodeProps USING [CopyInfoProc, GetProp, Register],
NodePropsExtras USING [Is],
NodeStyle USING [DataEntry, DataList, GetStyleName, IntegerValue, MaxNestingLevel, RealCode, Ref, 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],
TextLooks USING [Looks, noLooks],
TextNode USING [FirstChild, Level, Next, Parent, Ref],
TJaM USING [Frame, NumberRep, Object, TryToLoad];
NodeStyleOpsImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, Checksum, Convert, EditNotify, NodeProps, NodePropsExtras, NodeStyle, NodeStyleWorks, Rope, TextNode, TJaM
EXPORTS NodeStyleOps
~
BEGIN
OPEN NodeStyle, NodeStyleOps;
ROPE: TYPE ~ Rope.ROPE;
Frame: TYPE ~ TJaM.Frame;
Object: TYPE ~ TJaM.Object;
Style Operations
Create:
PUBLIC
PROC
RETURNS [Ref] ~ {
create a style body
RETURN [NEW[StyleBody]];
};
Copy:
PUBLIC
PROC [dest, source: Ref] ~ {
copy a style body
dest^ ← source^;
};
Alloc:
PUBLIC
ENTRY
PROC
RETURNS [s: Ref] ~ {
get from a small cache
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] ~ {
don't free more than once or disaster!
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;
};
Local Styles
defaultStyleName: PUBLIC ATOM;
defaultStylesForExtensions: PUBLIC LIST OF ExtObjPair;
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[];
};
localStyleNumber: INT ← 0;
ReadSpecs:
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];
};
WriteSpecs:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE] ~ {
localStyle: LocalStyle ← NARROW[value];
RETURN [IF localStyle=NIL THEN NIL ELSE localStyle.def];
};
CopyInfoProc:
PROC [name:
ATOM, value:
REF]
RETURNS [new:
REF] ~ {
RETURN [value] };
Apply Style to Node
defaultStyle: PUBLIC Ref ← NIL;
rootFormatName: ATOM;
defaultFormatName: ATOM;
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: ATOM;
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:
ATOM, kind: OfStyle] ~ {
ext: ATOM;
ref.isComment ← IF node # NIL THEN node.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.GetProp[node, $Prefix], 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.GetProp[node, $Postfix], kind];
ApplyAll Cache
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;
-- when clearing, go all the way to applyCacheSize rather than stopping at applyCacheDepth
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;
};
Update ApplyAll Cache due to Editing Operations
Change: TYPE ~ EditNotify.Change;
Notify:
PROC [change:
REF
READONLY Change] ~ {
if change invalidates one node only, remove that node
else clear entire cache
DoNode:
PROC [node: TextNode.Ref] ~ {
IF TextNode.FirstChild[node] # NIL THEN FlushApplyAllCache[]
ELSE RemoveNodeFromApplyAllCache[node]
};
WITH change
SELECT
FROM
x: REF READONLY Change.InsertingNode => IF TextNode.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 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;
x: REF READONLY Change.ChangingFormat => DoNode[x.node];
x:
REF
READONLY Change.ChangingProp => {
IF NodePropsExtras.Is[x.propAtom, $Visible] THEN DoNode[x.node];
};
ENDCASE => ERROR; -- not expecting notify for any other kinds of changes
};
Style Rule Cache
ApplyFormat:
PUBLIC
PROC [ref: Ref, name, alt:
ATOM, kind: OfStyle] ~ {
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] };
NIL => 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
NIL => 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 = NIL AND (name ← alt) = NIL THEN RETURN;
loc ← 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];
};
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 ATOM;
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] ← NIL; ENDLOOP;
};
HashStyle:
PROC [ref: Ref, looks: TextLooks.Looks ← TextLooks.noLooks, anotherRef:
REF ←
NIL]
RETURNS [
CARDINAL] ~
TRUSTED {
Bits: TYPE ~ MACHINE DEPENDENT RECORD [
REF, REF, REF, REF, RealCode, RealCode, RealCode, RealCode, TextLooks.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]];
Looks Cache
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 ← 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[];
};
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;
};
Object Cache
ApplyObject:
PUBLIC
PROC [ref: Ref, object: Object, kind: OfStyle ← screen] ~ {
OPEN objectCacheInfo;
objects: REF ObjectCacheObjects ← objectCacheObjects;
inputs: REF ObjectCacheBodies ← objectCacheInputs;
input: StyleBody;
initloc, loc: CARDINAL;
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;
};
IF object = nullObject THEN RETURN;
loc ← initloc ← HashStyle[ref, , object] MOD objectCacheSize;
IF FindInObjectCache[] THEN RETURN;
IF NodeStyleWorks.ExecuteObjectInStyle[ref, kind, object] 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 Object;
ObjectCacheBodies: TYPE ~ ARRAY [0..objectCacheSize) OF StyleBody;
nullObject: Object ~ NIL;
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;
};
Flush Caches
FlushCaches:
PUBLIC
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
ClearCaches[FALSE];
};
ClearCaches:
PROC [init:
BOOL] ~ {
ClearApplyAllCache[init];
ClearRuleCache[init];
ClearLooksCache[init];
ClearObjectCache[init];
};
Style Parameter Extensions
nonNumeric:
PUBLIC
ERROR ~
CODE;
GetStyleParam:
PUBLIC
PROC [s: Ref, name:
ATOM, styleName:
ATOM, kind: OfStyle]
RETURNS [r:
REAL] ~ {
May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
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: Ref, name:
ATOM, styleName:
ATOM, kind: OfStyle]
RETURNS [i:
INTEGER] ~ {
May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
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: Ref, 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];
};
Miscellaneous
StyleNameForNode:
PUBLIC
PROC [node: TextNode.Ref]
RETURNS [name:
ATOM] ~ {
Does an ApplyAll and then returns the style name
s: Ref ← Alloc[];
ApplyAll[s, node];
name ← GetStyleName[s];
Free[s];
};
Initialization
InitializeDefaultStyle:
PUBLIC
PROC [suggestedStyle:
ROPE] ~ {
changeSet: EditNotify.ChangeSet;
PointsPerInch: REAL ~ 1.0/0.0138370;
register the notify proc that updates the style caches when edits occur
changeSet[ChangingProp] ← TRUE;
changeSet[ChangingFormat] ← TRUE;
changeSet[MovingNodes] ← TRUE;
changeSet[NodeNesting] ← TRUE;
changeSet[InsertingNode] ← TRUE;
EditNotify.AddNotifyProc[Notify, after, high, changeSet];
initialize all the style caches
InitApplyCacheRecord[];
InitRuleCacheInfo[];
InitLooksCacheInfo[];
InitObjectCacheInfo[];
ClearCaches[TRUE];
establish the default styles wired into Tioga
defaultStyle ← Create[];
defaultFormatName ← $default;
rootFormatName ← $root;
provide some basic style attribute values in case no style gets loaded successfully
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];
register the special handling procedures for the local style property: StyleDef
NodeProps.Register[name: $StyleDef, reader: ReadSpecs, writer: WriteSpecs, copier: CopyInfoProc];
SetDefaultStyle[suggestedStyle];
};
END.