NodeStyleExtraImpl.mesa
Written by Bill Paxton, January 1981
Paxton, June 3, 1983 3:35 pm
Maxwell, January 6, 1983 10:05 am
Russ Atkinson, September 26, 1983 3:07 pm
Paul Rovner, August 10, 1983 4:43 pm
DIRECTORY
Ascii,
Atom,
Convert,
JaMBasic,
JaMOps,
JaMVM,
MessageWindow,
NameSymbolTable,
NodeProps,
NodeStyle,
NodeStyleExtra,
NodeStyleObject,
Process,
Rope,
TextLooks,
TextNode,
UserProfile;
NodeStyleExtraImpl: MONITOR
IMPORTS
Ascii, Atom, Convert, JaMOps, JaMVM, Process, Rope, MessageWindow, TextNode, NodeProps, NodeStyle, NodeStyleExtra, NameSymbolTable
EXPORTS
NodeStyle, NodeStyleExtra, NodeStyleObject
= BEGIN OPEN NodeStyle, NodeStyleExtra;
-- Styles, StyleNames, and Frames
FrameInfo: TYPE = REF FrameInfoBody;
FrameInfoBody: TYPE = RECORD [ frame: Frame, style: Ref, rest: FrameInfo ];
defaultStyleRope: Rope.Text;
defaultStyleName: PUBLIC Name;
defaultStylesForExtensions: PUBLIC LIST OF ExtObjPair;
SetDefaultStyle: PUBLIC SAFE PROC [name: Rope.ROPE] = TRUSTED {
defaultStyleRope ← Rope.Flatten[name];
defaultStyleName ← ForceLower[MakeName[
LOOPHOLE[defaultStyleRope, REF READONLY TEXT]]];
defaultStyle.name[style] ← defaultStyleName;
FlushCaches[] };
SetExtensionStyles: PUBLIC SAFE PROC [value: LIST OF Rope.ROPE] = TRUSTED {
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]] };
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[] };
GetFrame: PUBLIC SAFE PROC [style: Ref, styleName: Name, kind: OfStyle]
RETURNS [frame: Frame] = TRUSTED {
-- 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 one bombs during load
found: BOOL;
AllocFrame: ENTRY PROC [name: Name, kind: OfStyle] = {
ENABLE UNWIND => NULL;
allocFrameCalls ← allocFrameCalls+1;
IF name # NameSymbolTable.nullName 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 ← JaMOps.NewFrame[]; frameAlloc ← frameAlloc+1;
JaMOps.Begin[frame,sysdict];
JaMOps.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 ← TextNode.pZone.NEW[FrameInfoBody ← [frame,style,frameList]];
ENDLOOP };
AllocFrame[styleName,kind]; -- use styleName and kind as hint about which to allocate
IF styleName # NameSymbolTable.nullName THEN {
-- get the proper style dictionary on the frame dictionary stack
styleNameObj: Object;
done: BOOL ← FALSE;
[found,styleNameObj] ← JaMOps.TryToLoad[frame,NameToObject[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] ← JaMOps.TryToLoad[frame,NameToObject[styleKindName]];
IF found AND TypeCheckName[kindNameObj]=kindNames[kind] THEN
done ← TRUE }; -- already there
IF ~done THEN -- get rid of top dictionary
WHILE JaMOps.TopDict[frame.dictstk] # styledict DO
JaMOps.End[frame]; ENDLOOP };
IF ~done THEN JaMOps.Begin[frame,GetStyleDict[frame,styleName,kind]] }
ELSE WHILE JaMOps.TopDict[frame.dictstk] # styledict DO JaMOps.End[frame]; ENDLOOP;
SaveStyleInfo };
-- info about active frames
frame1, frame2, frame3, frame4: Frame ← NIL;
frameAlloc: INT ← 0; -- number of frames allocated from JaM
frameFree: INT ← 0; -- number of frames freed by JaM
allocFrameCalls: INT ← 0; -- number of times called AllocFrame
freeFrameCalls: INT ← 0; -- number of times called FreeFrame. should = allocFrameCalls
style1, style2, style3, style4: Ref;
frameList: FrameInfo;
debugFlag: BOOL ← TRUE;
debugStyle: Ref;
StyleForFrame: PUBLIC SAFE PROC [frame: Frame] RETURNS [style: Ref] = TRUSTED {
GetIt: ENTRY PROC RETURNS [s: Ref] = INLINE {
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 ← Create[];
RETURN [debugStyle] };
ERROR };
RETURN [style] };
-- info about free frames
freeFrame1, freeFrame2, freeFrame3, freeFrame4: Frame ← NIL;
styleName1, styleName2, styleName3, styleName4: Name ← NameSymbolTable.nullName;
styleKind1, styleKind2, styleKind3, styleKind4: OfStyle ← screen;
FreeFrame: PUBLIC ENTRY SAFE PROC [frame: Frame, name: Name, kind: OfStyle] = TRUSTED {
-- 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 ← name; styleKind1 ← kind }
ELSE IF freeFrame2 = NIL THEN {
freeFrame2 ← frame; styleName2 ← name; styleKind2 ← kind }
ELSE IF freeFrame3 = NIL THEN {
freeFrame3 ← frame; styleName3 ← name; styleKind3 ← kind }
ELSE IF freeFrame4 = NIL THEN {
freeFrame4 ← frame; styleName4 ← name; styleKind4 ← kind }
ELSE { frameFree ← frameFree+1; JaMOps.FreeFrame[frame] }; -- really free 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;
};
-- Local styles
number: INT ← 0;
ReadSpecsProc: SAFE PROC
[name: ATOM, specs: Rope.ROPE] RETURNS [value: REF] = TRUSTED {
GenLocalName: ENTRY PROC RETURNS [gen: Rope.ROPE] = {
number ← number + 1;
gen ← Rope.Concat["LocalStyle-", Convert.RopeFromInt[number]];
};
localStyle: LocalStyle ← TextNode.pZone.NEW[LocalStyleRec];
localStyleName: Rope.ROPE = GenLocalName[];
localStyle.name ← NameSymbolTable.MakeNameFromRope[localStyleName];
localStyle.def ← specs;
[] ← DefineStyle[localStyle.name, specs];
RETURN [localStyle];
};
WriteSpecsProc: SAFE PROC
[name: ATOM, value: REF] RETURNS [specs: Rope.ROPE] = TRUSTED {
localStyle: LocalStyle ← NARROW[value];
RETURN [IF localStyle=NIL THEN NIL ELSE localStyle.def];
};
CopyInfoProc: SAFE PROC [name: ATOM, value: REF] RETURNS [new: REF] =
TRUSTED { RETURN [value] };
-- Load style procedures
LoadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
frame: Frame ← GetFrame[NIL,NameSymbolTable.nullName,screen];
[] ← GetStyleDict[frame,name,screen];
FreeFrame[frame,NameSymbolTable.nullName,screen];
RETURN [TRUE] };
DefineStyle: PUBLIC SAFE PROC
[name: Name, def: Rope.ROPE] RETURNS [ok: BOOL] = TRUSTED {
frame: Frame ← GetFrame[NIL,NameSymbolTable.nullName,screen];
IF def=NIL THEN BadStyleFile[frame,name]
ELSE [] ← GetStyleDict[frame,name,screen,def];
FreeFrame[frame,NameSymbolTable.nullName,screen];
RETURN [TRUE] };
ReloadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
frame: Frame ← GetFrame[NIL,NameSymbolTable.nullName,screen];
name ← ForceLower[name];
ok ← RunStyle[frame,name];
IF ~ok THEN BadStyleFile[frame,name];
FreeFrame[frame,NameSymbolTable.nullName,screen ] };
GetStyleDict: PROC [frame: Frame, name: Name, kind: OfStyle, def: Rope.ROPE ← NIL]
RETURNS [d: dict Object] = {
found, ok: BOOL;
name ← ForceLower[name];
[d, found] ← CheckStyleDict[name,kind];
IF found THEN RETURN;
ok ← IF def # NIL THEN RunStyleString[frame,name,def] ELSE RunStyle[frame,name];
IF ok THEN [d,found] ← CheckStyleDict[name,kind];
IF ~found THEN {
BadStyleFile[frame,name];
[d, found] ← CheckStyleDict[name,kind] }};
BadStyleFile: PROC [frame: Frame, name: Name] = {
-- fake it so looks as if had a file saying BeginStyle (default) AttachStyle EndStyle
{ ENABLE BEGIN
WhatStyle => { styleName ← name; RESUME };
StartOfStyle => RESUME;
EndOfStyle => RESUME;
END;
BeginStyleOp[frame];
IF name # defaultStyleName THEN {
PushName[frame,defaultStyleName]; AttachStyleOp[frame] };
EndStyleOp[frame] };
Process.Detach[FORK BadStyleMessage[name]];
PushName[frame,name];
PushText[frame,"style was bad."];
StyleError[frame,2] };
BadStyleMessage: PROC [name: Name] = {
-- need to fork this so to avoid monitor deadlock in viewers
MessageWindow.Append[NameSymbolTable.RopeFromName[name],TRUE];
MessageWindow.Append[".style could not be loaded."] };
CreateStyleDict: PROC RETURNS [d: dict Object] = { -- creates dict for style
RETURN [JaMOps.Dict[50]] };
EnterStyleDict: PROC [name: Name, d: Object, kind: OfStyle] = INLINE {
JaMOps.Put[stylesDicts[kind],NameToObject[name],d] };
CheckStyleDict: PROC [name: Name, kind: OfStyle] RETURNS [d: dict Object, found: BOOL] = {
obj: Object;
[found,obj] ← JaMOps.TryToGet[stylesDicts[kind],NameToObject[name]];
IF found THEN d ← TypeCheckDict[obj] };
RunStyle: PROC [frame: Frame, name: Name] RETURNS [ok: BOOL] = {
txt: REF TEXT ← TextNode.pZone.NEW[TEXT[64]];
ext: STRING = ".style";
txtlen: NAT;
hasExt, started, finished: BOOL ← FALSE;
NameSymbolTable.FromName[name,txt];
txtlen ← txt.length;
FOR i:NAT IN [0..txtlen) DO -- see if has an extension already
IF txt[i] = '. THEN { hasExt ← TRUE; EXIT }; ENDLOOP;
FOR i:NAT IN [0..ext.length) DO txt[txtlen+i] ← ext[i]; ENDLOOP;
txt.length ← txtlen+ext.length;
PushText[frame,LOOPHOLE[txt,LONG STRING]];
JaMOps.Put[attachmentsDict, NameToObject[name], JaMOps.Array[0]];
JaMOps.Execute[frame, run !
WhatStyle => { styleName ← name; RESUME };
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
];
RETURN [started AND finished] };
RunStyleString: PROC [frame: Frame, name: Name, def: Rope.ROPE]
RETURNS [ok: BOOL] = {
started, finished: BOOL ← FALSE;
JaMOps.Put[attachmentsDict, NameToObject[name], JaMOps.Array[0]];
JaMOps.Execute[frame,
CVX[JaMOps.MakeString[LOOPHOLE[Rope.Flatten[def],LONG STRING]]] !
WhatStyle => { styleName ← name; RESUME };
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
];
RETURN [started AND finished] };
-- Registered commands
styleDictName: Name = MakeName["##styleDictName"];
styleKindName: Name = MakeName["##styleKindName"];
StartOfStyle: SIGNAL = CODE; -- raised to indicate start of loading style
EndOfStyle: SIGNAL = CODE; -- raised to indicate successful loading
WhatStyle: SIGNAL RETURNS [styleName: Name] = CODE; -- raised to find name of style being loaded
ForceLower: PROC [n: Name] RETURNS [Name] = { OPEN JaMBasic;
nameObj: Object = NameToObject[n];
name: name Object = WITH x:nameObj SELECT FROM name => x, ENDCASE => ERROR;
str: string Object = JaMOps.NameToString[name];
force: PROC [c: CHAR] RETURNS [stop: BOOL] = {
string[i] ← IF c IN ['A..'Z] THEN c-'A+'a ELSE c;
i ← i+1;
RETURN [FALSE] };
string: STRING ← [100];
i: CARDINAL ← 0;
JaMOps.StringForAll[str, force];
string.length ← i;
RETURN [TypeCheckName[JaMOps.MakeName[string,name.tag]]] };
BeginStyleOp: PROC [frame: Frame] = {
name: Name ← ForceLower[SIGNAL WhatStyle]; -- get style name from RunStyle
screenDict, printDict, baseDict: dict Object;
ResetDict: PROC [dict: dict Object] = { JaMOps.ClrDict[dict]; JaMOps.DetachAll[dict] };
MakeDict: PROC [kind: OfStyle] RETURNS [dict: dict Object] = {
dict ← CreateStyleDict[]; EnterStyleDict[name,dict,kind] };
InitDict: PROC [dict: dict Object, kind: OfStyle] = {
JaMOps.Put[baseDict,NameToObject[styleRuleDictNames[kind]],JaMOps.Dict[50]];
-- create rule name dict in baseDict
JaMOps.Put[dict,NameToObject[styleKindName],NameToObject[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];
FlushCaches[] }
ELSE {
baseDict ← MakeDict[base];
screenDict ← MakeDict[screen];
printDict ← MakeDict[print] };
InitDict[baseDict,base]; InitDict[screenDict,screen]; InitDict[printDict,print];
JaMOps.AttachDict[screenDict,baseDict];
JaMOps.AttachDict[printDict,baseDict];
JaMOps.Put[baseDict,NameToObject[styleDictNames[screen]],screenDict];
JaMOps.Put[baseDict,NameToObject[styleDictNames[print]],printDict];
JaMOps.Put[baseDict,NameToObject[styleDictNames[base]],baseDict];
JaMOps.Put[baseDict,NameToObject[styleDictName],NameToObject[name]];
JaMOps.Begin[frame,baseDict];
PushObject[frame,baseDict]; -- leave this around for EndStyleOp
SIGNAL StartOfStyle --caught by RunStyle-- };
StyleName: PROC [frame: Frame] = { -- expects style dictionary on op stack
PushObject[frame,JaMOps.Load[frame,NameToObject[styleDictName]]] };
EndStyleOp: PROC [frame: Frame] = {
d1, d2: dict Object;
d1 ← JaMOps.TopDict[frame.dictstk]; -- the current dictionary
d2 ← JaMOps.PopDict[frame.opstk]; -- pushed by StyleOp
IF d1 # d2 THEN {
PushText[frame,"mismatched Style and EndStyle commands"];
StyleError[frame,1] }
ELSE { -- change attachments so look in own basicDict before any attached dicts
name: Name ← SIGNAL WhatStyle;
screenDict: dict Object = CheckStyleDict[name,screen].d;
printDict: dict Object = CheckStyleDict[name,print].d;
JaMOps.DetachDict[screenDict,d1];
JaMOps.DetachDict[printDict,d1];
JaMOps.AttachDict[screenDict,d1];
JaMOps.AttachDict[printDict,d1];
JaMOps.End[frame] };
SIGNAL EndOfStyle --caught by RunStyle-- };
styleRuleDictNames: REF ARRAY OfStyle OF Name = TextNode.pZone.NEW[ARRAY OfStyle OF Name];
styleDictNames: REF ARRAY OfStyle OF Name = TextNode.pZone.NEW[ARRAY OfStyle OF Name];
StyleRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,base] };
PrintRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,print] };
ScreenRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,screen] };
DefineStyleRule: PROC [frame: Frame, kind: OfStyle] = { -- expects <name> <comment> <definition> on op stack
definition: Object ← PopObject[frame];
comment: Object ← PopObject[frame];
STKname: Name ← PopName[frame];
name: Name ← ForceLower[STKname];
nameObj: Object ← NameToObject[name];
dict: dict Object ← LoadStyleDict[frame,kind];
WITH x:definition SELECT FROM
array => JaMOps.ABind[x,bindingDict];
ENDCASE; -- def may be a string
JaMOps.Put[dict,nameObj,CVX[definition]]; -- save the definition
IF name#STKname THEN JaMOps.Put[dict,NameToObject[STKname],CVX[definition]];
JaMOps.Put[LoadStyleRuleDict[frame,kind],nameObj,comment]; -- save the comment in the rule name dict
};
LoadStyleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = {
RETURN [TypeCheckDict[JaMOps.Load[frame,NameToObject[styleDictNames[kind]]]]] };
LoadStyleRuleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = {
RETURN [TypeCheckDict[JaMOps.Load[frame,NameToObject[styleRuleDictNames[kind]]]]] };
OpenStyle: PROC [frame: Frame, kind: OfStyle] = {
name: Name ← PopName[frame];
IF ~LoadStyle[name] THEN RETURN;
WHILE JaMOps.TopDict[frame.dictstk] # sysdict DO JaMOps.End[frame]; ENDLOOP;
JaMOps.Begin[frame,styledict];
JaMOps.Begin[frame,GetStyleDict[frame,name,kind]] };
OpenPrintStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
OpenStyle[frame, print] };
OpenScreenStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
OpenStyle[frame, screen] };
ResetTestStyle: PROC [frame: Frame] = {
IF debugStyle=NIL THEN debugStyle ← Create[];
debugStyle^ ← defaultStyle^ };
StyleRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,base] };
PrintRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,print] };
ScreenRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,screen] };
GetRuleDict: PROC [frame: Frame, kind: OfStyle] = {
PushName[frame,styleRuleDictNames[kind]];
JaMOps.Execute[frame,get] };
ForEachAttachedStyle: PUBLIC SAFE PROC [
dictName: Name, proc: PROC [attached: Name] RETURNS [stop: BOOL]] = TRUSTED {
val: Object;
array: array Object;
found: BOOL;
dictName ← ForceLower[dictName];
[found,val] ← JaMOps.TryToGet[attachmentsDict, NameToObject[dictName]];
IF ~found THEN RETURN;
WITH val:val SELECT FROM
array => array ← val;
ENDCASE => ERROR;
FOR i: CARDINAL IN [0..array.length) DO
ob: Object ← JaMVM.GetElem[array,i];
IF proc[TypeCheckName[ob]] THEN RETURN;
ENDLOOP;
};
AttachStyleOp: PROC [frame: Frame] = { -- expects opstk to contain style name
name: Name ← ForceLower[PopName[frame]];
found: BOOL;
printDict, screenDict: dict Object;
array: array Object;
styleName: Name ← SIGNAL WhatStyle;
val: Object;
[printDict,found] ← CheckStyleDict[name,print];
IF ~found THEN {
IF RunStyle[frame,name] THEN [printDict,found] ← CheckStyleDict[name,print];
IF ~found THEN {
BadStyleFile[frame,name];
RETURN }};
[screenDict,found] ← CheckStyleDict[name,screen];
IF ~found THEN ERROR;
JaMOps.AttachDict[LoadStyleDict[frame,screen],screenDict];
JaMOps.AttachDict[LoadStyleDict[frame,print],printDict];
[found,val] ← JaMOps.TryToGet[attachmentsDict, NameToObject[styleName]];
IF ~found THEN array ← JaMOps.Array[1] -- this is the first attachment
ELSE { -- add new item to the array
WITH val:val SELECT FROM
array => array ← val;
ENDCASE => ERROR;
array ← JaMOps.ACopy[array,1] };
JaMOps.APut[array,array.length-1,NameToObject[name]];
JaMOps.Put[attachmentsDict, NameToObject[styleName], array];
};
ClearTabStopsOp: PROC [frame: Frame] = {
ref: Ref ← StyleForFrame[frame];
ref.tabStops ← NIL; ref.numTabStops ← 0 };
-- support procs
PushText: PUBLIC SAFE PROC [frame: Frame, txt: LONG STRING] = TRUSTED {
JaMOps.Push[frame.opstk,JaMOps.MakeString[txt]] };
PushObject: PUBLIC SAFE PROC [frame: Frame, ob: Object] = TRUSTED {
JaMOps.Push[frame.opstk,ob] };
PopObject: PUBLIC SAFE PROC [frame: Frame] RETURNS [Object] = TRUSTED {
RETURN[JaMOps.Pop[frame.opstk]] };
PushName: PUBLIC SAFE PROC [frame: Frame, name: Name] = TRUSTED {
JaMOps.Push[frame.opstk,NameToObject[name]] };
stringToNameCount: LONG INTEGER ← 0; -- for debugging
PopName: PUBLIC SAFE PROC [frame: Frame] RETURNS [Name] = TRUSTED {
obj: Object ← JaMOps.Pop[frame.opstk];
WITH x:obj SELECT FROM
name => RETURN [LOOPHOLE[x.id]];
string => {
nameObj: name Object ← JaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
RETURN [LOOPHOLE[nameObj.id]] };
ENDCASE => {
PushText[frame," -- found where expected a name"];
PushObject[frame,obj];
StyleError[frame,2] };
ERROR };
TryToPopReal: PUBLIC SAFE PROC [frame: Frame] RETURNS [value: Real, ok: BOOL] = TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN RETURN [0.0, FALSE];
obj ← JaMOps.Top[frame.opstk];
WITH x:obj SELECT FROM
integer => { [] ← PopObject[frame]; RETURN [x.ivalue, TRUE] };
real => { [] ← PopObject[frame]; RETURN [x.rvalue, TRUE] };
ENDCASE => RETURN [0.0, FALSE] };
TryToPopString: PUBLIC SAFE PROC [frame: Frame]
RETURNS [string: string JaMBasic.Object, ok: BOOL] = TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN { ok ← FALSE; RETURN };
obj ← JaMOps.Top[frame.opstk];
WITH x:obj SELECT FROM
name => { [] ← PopObject[frame]; RETURN [JaMOps.NameToString[x], TRUE] };
string => { [] ← PopObject[frame]; RETURN [x, TRUE] };
ENDCASE => ok ← FALSE };
TryToPopName: PUBLIC SAFE PROC [frame: Frame] RETURNS [name: Name, ok: BOOL] = TRUSTED {
obj: Object;
IF frame.opstk.head = NIL THEN RETURN [NameSymbolTable.nullName,FALSE];
obj ← JaMOps.Top[frame.opstk];
WITH x:obj SELECT FROM
name => { [] ← PopObject[frame]; RETURN [LOOPHOLE[x.id],TRUE] };
string => {
nameObj: name Object ← JaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
[] ← PopObject[frame];
RETURN [LOOPHOLE[nameObj.id],TRUE] };
ENDCASE => RETURN [NameSymbolTable.nullName,FALSE] };
TypeCheckName: PUBLIC SAFE PROC [obj: Object] RETURNS [Name] = TRUSTED {
WITH x:obj SELECT FROM
name => RETURN [LOOPHOLE[x.id]];
string => {
nameObj: name Object ← JaMOps.StringToName[x];
stringToNameCount ← stringToNameCount+1;
RETURN [LOOPHOLE[nameObj.id]] };
ENDCASE;
ERROR };
TypeCheckDict: PUBLIC SAFE PROC
[obj: Object] RETURNS [dict Object] = TRUSTED {
WITH x:obj SELECT FROM
dict => RETURN [x];
ENDCASE;
ERROR };
TypeCheckCommand: PUBLIC SAFE PROC
[obj: Object] RETURNS [command Object] = TRUSTED {
WITH x:obj SELECT FROM
command => RETURN [x];
ENDCASE;
ERROR };
-- Initialization
StyleCommand: PUBLIC SAFE PROC
[frame: Frame, text: REF READONLY TEXT, proc: PROC [Frame]]
RETURNS [name: Name]= TRUSTED {
name ← MakeName[text];
JaMOps.RegisterExplicit[frame,LOOPHOLE[text,LONG STRING],proc];
-- add it to the binding dictionary
JaMOps.Put[bindingDict,NameToObject[name],
CVX[JaMOps.Load[frame,NameToObject[name]]]] };
StyleLiteral: PUBLIC SAFE PROC
[frame: Frame, text: REF READONLY TEXT] RETURNS [name: Name] = TRUSTED {
name ← MakeName[text];
-- add it to the binding dictionary
JaMOps.Put[bindingDict,NameToObject[name],CVLit[NameToObject[name]]];
-- add it to the current dictionary
JaMOps.Def[frame,NameToObject[name],CVLit[NameToObject[name]]] };
InitDict: PROC [txt: REF READONLY TEXT, size: CARDINAL ← 100]
RETURNS [name: Name, dictionary: dict Object] = {
found: BOOL;
d: Object;
name ← MakeName[txt];
[found,d] ← JaMOps.TryToGet[sysdict,NameToObject[name]];
IF found THEN dictionary ← TypeCheckDict[d]
ELSE { dictionary ← JaMOps.Dict[size];
JaMOps.Put[sysdict,NameToObject[name],dictionary] }};
bindingDictName, attachmentsDictName, styledictName: Name;
bindingDict, attachmentsDict: dict Object;
stylesDictsNames: REF ARRAY OfStyle OF Name ← TextNode.pZone.NEW[ARRAY OfStyle OF Name];
stylesDictNames: REF ARRAY OfStyle OF Name ← TextNode.pZone.NEW[ARRAY OfStyle OF Name];
stylesDicts: REF ARRAY OfStyle OF dict Object ← TextNode.pZone.NEW[ARRAY OfStyle OF dict Object];
InitStylesDict: PROC = {
[stylesDictsNames[base], stylesDicts[base]] ← InitDict["TiogaBaseStylesDictionary"];
[stylesDictsNames[print], stylesDicts[print]] ← InitDict["TiogaPrintStylesDictionary"];
[stylesDictsNames[screen], stylesDicts[screen]] ← InitDict["TiogaScreenStylesDictionary"] };
InitBindingDict: PROC = {
[bindingDictName, bindingDict] ← InitDict["TiogaBindingDictionary",200] };
InitAttachmentsDict: PROC = {
[attachmentsDictName, attachmentsDict] ← InitDict["TiogaAttachedStylesDictionary"] };
InitStyleDict: PROC = {
[styledictName, styledict] ← InitDict["TiogaStylesDictionary"];
JaMOps.AttachDict[styledict,userdict];
};
RegCom: PROC [frame: Frame, txt: REF READONLY TEXT, proc: PROC[Frame]]
RETURNS [c: command Object] = {
JaMOps.RegisterExplicit[frame,LOOPHOLE[txt,LONG STRING],proc];
c ← GetCommand[frame,MakeName[txt]] };
sysdict, userdict, styledict: PUBLIC dict Object;
styleerror: PUBLIC Name;
GetCommand: PUBLIC SAFE PROC [frame: Frame, name: Name]
RETURNS [command Object] = TRUSTED {
flag: BOOL;
obj: Object;
[flag,obj] ← JaMOps.TryToLoad[frame,NameToObject[name]];
IF ~flag THEN ERROR;
RETURN [TypeCheckCommand[obj]] };
GetObject: PROC [frame: Frame, name: Name] RETURNS [ob: Object] = {
RETURN [JaMOps.Load[frame,NameToObject[name]]] };
ReportStyleError: PROC [frame: Frame] = {
num: CARDINAL ← JaMOps.PopCardinal[frame.opstk];
string: string JaMBasic.Object;
ok: BOOL;
MessageWindow.Clear[];
IF executingName # NameSymbolTable.nullName THEN {
PushText[frame,"style rule. "];
PushName[frame,executingName];
PushText[frame,"Error in"];
num ← num+3 };
UNTIL num=0 DO
GetChar: SAFE PROC RETURNS [c: CHAR] = TRUSTED
{ c ← JaMVM.GetChar[string, i]; i ← i+1 };
i: CARDINAL;
[string, ok] ← TryToPopString[frame];
IF ~ok THEN EXIT;
i ← 0;
MessageWindow.Append[Rope.FromProc[string.length, GetChar]];
num ← num-1;
IF num # 0 THEN MessageWindow.Append[" "];
ENDLOOP;
};
RunFile: PROC [frame: Frame, name: Name, dictname: LONG STRING]
RETURNS [BOOL] = {
known: BOOL;
[known,] ← JaMOps.TryToLoad[frame,NameToObject[name]];
IF known THEN RETURN [FALSE];
PushText[frame,dictname];
JaMOps.Execute[frame,run];
RETURN [TRUE] };
load, get, run: PUBLIC command Object;
kindNames: REF ARRAY OfStyle OF Name ← TextNode.pZone.NEW[ARRAY OfStyle OF Name];
started: BOOL ← FALSE;
StartExtra: PUBLIC SAFE PROCEDURE =
TRUSTED BEGIN
frame, frame1, frame2, frame3, frame4: Frame ← NIL;
topDictName: Name;
IF started THEN RETURN; started ← TRUE;
frame ← JaMOps.defaultFrame;
get ← GetCommand[frame,MakeName[".get"]];
run ← GetCommand[frame,MakeName[".run"]];
load ← GetCommand[frame,MakeName[".load"]];
sysdict ← TypeCheckDict[GetObject[frame,MakeName[".sysdict"]]];
-- check if have done (start.jam) .run
IF ~RunFile[frame,MakeName["user"],"start.jam"] THEN
JaMOps.Execute[frame,CVX[NameToObject[MakeName[".start"]]]];
userdict ← JaMOps.TopDict[frame.dictstk];
InitStyleDict[];
JaMOps.End[frame]; -- replace userdict by styledict for rest of startup
JaMOps.Begin[frame,styledict];
topDictName ← MakeName["topDictName"];
JaMOps.Put[sysdict,NameToObject[topDictName],NameToObject[MakeName[".sysdict"]]];
JaMOps.Put[userdict,NameToObject[topDictName],NameToObject[MakeName["userdict"]]];
JaMOps.Put[styledict,NameToObject[topDictName],
NameToObject[MakeName["TiogaStylesDictionary"]]];
styleerror ← MakeName["StyleError"];
kindNames[screen] ← MakeName["screen"];
kindNames[print] ← MakeName["print"];
kindNames[base] ← MakeName["base"];
styleRuleDictNames[base] ← MakeName["##BaseStyleRuleDictName"];
styleRuleDictNames[screen] ← MakeName["##ScreenStyleRuleDictName"];
styleRuleDictNames[print] ← MakeName["##PrintStyleRuleDictName"];
styleDictNames[base] ← MakeName["##BaseStyleDictName"];
styleDictNames[screen] ← MakeName["##ScreenStyleDictName"];
styleDictNames[print] ← MakeName["##PrintStyleDictName"];
InitStylesDict[]; InitBindingDict[]; InitAttachmentsDict[];
-- check if have done (TiogaUtils.jam) .run
[] ← RunFile[frame,styleerror,"TiogaUtils.jam"];
[] ← RegCom[frame,"ReportStyleError",ReportStyleError];
[] ← RegCom[frame,"StyleName",StyleName];
[] ← RegCom[frame,"StyleRuleDict",StyleRuleDict];
[] ← RegCom[frame,"PrintRuleDict",PrintRuleDict];
[] ← RegCom[frame,"ScreenRuleDict",ScreenRuleDict];
[] ← RegCom[frame,"OpenPrintStyle",OpenPrintStyleOp];
[] ← RegCom[frame,"OpenScreenStyle",OpenScreenStyleOp];
[] ← RegCom[frame,"ResetTestStyle",ResetTestStyle];
[] ← StyleCommand[frame,"BeginStyle",BeginStyleOp];
[] ← StyleCommand[frame,"EndStyle",EndStyleOp];
[] ← StyleCommand[frame,"StyleRule",StyleRuleOp];
[] ← StyleCommand[frame,"PrintRule",PrintRuleOp];
[] ← StyleCommand[frame,"ScreenRule",ScreenRuleOp];
[] ← StyleCommand[frame,"AttachStyle",AttachStyleOp];
-- style commands for tabs
[] ← StyleCommand[frame,"clearTabStops",ClearTabStopsOp];
[] ← StyleCommand[frame,"tabStop",TabStopOp];
[] ← StyleCommand[frame,"defaultTabStops",DefaultTabStopsOp];
[] ← StyleCommand[frame,"tabStopLocations",RelativeTabStopsOp];
-- allocate and free some frames to initialize the cache
frame1 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame2 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame3 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
frame4 ← GetFrame[NIL, NameSymbolTable.nullName, screen];
FreeFrame[frame1, NameSymbolTable.nullName, screen];
FreeFrame[frame2, NameSymbolTable.nullName, screen];
FreeFrame[frame3, NameSymbolTable.nullName, screen];
FreeFrame[frame4, NameSymbolTable.nullName, screen];
NodeProps.Register[name: $StyleDef,
reader: ReadSpecsProc,
writer: WriteSpecsProc,
copier: CopyInfoProc];
END;
StartExtra;
END.