DIRECTORY
BasicTime USING [GMT, nullGMT],
FS USING [Error, FileInfo],
MessageWindow USING [Append, Blink, Clear],
NodeStyle USING [GetReal, RealParam, SetReal, Style],
NodeStyleFont USING [FontFromStyleParams],
NodeStyleOps USING [Create, defaultStyle, defaultStyleName, FlushCaches, LoadStyle, OfStyle],
NodeStyleValidate USING [],
NodeStyleWorks USING [AddRealProc, ForceLowerName, get, LoadProc, Ops, OpsRec, Param, ParamRec, PercentProc, PopName, RegisterStyleCommand, run, SetNameProc, StoreProc, TryToPopName, TypeCheckDict, TypeCheckName],
PrincOpsUtils USING [],
Process USING [GetCurrent],
RefTab USING [Create, Fetch, Pairs, Ref, Store],
Rope USING [Concat, Equal, FromChar, ROPE],
TextLooks USING [Look, Looks],
TJaM USING [ABind, ACopy, AGet, APut, Array, AtomFromRope, AttachDict, Begin, ClrDict, CommandProc, CountStack, CvX, DetachAll, DetachDict, Dict, DictTop, End, Execute, Frame, Load, NewArray, NewDict, NewFrame, Object, Pop, PopDict, PopReal, Push, PushInt, PushReal, PushRope, Put, Register, RopeFromAtom, Stop, TryToGet, TryToLoad],
UserProfile USING [ListOfTokens];
Execution Frames for Style Machinery
ROPE: TYPE ~ Rope.ROPE;
Frame: TYPE ~ TJaM.Frame;
OfStyle: TYPE ~ NodeStyleOps.OfStyle;
Object: TYPE ~ TJaM.Object;
FrameInfo: TYPE ~ REF FrameInfoBody;
FrameInfoBody: TYPE ~ RECORD [ frame: Frame, style: Style, rest: FrameInfo ];
GetFrame:
PUBLIC
PROC [style: Style, styleName:
ATOM, kind: OfStyle]
RETURNS [frame: Frame] ~ {
-- style is the StyleRef you will be using with the frame
-- styleName tells which style dictionary you want
-- will give you default style if requested style bombs during load
found: BOOL;
AllocFrame:
ENTRY
PROC [name:
ATOM, kind: OfStyle] ~ {
ENABLE UNWIND => NULL;
allocFrameCalls ← allocFrameCalls+1;
IF name #
NIL
THEN {
-- first try to find one that already has the right style
IF name = styleName1
AND kind = styleKind1
AND freeFrame1 #
NIL
THEN
{ frame ← freeFrame1; freeFrame1 ← NIL; RETURN };
IF name = styleName2
AND kind = styleKind2
AND freeFrame2 #
NIL
THEN
{ frame ← freeFrame2; freeFrame2 ← NIL; RETURN };
IF name = styleName3
AND kind = styleKind3
AND freeFrame3 #
NIL
THEN
{ frame ← freeFrame3; freeFrame3 ← NIL; RETURN };
IF name = styleName4
AND kind = styleKind4
AND freeFrame4 #
NIL
THEN
{ frame ← freeFrame4; freeFrame4 ← NIL; RETURN }};
-- look for any free one
IF freeFrame1 # NIL THEN { frame ← freeFrame1; freeFrame1 ← NIL }
ELSE IF freeFrame2 # NIL THEN { frame ← freeFrame2; freeFrame2 ← NIL }
ELSE IF freeFrame3 # NIL THEN { frame ← freeFrame3; freeFrame3 ← NIL }
ELSE IF freeFrame4 # NIL THEN { frame ← freeFrame4; freeFrame4 ← NIL }
ELSE {
frame ← TJaM.NewFrame[];
frameAlloc ← frameAlloc+1;
TJaM.Begin[frame, styledict];
};
};
SaveStyleInfo:
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
IF frame1 = NIL THEN { frame1 ← frame; style1 ← style }
ELSE IF frame2 = NIL THEN { frame2 ← frame; style2 ← style }
ELSE IF frame3 = NIL THEN { frame3 ← frame; style3 ← style }
ELSE IF frame4 = NIL THEN { frame4 ← frame; style4 ← style }
ELSE
FOR lst: FrameInfo ← frameList, lst.rest
UNTIL lst=
NIL
DO
IF lst.frame = NIL THEN { lst.frame ← frame; lst.style ← style; EXIT };
REPEAT FINISHED => frameList ← NEW[FrameInfoBody ← [frame, style, frameList]];
ENDLOOP;
};
AllocFrame[styleName, kind]; -- use styleName and kind as hint about which to allocate
IF styleName #
NIL
THEN {
get the proper style dictionary on the frame dictionary stack
styleNameObj: Object;
done: BOOL ← FALSE;
[found, styleNameObj] ← TJaM.TryToLoad[frame, styleDictName];
IF found
THEN {
-- some style dictionary on stack already
IF TypeCheckName[styleNameObj] = styleName
THEN {
-- still must check kind of style
kindNameObj: Object;
[found, kindNameObj] ← TJaM.TryToLoad[frame, styleKindName];
IF found
AND TypeCheckName[kindNameObj] = kindNames[kind]
THEN
done ← TRUE;
}; -- already there
IF
NOT done
THEN
-- get rid of top dictionary
WHILE TJaM.DictTop[frame] # styledict
DO
TJaM.End[frame]; ENDLOOP;
};
IF NOT done THEN TJaM.Begin[frame, GetStyleDict[frame, styleName, kind]]
}
ELSE WHILE TJaM.DictTop[frame] # styledict DO TJaM.End[frame] ENDLOOP;
SaveStyleInfo[];
};
FreeFrame:
PUBLIC
ENTRY
PROC [frame: Frame, styleName:
ATOM, kind: OfStyle] ~ {
name and kind are just a hint about what style dictionary is on the frame stack
ENABLE UNWIND => NULL;
freeFrameCalls ← freeFrameCalls+1;
add it to cache of free frames or really free it if cache full
IF freeFrame1 =
NIL
THEN {
freeFrame1 ← frame; styleName1 ← styleName; styleKind1 ← kind }
ELSE
IF freeFrame2 =
NIL
THEN {
freeFrame2 ← frame; styleName2 ← styleName; styleKind2 ← kind }
ELSE
IF freeFrame3 =
NIL
THEN {
freeFrame3 ← frame; styleName3 ← styleName; styleKind3 ← kind }
ELSE
IF freeFrame4 =
NIL
THEN {
freeFrame4 ← frame; styleName4 ← styleName; styleKind4 ← kind }
ELSE { frameFree ← frameFree+1; }; -- let garbage collector find it
remove it from active frame info
SELECT frame
FROM
frame1 => { frame1 ← NIL; style1 ← NIL };
frame2 => { frame2 ← NIL; style2 ← NIL };
frame3 => { frame3 ← NIL; style3 ← NIL };
frame4 => { frame4 ← NIL; style4 ← NIL };
ENDCASE =>
FOR lst: FrameInfo ← frameList, lst.rest
UNTIL lst=
NIL
DO
IF lst.frame = frame THEN { lst.frame ← NIL; lst.style ← NIL; EXIT };
ENDLOOP;
};
StyleForFrame:
PUBLIC
PROC [frame: Frame]
RETURNS [style: Style] ~ {
GetIt:
ENTRY
PROC
RETURNS [s: Style] ~ {
ENABLE UNWIND => NULL;
SELECT frame
FROM
frame1 => RETURN [style1];
frame2 => RETURN [style2];
frame3 => RETURN [style3];
frame4 => RETURN [style4];
ENDCASE =>
FOR lst: FrameInfo ← frameList, lst.rest
UNTIL lst=
NIL
DO
IF lst.frame=frame THEN RETURN [lst.style];
ENDLOOP };
IF (style ← GetIt[]) =
NIL
THEN {
-- failed to find the frame
IF debugFlag
THEN {
IF debugStyle = NIL THEN debugStyle ← NodeStyleOps.Create[];
RETURN [debugStyle];
};
ERROR;
};
RETURN [style];
};
Style Dictionaries
GetStyleDict:
PUBLIC
PROC [frame: Frame, styleName:
ATOM, kind: OfStyle,
def:
ROPE ←
NIL]
RETURNS [d: TJaM.Dict] ~ {
found, ok: BOOL;
styleName ← ForceLowerName[styleName];
[d, found] ← CheckStyleDict[styleName, kind];
IF found THEN RETURN;
ok ←
IF def #
NIL
THEN RunStyleString[frame, styleName, def]
ELSE RunStyle[frame, styleName];
IF ok THEN [d, found] ← CheckStyleDict[styleName, kind];
IF
NOT found
THEN {
BadStyleFile[frame, styleName];
[d, found] ← CheckStyleDict[styleName, kind];
};
};
BadStyleFile:
PUBLIC
PROC [frame: Frame, styleName:
ATOM] ~ {
fake it so looks as if had a file saying "BeginStyle (default) AttachStyle EndStyle"
{
ENABLE {
WhatStyle => RESUME[styleName];
StartOfStyle => RESUME;
EndOfStyle => RESUME;
};
BeginStyleOp[frame];
IF styleName # NodeStyleOps.defaultStyleName
THEN {
TJaM.Push[frame, NodeStyleOps.defaultStyleName];
AttachStyleOp[frame];
};
EndStyleOp[frame];
};
[] ← RefTab.Store[fileForStyle, styleName, NEW [FileIDRep ← []]];
MessageWindow.Append[TJaM.RopeFromAtom[styleName], TRUE];
MessageWindow.Append[".style could not be loaded."];
MessageWindow.Blink[];
TJaM.Push[frame, styleName];
TJaM.PushRope[frame, "style was bad."];
StyleError[frame, 2];
};
CheckStyleDict:
PROC [styleName:
ATOM, kind: OfStyle]
RETURNS [d: TJaM.Dict, found:
BOOL] ~ {
obj: Object;
[found, obj] ← TJaM.TryToGet[stylesDicts[kind], styleName];
IF found THEN d ← TypeCheckDict[obj];
};
CreateStyleDict:
PROC
RETURNS [d: TJaM.Dict] ~ {
-- creates dict for style
RETURN [TJaM.NewDict[50]];
};
EnterStyleDict:
PROC [styleName:
ATOM, d: Object, kind: OfStyle] ~ {
TJaM.Put[stylesDicts[kind], styleName, d];
};
Style File handling.
Search rule handling
defaultSearch:
LIST
OF
ROPE ←
LIST["[]<>Commands>", "[]<>"];
FileID: TYPE ~ REF FileIDRep;
FileIDRep: TYPE ~ RECORD [name: ROPE ← NIL, time: BasicTime.GMT ← BasicTime.nullGMT];
Same:
PROC [a, b: FileID]
RETURNS [
BOOL] ~ {
RETURN [a.time = b.time AND Rope.Equal[a.name, b.name, FALSE]]
};
GetFileID:
PROC [shortName:
ATOM, extension:
ROPE]
RETURNS [FileID] ~ {
dirs: LIST OF ROPE ← UserProfile.ListOfTokens["Tioga.StyleSearchRules", defaultSearch];
name: ROPE ~ Rope.Concat[TJaM.RopeFromAtom[shortName], extension];
fileName: ROPE ← NIL;
created: BasicTime.GMT ← BasicTime.nullGMT;
WHILE fileName =
NIL
AND dirs #
NIL
DO
[fullFName: fileName, created: created] ← FS.FileInfo[name: name, wDir: dirs.first ! FS.Error => CONTINUE];
dirs ← dirs.rest;
ENDLOOP;
IF fileName = NIL THEN RETURN [NIL];
RETURN [NEW[FileIDRep ← [fileName, created]]];
};
Locking to avoid concurrent changes to internal style representation.
DoLocked:
PUBLIC
PROC [action:
PROC] ~ {
me: UNSAFE PROCESS ~ Process.GetCurrent[];
Lock:
ENTRY
PROC ~ {
UNTIL styleLockProcess = me OR styleLockCount = 0 DO WAIT styleLockFree ENDLOOP;
styleLockProcess ← me; styleLockCount ← styleLockCount + 1;
};
Unlock:
ENTRY
PROC ~ {
styleLockCount ← styleLockCount - 1;
IF styleLockCount = 0 THEN {styleLockProcess ← NIL; NOTIFY styleLockFree};
};
Lock[];
action[ ! UNWIND => Unlock[]];
Unlock[];
};
Running styles and validation of style to file correspondence.
ValidateStyles:
PUBLIC
PROC
RETURNS [changed:
BOOL ←
FALSE] ~ {
Called from elsewhere in Tioga when something changes that may have changed any style.
Does not attempt to refresh screen.
Locked:
PROC ~ {
Action:
PROC [key:
REF, val:
REF]
RETURNS [quit:
BOOLEAN] ~ {
IF ValidateStyle[NARROW[key]] THEN changed ← TRUE;
RETURN [FALSE]
};
[] ← RefTab.Pairs[fileForStyle, Action];
};
DoLocked[Locked];
};
ValidateStyle:
PUBLIC
PROC [styleName:
ATOM]
RETURNS [changed:
BOOL ←
FALSE] ~ {
Called from elsewhere in Tioga when something changes that may have changed a style.
Does not attempt to refresh screen.
Locked:
PROC ~ {
fileID: FileID ~ GetFileID[styleName, ".style"];
oldFileID: FileID ~ NARROW[RefTab.Fetch[fileForStyle, styleName].val];
IF oldFileID =
NIL
OR fileID =
NIL
OR Same[fileID, oldFileID]
THEN changed ← FALSE
ELSE {
frame: Frame ← GetFrame[NIL, NIL, screen];
IF NOT RunStyle[frame, styleName] THEN BadStyleFile[frame, styleName];
FreeFrame[frame, NIL, screen];
changed ← TRUE;
};
};
DoLocked[Locked];
};
RunStyle:
PUBLIC
PROC [frame: Frame, styleName:
ATOM]
RETURNS [ok:
BOOL ←
FALSE] ~ {
Inner:
PROC ~ {
started, finished: BOOL ← FALSE;
this is probably where the use of working directories for style files needs to be added
fileID: FileID ~ GetFileID[styleName, ".style"];
TJaM.Put[attachmentsDict, styleName, TJaM.NewArray[0]];
IF fileID = NIL THEN {ok ← FALSE; RETURN};
MessageWindow.Append["Using ", runNesting=0];
MessageWindow.Append[fileID.name, FALSE];
MessageWindow.Append[" . . . ", FALSE];
runNesting ← runNesting + 1;
TJaM.PushRope[frame, fileID.name];
TJaM.Execute[frame, run !
WhatStyle => RESUME[styleName];
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
TJaM.Stop => { finished ← FALSE; CONTINUE };
];
runNesting ← runNesting - 1;
ok ← started AND finished;
IF ok THEN MessageWindow.Append["ok ", FALSE];
IF ok THEN [] ← RefTab.Store[fileForStyle, styleName, fileID];
IF ok AND runNesting=0 THEN MessageWindow.Clear[];
};
DoLocked[Inner];
};
RunStyleString:
PUBLIC
PROC [frame: Frame, styleName:
ATOM, def:
ROPE]
RETURNS [ok:
BOOL] ~ {
started, finished: BOOL ← FALSE;
TJaM.Put[attachmentsDict, styleName, TJaM.NewArray[0]];
TJaM.Execute[frame, TJaM.CvX[def] !
WhatStyle => { RESUME[styleName] };
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
TJaM.Stop => { finished ← FALSE; CONTINUE };
];
RETURN [started AND finished];
};
styleDictName: ATOM ~ TJaM.AtomFromRope["##styleDictName"];
styleKindName: ATOM ~ TJaM.AtomFromRope["##styleKindName"];
InitDict:
PUBLIC
PROC [name:
ATOM, size:
CARDINAL ← 100]
RETURNS [dictionary: TJaM.Dict] ~ {
found: BOOL;
d: Object;
[found, d] ← TJaM.TryToGet[sysdict, name];
IF found THEN dictionary ← TypeCheckDict[d]
ELSE {
dictionary ← TJaM.NewDict[size];
TJaM.Put[sysdict, name, dictionary];
}
};
kindNames: REF ARRAY OfStyle OF ATOM ← NEW[ARRAY OfStyle OF ATOM ← [
$screen, $print, $base]];
styleRuleDictNames:
REF
ARRAY OfStyle
OF
ATOM ~
NEW[
ARRAY OfStyle
OF
ATOM ← [
TJaM.AtomFromRope["##BaseStyleRuleDictName"],
TJaM.AtomFromRope["##ScreenStyleRuleDictName"],
TJaM.AtomFromRope["##PrintStyleRuleDictName"]
]];
styleDictNames:
REF
ARRAY OfStyle
OF
ATOM ~
NEW[
ARRAY OfStyle
OF
ATOM ←[
TJaM.AtomFromRope["##BaseStyleDictName"],
TJaM.AtomFromRope["##ScreenStyleDictName"],
TJaM.AtomFromRope["##PrintStyleDictName"]
]];
StartOfStyle: SIGNAL ~ CODE; -- raised to indicate start of loading style
EndOfStyle: SIGNAL ~ CODE; -- raised to indicate successful loading
WhatStyle: SIGNAL RETURNS [ATOM] ~ CODE; -- raised to find name of style being loaded
BeginStyleOp: TJaM.CommandProc ~ {
name: ATOM ← ForceLowerName[SIGNAL WhatStyle]; -- get style name from RunStyle
screenDict, printDict, baseDict: TJaM.Dict;
ResetDict:
PROC [dict: TJaM.Dict] ~ {
TJaM.ClrDict[dict];
TJaM.DetachAll[dict];
};
MakeDict:
PROC [kind: OfStyle]
RETURNS [dict: TJaM.Dict] ~ {
dict ← CreateStyleDict[];
EnterStyleDict[name, dict, kind];
};
SetupDict:
PROC [dict: TJaM.Dict, kind: OfStyle] ~ {
TJaM.Put[baseDict, styleRuleDictNames[kind], TJaM.NewDict[50]];
create rule name dict in baseDict
TJaM.Put[dict, styleKindName, kindNames[kind]];
record the style kind
};
found: BOOL;
[baseDict, found] ← CheckStyleDict[name, base]; -- check if reloading
IF found
THEN {
ResetDict[baseDict];
[printDict, ] ← CheckStyleDict[name, print];
ResetDict[printDict];
[screenDict, ] ← CheckStyleDict[name, screen];
ResetDict[screenDict];
NodeStyleOps.FlushCaches[] }
ELSE {
baseDict ← MakeDict[base];
screenDict ← MakeDict[screen];
printDict ← MakeDict[print] };
SetupDict[baseDict, base]; SetupDict[screenDict, screen]; SetupDict[printDict, print];
TJaM.AttachDict[screenDict, baseDict];
TJaM.AttachDict[printDict, baseDict];
TJaM.Put[baseDict, styleDictNames[screen], screenDict];
TJaM.Put[baseDict, styleDictNames[print], printDict];
TJaM.Put[baseDict, styleDictNames[base], baseDict];
TJaM.Put[baseDict, styleDictName, name];
TJaM.Begin[frame, baseDict];
TJaM.Push[frame, baseDict]; -- leave this around for EndStyleOp
SIGNAL StartOfStyle; -- caught by RunStyle
};
EndStyleOp: TJaM.CommandProc ~ {
d1, d2: TJaM.Dict;
d1 ← TJaM.DictTop[frame]; -- the current dictionary
d2 ← TJaM.PopDict[frame]; -- pushed by StyleOp
IF d1 # d2
THEN {
TJaM.PushRope[frame, "mismatched Style and EndStyle commands"];
StyleError[frame, 1];
}
ELSE {
-- change attachments so look in own basicDict before any attached dicts
name: ATOM ← SIGNAL WhatStyle;
screenDict: TJaM.Dict ~ CheckStyleDict[name, screen].d;
printDict: TJaM.Dict ~ CheckStyleDict[name, print].d;
TJaM.DetachDict[screenDict, d1];
TJaM.DetachDict[printDict, d1];
TJaM.AttachDict[screenDict, d1];
TJaM.AttachDict[printDict, d1];
TJaM.End[frame];
};
SIGNAL EndOfStyle; -- caught by RunStyle
};
StyleNameOp: TJaM.CommandProc ~ {
-- expects style dictionary on op stack
TJaM.Push[frame, TJaM.Load[frame, styleDictName]]
};
StyleRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, base] };
PrintRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, print] };
ScreenRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, screen] };
DefineStyleRule:
PROC [frame: Frame, kind: OfStyle] ~ {
expects <name> <comment> <definition> on op stack
definition: Object ← TJaM.Pop[frame];
comment: Object ← TJaM.Pop[frame];
styleRule: ATOM ← PopName[frame];
name: ATOM ← ForceLowerName[styleRule];
dict: TJaM.Dict ← LoadStyleDict[frame, kind];
WITH definition
SELECT
FROM
x: TJaM.Array => TJaM.ABind[x, bindingDict];
ENDCASE; -- def may be a string
definition ← TJaM.CvX[definition];
TJaM.Put[dict, name, definition]; -- save the definition
IF name # styleRule THEN TJaM.Put[dict, styleRule, definition];
TJaM.Put[LoadStyleRuleDict[frame, kind], name, comment]; -- save the comment in the rule name dict
};
LoadStyleDict:
PROC [frame: Frame, kind: OfStyle]
RETURNS [TJaM.Dict] ~ {
RETURN [TypeCheckDict[TJaM.Load[frame, styleDictNames[kind]]]];
};
LoadStyleRuleDict:
PROC [frame: Frame, kind: OfStyle]
RETURNS [TJaM.Dict] ~ {
RETURN [TypeCheckDict[TJaM.Load[frame, styleRuleDictNames[kind]]]];
};
OpenPrintStyleOp: TJaM.CommandProc ~ {
-- expects style name on op stack
OpenStyle[frame, print];
};
OpenScreenStyleOp: TJaM.CommandProc ~ {
-- expects style name on op stack
OpenStyle[frame, screen];
};
OpenStyle:
PROC [frame: Frame, kind: OfStyle] ~ {
name: ATOM ← PopName[frame];
IF NOT NodeStyleOps.LoadStyle[name] THEN RETURN;
WHILE TJaM.DictTop[frame] # sysdict DO TJaM.End[frame]; ENDLOOP;
TJaM.Begin[frame, styledict];
TJaM.Begin[frame, GetStyleDict[frame, name, kind]];
};
ResetTestStyleOp: TJaM.CommandProc ~ {
IF debugStyle=NIL THEN debugStyle ← NodeStyleOps.Create[];
debugStyle^ ← NodeStyleOps.defaultStyle^;
};
StyleRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, base] };
PrintRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, print] };
ScreenRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, screen] };
GetRuleDict:
PROC [frame: Frame, kind: OfStyle] ~ {
TJaM.Push[frame, styleRuleDictNames[kind]];
TJaM.Execute[frame, get];
};
AttachStyleOp: TJaM.CommandProc ~ {
-- expects opstk to contain style name as a rope
name: ATOM ← ForceLowerName[PopName[frame]];
found: BOOL;
printDict, screenDict: TJaM.Dict;
array: TJaM.Array;
styleName: ATOM ← SIGNAL WhatStyle;
val: Object;
[printDict, found] ← CheckStyleDict[name, print];
IF
NOT found
THEN {
IF RunStyle[frame, name] THEN [printDict, found] ← CheckStyleDict[name, print];
IF
NOT found
THEN {
BadStyleFile[frame, name];
RETURN;
};
};
[screenDict, found] ← CheckStyleDict[name, screen];
IF ~found THEN ERROR;
TJaM.AttachDict[LoadStyleDict[frame, screen], screenDict];
TJaM.AttachDict[LoadStyleDict[frame, print], printDict];
[found, val] ← TJaM.TryToGet[attachmentsDict, styleName];
IF NOT found THEN array ← TJaM.NewArray[1] -- this is the first attachment
ELSE {
-- add new item to the array
WITH val
SELECT
FROM
x: TJaM.Array => array ← x;
ENDCASE => ERROR;
array ← TJaM.ACopy[array, 1];
};
TJaM.APut[array, array.len-1, name];
TJaM.Put[attachmentsDict, styleName, array];
};
ForEachAttachedStyle:
PUBLIC
PROC [dictName:
ATOM, proc:
PROC [attached:
ATOM]
RETURNS [stop:
BOOL]] ~ {
val: Object;
array: TJaM.Array;
found: BOOL;
dictName ← ForceLowerName[dictName];
[found, val] ← TJaM.TryToGet[attachmentsDict, dictName];
IF NOT found THEN RETURN;
WITH val
SELECT
FROM
x: TJaM.Array => array ← x;
ENDCASE => ERROR;
FOR i:
CARDINAL
IN [0..array.len)
DO
IF proc[TypeCheckName[TJaM.AGet[array, i]]] THEN RETURN;
ENDLOOP;
};
Execute Styles
ExecuteObject:
PROC [frame: Frame, object: Object]
RETURNS [ok:
BOOL ←
TRUE] ~ {
Utility routine; ensures same stack depth after execution; does NOT handle TJaM.Stop
initDepth, finalDepth: INT;
initDepth ← TJaM.CountStack[frame];
TJaM.Execute[frame, object];
finalDepth ← TJaM.CountStack[frame];
IF finalDepth # initDepth
THEN {
TJaM.PushRope[frame, "Failed to leave stack at same depth after execution.\n"];
TJaM.Push[frame, object];
StyleError[frame, 2];
ok ← FALSE;
};
ExecuteName:
PUBLIC
PROC [frame: Frame, name:
ATOM]
RETURNS [ok:
BOOL] ~ {
makes sure that same stack depth after execute
oldName: ATOM ← executingName;
[ok, ] ← TJaM.TryToLoad[frame, name];
executingName ← name;
IF ok THEN ok ← ExecuteObject[frame, name ! TJaM.Stop => {ok ← FALSE; CONTINUE}];
executingName ← oldName;
ExecuteNameInStyle:
PUBLIC
PROC [ref: Style, kind: OfStyle, styleRule:
ATOM]
RETURNS [ok:
BOOL] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
ok ← ExecuteName[frame, styleRule];
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
ExecuteObjectInStyle:
PUBLIC
PROC [ref: Style, kind: OfStyle, object: Object]
RETURNS [ok:
BOOL ←
TRUE] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
{
ENABLE TJaM.Stop => GO TO stop;
ok ← ExecuteObject[frame, TJaM.CvX[object]];
EXITS stop => ok ← FALSE;
};
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
ExecuteLooksInStyle:
PUBLIC
PROC [ref: Style, kind: OfStyle, looks: TextLooks.Looks]
RETURNS [ok:
BOOL ←
TRUE] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
FOR c:
CHAR
IN TextLooks.Look
DO
IF looks[c] THEN ok ← ExecuteName[frame, lookNames[c]]
ENDLOOP;
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
IF nodeStyleFonts
THEN {
ref.font ← NodeStyleFont.FontFromStyleParams[prefix: ref.name[fontPrefix], family: ref.name[fontFamily], face: ref.fontFace, size: GetReal[ref, fontSize], alphabets: ref.fontAlphabets];
};
};
lookNames: REF LookNames ← NEW[LookNames];
LookNames: TYPE ~ ARRAY TextLooks.Look OF ATOM;
InitLookNames:
PROC ~ {
names are "look.a", "look.b", "look.c", etc.
FOR c:
CHAR
IN TextLooks.Look
DO
lookNames[c] ← TJaM.AtomFromRope[Rope.Concat["look.", Rope.FromChar[c]]];
ENDLOOP;
};
StyleError:
PUBLIC
PROC [frame: Frame, num:
INTEGER] ~ {
TJaM.PushInt[frame, num];
TJaM.Execute[frame, $StyleError ! TJaM.Stop => CONTINUE];
};
Initialization
RegisterWorks1:
PUBLIC
PROC [frame: Frame] ~ {
InitLookNames[];
register the various style commands and JaM commands in this module
RegisterStyleCommand[frame, $BeginStyle, BeginStyleOp];
RegisterStyleCommand[frame, $EndStyle, EndStyleOp];
RegisterStyleCommand[frame, $StyleRule, StyleRuleOp];
RegisterStyleCommand[frame, $PrintRule, PrintRuleOp];
RegisterStyleCommand[frame, $ScreenRule, ScreenRuleOp];
RegisterStyleCommand[frame, $AttachStyle, AttachStyleOp];
TJaM.Register[frame, $StyleName, StyleNameOp];
TJaM.Register[frame, $OpenPrintStyle, OpenPrintStyleOp];
TJaM.Register[frame, $OpenScreenStyle, OpenScreenStyleOp];
TJaM.Register[frame, $ResetTestStyle, ResetTestStyleOp];
TJaM.Register[frame, $StyleRuleDict, StyleRuleDictOp];
TJaM.Register[frame, $PrintRuleDict, PrintRuleDictOp];
TJaM.Register[frame, $ScreenRuleDict, ScreenRuleDictOp];
};