NodeStyleOpsImpl.mesa
Copyright Ó 1985, 1986, 1988, 1989, 1990, 1991, 1992 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, September 24, 1991 1:06 pm PDT
Rick Beach, March 27, 1985 10:54:03 am PST
Bier, February 22, 1989 11:11:16 am PST
Spreitze, July 9, 1990 5:36 pm PDT
Doug Wyatt, June 19, 1992 4:29 pm PDT
DIRECTORY
Atom USING [GetPName, MakeAtom],
CodeTimer USING [StartInt, StopInt],
Convert USING [RopeFromInt],
EditNotify USING [AddNotifyProc, Change, ChangeSet],
IO USING [PutFR],
NodeProps,
NodeStyle USING [DataEntry, DataList, FontAlphabets, FontFace, GetName, IntegerValue, MaxNestingLevel, PointsPerFil, PointsPerInch, RealCode, Ref, SetName, SetReal, StyleBody],
NodeStyleOps USING [ExtObjPair, LocalStyle, LocalStyleRec, OfStyle],
NodeStyleWorks USING [BadStyleFile, ExecuteLooksInStyle, ExecuteNameInStyle, ExecuteObjectInStyle, ForceLowerName, ForceLowerRope, FreeFrame, GetFrame, GetStyleDict, RunStyle, StyleError, StyleParamKey, Where, WhoIsExecuting],
Rope USING [Cat, Concat, ROPE],
TextEdit USING [GetFormat, Size],
Tioga USING [Node, Looks, noLooks],
TextNode USING [FirstChild, Level, LocNumber, Parent],
TJaM USING [Frame, NumberRep, Object, Push, PushRope, Stop, TryToLoad],
TRawHash USING [RawHash];
NodeStyleOpsImpl: CEDAR MONITOR
IMPORTS Atom, CodeTimer, Convert, EditNotify, IO, NodeProps, NodeStyle, NodeStyleWorks, Rope, TextEdit, TextNode, TJaM, TRawHash
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­;
};
s1, s2, s3: Ref ¬ NIL; -- the small cache of style refs
Alloc: PUBLIC ENTRY PROC RETURNS [s: Ref] ~ {
get from a small cache
ENABLE UNWIND => NULL;
SELECT TRUE FROM
s3 # NIL => { s ¬ s3; s3 ¬ NIL };
s2 # NIL => { s ¬ s2; s2 ¬ NIL };
s1 # NIL => { s ¬ s1; s1 ¬ NIL };
ENDCASE => {
CodeTimer.StartInt[$AllocNewNodeStyle, $PTioga];
s ¬ Create[];
CodeTimer.StopInt[$AllocNewNodeStyle, $PTioga];
};
};
Free: PUBLIC ENTRY PROC [s: Ref] ~ {
don't free more than once or disaster!
ENABLE UNWIND => NULL;
SELECT TRUE FROM
s3 = NIL => { s3 ¬ s };
s2 = NIL => { s2 ¬ s };
s1 = NIL => { s1 ¬ s };
ENDCASE => NULL;
};
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[NodeStyleWorks.ForceLowerRope[Atom.GetPName[name]]]];
};
name ¬ NodeStyleWorks.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.FreeFrame[frame, NIL, kind] ELSE NodeStyleWorks.BadStyleFile[frame, name];
ENDLOOP;
};
Local Styles
defaultStyleName: PUBLIC ATOM;
defaultStylesForExtensions: PUBLIC LIST OF ExtObjPair;
SetDefaultStyle: PUBLIC PROC [name: ROPE] ~ {
defaultStyleName ¬ Atom.MakeAtom[NodeStyleWorks.ForceLowerRope[name]];
defaultStyle.name[style] ¬ defaultStyleName;
FlushCaches[];
};
SetExtensionStyles: PUBLIC PROC [value: LIST OF ROPE] ~ {
defaultStylesForExtensions ¬ NIL;
UNTIL value=NIL OR value.rest=NIL DO
ext: ATOM ¬ Atom.MakeAtom[NodeStyleWorks.ForceLowerRope[value.first]]; -- the extension
styleObject: Object ¬ Rope.Cat["\"", NodeStyleWorks.ForceLowerRope[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: Tioga.Node, kind: OfStyle ¬ screen] ~ {
CodeTimer.StartInt[$ApplyAll, $PTioga];
[] ¬ DoApplyAll[ref, node, kind];
CodeTimer.StopInt[$ApplyAll, $PTioga];
};
DoApplyAll: PROC [ref: Ref, node: Tioga.Node, kind: OfStyle]
RETURNS [depth: CARDINAL] ~ {
found: BOOL;
parent: Tioga.Node;
alt: ATOM;
IF node = NIL THEN { ref­ ¬ defaultStyle­; ref.kind ← kind; 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: Tioga.Node, alt: ATOM, kind: OfStyle] ~ {
ENABLE NodeStyleWorks.Where => {
loc1: INT;
loc2: INT;
msg: ROPE;
CodeTimer.StartInt[$NodeStyleWorksWhere, $PTioga];
loc1 ¬ TextNode.LocNumber[at: [node, 0], skipCommentNodes: FALSE];
loc2 ¬ TextNode.LocNumber[at: [node, TextEdit.Size[node]], skipCommentNodes: FALSE];
msg ¬ IO.PutFR["%g..%g", [integer[loc1]], [integer[loc2]]];
CodeTimer.StopInt[$NodeStyleWorksWhere, $PTioga];
RESUME[msg];
};
ext: ATOM;
CodeTimer.StartInt[$ApplyForNode, $PTioga];
ref.isComment ¬ IF node # NIL THEN node.comment ELSE FALSE;
ref.kind ¬ kind;
ref.nestingLevel ¬ MIN[TextNode.Level[node], MaxNestingLevel];
NodeStyleObsolete.EvalFreeVars[ref, node];
IF node.hasStyleDef THEN {
localStyle: LocalStyle ¬ NARROW[NodeProps.GetProp[node, NodeProps.nameStyleDef]];
IF localStyle # NIL THEN ref.name[style] ¬ localStyle.name;
};
IF node.hasPrefix
THEN {
ApplyObject[ref, NodeProps.GetProp[node, NodeProps.namePrefix], kind ! NodeStyleWorks.WhoIsExecuting => {RESUME[$Prefix]}];
}
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, TextEdit.GetFormat[node], alt, kind];
IF node.hasPostfix THEN {
ApplyObject[ref, NodeProps.GetProp[node, NodeProps.namePostfix], kind ! NodeStyleWorks.WhoIsExecuting => {RESUME[$Postfix]}];
};
CodeTimer.StopInt[$ApplyForNode, $PTioga];
};
ApplyAll Cache
ac: 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 Tioga.Node;
ApplyCacheResults: TYPE ~ ARRAY [0..applyCacheSize) OF StyleBody;
InitApplyCacheRecord: PROC ~ {
ac.applyCacheResults ¬ NEW[ApplyCacheResults];
ac.applyCacheNodes ¬ NEW[ApplyCacheNodes];
};
RemoveAllFromApplyAllCache: PUBLIC PROC ~ { FlushApplyAllCache[] };
FlushApplyAllCache: PUBLIC ENTRY PROC [init: BOOL ¬ FALSE] ~ {
ENABLE UNWIND => NULL;
ClearApplyAllCache[init];
};
ClearApplyAllCache: PROC [init: BOOL] ~ {
nodes: REF ApplyCacheNodes ¬ ac.applyCacheNodes;
-- when clearing, go all the way to applyCacheSize rather than stopping at ac.applyCacheDepth
FOR i: CARDINAL IN [0..applyCacheSize) DO nodes[i] ¬ NIL; ENDLOOP;
ac.applyCacheDepth ¬ 0;
};
RemoveNodeFromApplyAllCache: PUBLIC ENTRY PROC [node: Tioga.Node] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ¬ ac.applyCacheNodes;
FOR i: CARDINAL IN [0..ac.applyCacheDepth) DO
IF nodes[i]=node THEN { -- clear from here on
FOR j: CARDINAL IN [i..applyCacheSize) DO
nodes[j] ¬ NIL;
ENDLOOP;
ac.applyCacheDepth ¬ i; EXIT
};
ENDLOOP;
};
FindInApplyAllCache: ENTRY PROC [ref: Ref, node: Tioga.Node, kind: OfStyle]
RETURNS [found: BOOL, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ¬ ac.applyCacheNodes;
CodeTimer.StartInt[$FindInApplyAllCache, $PTioga];
ac.applyCacheProbes ¬ ac.applyCacheProbes+1;
FOR i: CARDINAL DECREASING IN [0..ac.applyCacheDepth) DO
CodeTimer.StartInt[$FindInApplyAllCacheLoop, $PTioga];
IF nodes[i]=node AND kind=ac.applyCacheResults[i].kind THEN { -- found it
ac.applyCacheHits ¬ ac.applyCacheHits+1;
ac.applyCacheSaves ¬ ac.applyCacheSaves+i+1;
ref­ ¬ ac.applyCacheResults[i];
CodeTimer.StopInt[$FindInApplyAllCacheLoop, $PTioga];
RETURN [TRUE, i]
};
CodeTimer.StopInt[$FindInApplyAllCacheLoop, $PTioga];
ENDLOOP;
CodeTimer.StopInt[$FindInApplyAllCache, $PTioga];
RETURN [FALSE, 0];
};
EnterInApplyAllCache: ENTRY PROC [ref: Ref, node: Tioga.Node, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ¬ ac.applyCacheNodes;
CodeTimer.StartInt[$EnterInApplyAllCache, $PTioga];
IF depth >= applyCacheSize THEN RETURN;
nodes[depth] ¬ node;
ac.applyCacheResults[depth] ¬ ref­;
FOR i: CARDINAL IN [depth+1..applyCacheSize) DO nodes[i] ¬ NIL; ENDLOOP;
ac.applyCacheDepth ¬ depth+1;
CodeTimer.StopInt[$EnterInApplyAllCache, $PTioga];
};
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: Tioga.Node] ~ {
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 => FlushApplyAllCache[];
-- Change.NodeNesting used to do the following, but since changing the nesting can change the bottomLeading, for instance, I made this more conservative. -mfp
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.ChangingProp => {
IF NodeProps.Is[x.name, $Visible] THEN DoNode[x.node];
};
ENDCASE => ERROR; -- not expecting notify for any other kinds of changes
};
Style Rule Cache
warnDefault: BOOL ¬ FALSE; -- set this to TRUE to see warnings about missing format definitons
ApplyFormat: PUBLIC PROC [ref: Ref, name, alt: ATOM, kind: OfStyle] ~ {
names: REF RuleCacheNames ¬ rc.ruleCacheNames;
inputs: REF RuleCacheBodies ¬ rc.ruleCacheInputs;
input: StyleBody;
initloc, loc: CARDINAL;
FindInRuleCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
rc.ruleCacheProbes ¬ rc.ruleCacheProbes+1;
DO -- search cache
SELECT names[loc] FROM
name => IF inputs[loc] = ref­ THEN {
ref­ ¬ rc.ruleCacheResults[loc];
rc.ruleCacheHits ¬ rc.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 rc.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;
rc.ruleCacheCount ¬ rc.ruleCacheCount+1;
inputs[loc] ¬ input;
rc.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];
IF warnDefault THEN {
styleName: ATOM ~ NodeStyle.GetName[ref, style];
frame: TJaM.Frame ~ NodeStyleWorks.GetFrame[ref, styleName, kind];
TJaM.Push[frame, alt];
TJaM.PushRope[frame, "format used instead of"];
TJaM.Push[frame, name];
NodeStyleWorks.StyleError[frame, 3 ! TJaM.Stop => CONTINUE];
NodeStyleWorks.FreeFrame[frame: frame, styleName: styleName, kind: kind];
};
};
};
rc: 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 ~ {
rc.ruleCacheNames ¬ NEW[RuleCacheNames];
rc.ruleCacheInputs ¬ NEW[RuleCacheBodies];
rc.ruleCacheResults ¬ NEW[RuleCacheBodies];
};
FlushRuleCache: ENTRY PROC [init: BOOL ¬ FALSE] ~ {
ENABLE UNWIND => NULL;
ClearRuleCache[];
};
ClearRuleCache: PROC [init: BOOL ¬ FALSE] ~ {
names: REF RuleCacheNames ¬ rc.ruleCacheNames;
IF NOT init AND rc.ruleCacheCount = 0 THEN RETURN;
rc.ruleCacheCount ¬ 0;
FOR i: CARDINAL IN [0..ruleCacheSize) DO names[i] ¬ NIL; ENDLOOP;
};
HashStyle: PROC [ref: Ref, 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 [TRawHash.ComputeChecksum[3145, SIZE[Bits], @bits]];
RETURN [TRawHash.RawHash[@bits, SIZE[Bits]]];
};
Looks Cache
ApplyLooks: PUBLIC PROC [ref: Ref, looks: Tioga.Looks, kind: OfStyle] ~ {
lks: REF LooksCacheLooks ¬ lc.looksCacheLooks;
inputs: REF LooksCacheBodies ¬ lc.looksCacheInputs;
initloc, loc: CARDINAL;
input: StyleBody;
FindInLooksCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
lc.looksCacheProbes ¬ lc.looksCacheProbes+1;
DO -- search cache
SELECT lks[loc] FROM
looks => IF inputs[loc] = ref­ THEN {
ref­ ¬ lc.looksCacheResults[loc];
lc.looksCacheHits ¬ lc.looksCacheHits+1;
RETURN [TRUE] };
Tioga.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 lc.looksCacheCount = looksCacheMax THEN ClearLooksCache[];
loc ¬ initloc;
DO -- search cache
SELECT lks[loc] FROM
looks => IF inputs[loc] = input THEN RETURN; -- already in cache
Tioga.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;
lc.looksCacheResults[loc] ¬ ref­;
lks[loc] ¬ looks;
inputs[loc] ¬ input;
lc.looksCacheCount ¬ lc.looksCacheCount+1;
};
IF looks = Tioga.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[];
};
lc: 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 Tioga.Looks;
LooksCacheBodies: TYPE ~ ARRAY [0..looksCacheSize) OF StyleBody;
InitLooksCacheInfo: PROC ~ {
lc.looksCacheLooks ¬ NEW[LooksCacheLooks];
lc.looksCacheInputs ¬ NEW[LooksCacheBodies];
lc.looksCacheResults ¬ NEW[LooksCacheBodies];
};
FlushLooksCache: ENTRY PROC [init: BOOL ¬ FALSE] ~ {
ENABLE UNWIND => NULL;
ClearLooksCache[];
};
ClearLooksCache: PROC [init: BOOL ¬ FALSE] ~ {
IF NOT init AND lc.looksCacheCount = 0 THEN RETURN;
lc.looksCacheCount ¬ 0;
FOR i: CARDINAL IN [0..looksCacheSize) DO lc.looksCacheLooks[i] ¬ Tioga.noLooks; ENDLOOP;
};
Object Cache
ApplyObject: PUBLIC PROC [ref: Ref, object: Object, kind: OfStyle ¬ screen] ~ {
objects: REF ObjectCacheObjects ¬ oc.objectCacheObjects;
inputs: REF ObjectCacheBodies ¬ oc.objectCacheInputs;
input: StyleBody;
initloc, loc: CARDINAL;
FindInObjectCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
oc.objectCacheProbes ¬ oc.objectCacheProbes+1;
DO -- search cache
SELECT objects[loc] FROM
object => IF inputs[loc] = ref­ THEN {
ref­ ¬ oc.objectCacheResults[loc];
oc.objectCacheHits ¬ oc.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 oc.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;
oc.objectCacheCount ¬ oc.objectCacheCount+1;
inputs[loc] ¬ input;
oc.objectCacheResults[loc] ¬ ref­;
objects[loc] ¬ object;
};
CodeTimer.StartInt[$ApplyObject, $PTioga];
IF object = nullObject THEN {
CodeTimer.StopInt[$ApplyObject, $PTioga];
RETURN;
};
loc ¬ initloc ¬ HashStyle[ref, , object] MOD objectCacheSize;
IF FindInObjectCache[] THEN {
CodeTimer.StopInt[$ApplyObject, $PTioga];
RETURN;
};
input ¬ ref­; -- save the input value of the record
IF NodeStyleWorks.ExecuteObjectInStyle[ref, kind, object] THEN PutInObjectCache[];
CodeTimer.StopInt[$ApplyObject, $PTioga];
};
oc: 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 ~ {
oc.objectCacheObjects ¬ NEW[ObjectCacheObjects];
oc.objectCacheInputs ¬ NEW[ObjectCacheBodies];
oc.objectCacheResults ¬ NEW[ObjectCacheBodies];
};
FlushObjectCache: ENTRY PROC [init: BOOL ¬ FALSE] ~ {
ENABLE UNWIND => NULL;
ClearObjectCache[];
};
ClearObjectCache: PROC [init: BOOL ¬ FALSE] ~ {
IF NOT init AND oc.objectCacheCount = 0 THEN RETURN;
oc.objectCacheCount ¬ 0;
FOR i: CARDINAL IN [0..objectCacheSize) DO oc.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: Tioga.Node] RETURNS [name: ATOM] ~ {
Does an ApplyAll and then returns the style name
s: Ref ~ Alloc[];
ApplyAll[s, node];
name ¬ NodeStyle.GetName[s, style];
Free[s];
};
Initialization
InitializeDefaultStyle: PUBLIC PROC [suggestedStyle: ROPE] ~ {
changeSet: EditNotify.ChangeSet;
in: REAL ~ NodeStyle.PointsPerInch;
register the notify proc that updates the style caches when edits occur
changeSet[ChangingProp] ¬ 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
SetName[defaultStyle, fontFamily, $Helvetica];
SetReal[defaultStyle, fontSize, 10];
SetReal[defaultStyle, leading, 12];
SetReal[defaultStyle, topLeading, 12];
SetReal[defaultStyle, topIndent, 12];
SetReal[defaultStyle, tabStops, 20];
SetReal[defaultStyle, pageWidth, 8.5*in];
SetReal[defaultStyle, pageLength, 11*in];
SetReal[defaultStyle, leftMargin, 1*in];
SetReal[defaultStyle, rightMargin, 1*in];
SetReal[defaultStyle, topMargin, 1*in];
SetReal[defaultStyle, bottomMargin, 1*in];
SetReal[defaultStyle, lineLength, 6.5*in];
SetReal[defaultStyle, underlineThickness, 1];
SetReal[defaultStyle, underlineDescent, 1];
SetReal[defaultStyle, strikeoutThickness, 1];
SetReal[defaultStyle, strikeoutAscent, 4];
SetReal[defaultStyle, maxVerticalExpansion, 3];
SetReal[defaultStyle, maxHorizontalExpansion, NodeStyle.PointsPerFil];
SetReal[defaultStyle, hyphenCode, ORD['-]];
register the special handling procedures for the local style property: StyleDef
NodeProps.Register[name: $StyleDef, reader: ReadSpecs, writer: WriteSpecs, copier: CopyInfoProc];
SetDefaultStyle[suggestedStyle];
};
END.