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
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;
Style Environment
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],
};
Style Operations
Create: PUBLIC PROC RETURNS [Style] ~ {
create a style body
RETURN [NEW[StyleBody]];
};
Copy: PUBLIC PROC [dest, source: Style] ~ {
copy a style body
dest^ ← source^;
};
Alloc: PUBLIC ENTRY PROC [env: Env] RETURNS [s: Style] ~ { OPEN env;
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[];
};
Free: PUBLIC ENTRY PROC [env: Env, s: Style] ~ { OPEN env;
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
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];
};
Apply Style to Node
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];
NodeStyleObsolete.EvalFreeVars[ref, node];
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];
};
ApplyAll Cache
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] ~ {
when clearing, go all the way to applyCacheSize rather than stopping at applyCache.depth
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;
};
Update ApplyAll Cache due to Editing Operations
Change: TYPE ~ TiogaPrivate.Change;
Notify: PROC [change: REF READONLY Change] ~ {
if change invalidates one node only, remove that node
else clear entire cache
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
};
Hashing
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]];
};
Style Rule Cache
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];
};
Looks Cache
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[];
};
Object Cache
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[];
};
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: Style, 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: Style, 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: 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];
};
Miscellaneous
StyleNameForNode: PUBLIC PROC [node: Tioga.Node] RETURNS [name: ATOM] ~ {
Does an ApplyAll and then returns the style name
s: Style ← Alloc[];
ApplyAll[s, node];
name ← GetStyleName[s];
Free[s];
};
Initialization
InitializeDefaultStyle: PUBLIC PROC [world: Tioga.World, suggestedStyle: ROPE] ~ {
changeSet: TiogaPrivate.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;
TiogaPrivate.AddEditNotifyProc[world, 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
Tioga.RegisterProp[name: $StyleDef, reader: ReadStyleDef, writer: WriteStyleDef, copier: CopyStyleDef];
SetDefaultStyle[suggestedStyle];
};
END.