NodeStyleOpsImpl.mesa
Copyright © 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
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;
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 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 ];
};
Local Styles
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] };
Apply Style to Node
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];
};
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
prefixAtom: ATOM = NodeProps.PrefixAtom[];
postfixAtom: ATOM = NodeProps.PostfixAtom[];
Notify: PROC [change: REF READONLY EditNotify.Change] = TRUSTED {
if change invalidates one node only, remove that node
else clear entire cache
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
};
Style Rule Cache
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]];
};
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 ←
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;
};
Object Cache
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;
};
Flush Caches
FlushCaches: PUBLIC ENTRY PROC = {
ENABLE UNWIND => NULL;
ClearCaches[FALSE];
};
ClearCaches: PROC [init: BOOL] = {
ClearApplyAllCache[init];
ClearRuleCache[init];
ClearLooksCache[init];
ClearObjectCache[init];
};
Special Parameter Extensions
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]]];
};
Style Parameter Extensions
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];
};
Miscellaneous
StyleNameForNode: PUBLIC PROC [node: TextNode.Ref] RETURNS [name: Name] = {
Does an ApplyAll and then returns the style name
s: Ref ← Alloc[];
ApplyAll[s, node];
name ← GetStyleName[s];
Free[s];
};
Initialization (must be done after NodeStyleWorks)
Start: PUBLIC PROC = {
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 ← NameSymbolTable.MakeName["default"];
rootFormatName ← NameSymbolTable.MakeName["root"];
provide some basic style attribute values in case no style gets loaded successfully
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];
expect to find Cedar.style when Tioga is loaded
[] ← LoadStyle[defaultStyleName];
register the special handling procedures for the local style property: StyleDef
NodeProps.Register[name: $StyleDef,
reader: ReadSpecsProc, writer: WriteSpecsProc, copier: CopyInfoProc];
};
Start[];
END.