<> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Ascii, Atom, Convert, MessageWindow, NameSymbolTable, NodeProps, NodeStyle, NodeStyleOps, NodeStyleWorks, Process, Rope, TextLooks, TJaMBasic, TJaMInternal, TJaMOps, TJaMVM, UserProfile; NodeStyleWorks2Impl: CEDAR MONITOR IMPORTS TJaMOps, TJaMVM, Process, Rope, MessageWindow, NodeStyle, NodeStyleOps, NodeStyleWorks, NameSymbolTable EXPORTS NodeStyleWorks = BEGIN OPEN NodeStyle, NodeStyleWorks; <> GetCommand: PUBLIC PROC [frame: Frame, name: Name] RETURNS [command Object] = TRUSTED { known: BOOL; obj: Object; [known, obj] _ TJaMOps.TryToLoad[frame, name]; IF NOT known THEN ERROR; RETURN [TypeCheckCommand[obj]]; }; GetObject: PUBLIC PROC [frame: Frame, name: Name] RETURNS [ob: Object] = TRUSTED { RETURN [TJaMOps.Load[frame, name]]; }; ForceLowerName: PUBLIC PROC [n: Name] RETURNS [Name] = TRUSTED { nameObj: Object = NameToObject[n]; name: name Object = WITH x:nameObj SELECT FROM name => x, ENDCASE => ERROR; str: string Object = TJaMOps.NameToString[name]; ForceChar: PROC [c: CHAR] RETURNS [stop: BOOL] = TRUSTED { string[i] _ IF c IN ['A..'Z] THEN c-'A+'a ELSE c; i _ i+1; RETURN [FALSE]; }; string: STRING _ [100]; i: CARDINAL _ 0; TJaMOps.StringForAll[str, ForceChar]; string.length _ i; RETURN [TypeCheckName[TJaMOps.MakeName[string, name.tag]]]; }; PushText: PUBLIC PROC [frame: Frame, txt: LONG STRING] = TRUSTED { TJaMOps.Push[frame.opstk, TJaMOps.MakeString[txt]]; }; PushObject: PUBLIC PROC [frame: Frame, ob: Object] = TRUSTED { TJaMOps.Push[frame.opstk, ob]; }; PopObject: PUBLIC PROC [frame: Frame] RETURNS [Object] = TRUSTED { RETURN[TJaMOps.Pop[frame.opstk]]; }; PushName: PUBLIC PROC [frame: Frame, name: Name] = TRUSTED { TJaMOps.Push[frame.opstk, NameToObject[name]]; }; stringToNameCount: LONG INTEGER _ 0; -- for debugging PopName: PUBLIC PROC [frame: Frame] RETURNS [Name] = TRUSTED { obj: Object _ TJaMOps.Pop[frame.opstk]; WITH x:obj SELECT FROM name => RETURN [LOOPHOLE[x.id]]; string => { nameObj: name Object _ TJaMOps.StringToName[x]; stringToNameCount _ stringToNameCount+1; RETURN [LOOPHOLE[nameObj.id]] }; ENDCASE => { PushText[frame, " -- found where expected a name"L]; PushObject[frame, obj]; StyleError[frame, 2] }; ERROR; }; TryToPopReal: PUBLIC PROC [frame: Frame] RETURNS [value: REAL _ 0.0, ok: BOOL] = TRUSTED { obj: Object; IF frame.opstk.head = NIL THEN RETURN [0.0, FALSE]; obj _ TJaMOps.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 PROC [frame: Frame] RETURNS [string: string TJaMBasic.Object, ok: BOOL] = TRUSTED { obj: Object; IF frame.opstk.head = NIL THEN { ok _ FALSE; RETURN }; obj _ TJaMOps.Top[frame.opstk]; WITH x:obj SELECT FROM name => { [] _ PopObject[frame]; RETURN [TJaMOps.NameToString[x], TRUE] }; string => { [] _ PopObject[frame]; RETURN [x, TRUE] }; ENDCASE => ok _ FALSE; }; TryToPopName: PUBLIC PROC [frame: Frame] RETURNS [name: Name, ok: BOOL] = TRUSTED { obj: Object; IF frame.opstk.head = NIL THEN RETURN [NameSymbolTable.nullName, FALSE]; obj _ TJaMOps.Top[frame.opstk]; WITH x:obj SELECT FROM name => { [] _ PopObject[frame]; RETURN [LOOPHOLE[x.id], TRUE] }; string => { nameObj: name Object _ TJaMOps.StringToName[x]; stringToNameCount _ stringToNameCount+1; [] _ PopObject[frame]; RETURN [LOOPHOLE[nameObj.id], TRUE] }; ENDCASE => RETURN [NameSymbolTable.nullName, FALSE]; }; TypeCheckName: PUBLIC PROC [obj: Object] RETURNS [Name] = TRUSTED { WITH x:obj SELECT FROM name => RETURN [LOOPHOLE[x.id]]; string => { nameObj: name Object _ TJaMOps.StringToName[x]; stringToNameCount _ stringToNameCount+1; RETURN [LOOPHOLE[nameObj.id]] }; ENDCASE; ERROR; }; TypeCheckDict: PUBLIC PROC [obj: Object] RETURNS [dict Object] = TRUSTED { WITH x:obj SELECT FROM dict => RETURN [x]; ENDCASE; ERROR; }; TypeCheckCommand: PUBLIC PROC [obj: Object] RETURNS [command Object] = TRUSTED { WITH x:obj SELECT FROM command => RETURN [x]; ENDCASE; ERROR; }; <> IsCommentOp: PROC [frame: Frame] = TRUSTED { style: Ref _ StyleForFrame[frame]; TJaMOps.PushBoolean[frame.opstk, style.isComment]; }; IsPrintOp: PROC [frame: Frame] = TRUSTED { style: Ref _ StyleForFrame[frame]; TJaMOps.PushBoolean[frame.opstk, style.print]; }; NestingLevelOp: PROC [frame: Frame] = TRUSTED { style: Ref _ StyleForFrame[frame]; PushInteger[frame, style.nestingLevel]; }; <> StyleParamOp: PROC [frame: Frame] = TRUSTED { <> initialValue: Object _ PopObject[frame]; -- the initial value name: Name _ PopName[frame]; -- the parameter name key: Name; array: array Object; [key, array] _ SpecialOpArray[name, specialOp]; TJaMOps.Def[frame, NameToObject[name], array]; -- store the definition TJaMOps.Def[frame, NameToObject[key], initialValue]; -- store the initial value }; SpecialOpArray: PUBLIC PROC [name: Name, op: Object] RETURNS [key: Name, array: array Object] = TRUSTED { <> key _ StyleParamKey[name]; array _ TJaMOps.Array[2]; -- create a 2 element array array.tag _ X; -- make it executable TJaMOps.APut[array, 0, CVLit[NameToObject[key]]]; TJaMOps.APut[array, 1, CVX[op]]; }; StyleParamKey: PUBLIC ENTRY PROC [name: Name] RETURNS [key: Name] = TRUSTED { <> <<[I wondered why this uses REF TEXT and not ROPE. RJB]>> ENABLE UNWIND => NULL; text.length _ 0; NameSymbolTable.FromName[name, text]; FOR i:NAT DECREASING IN [0..text.length) DO -- make room for prefix text[i+2] _ text[i]; ENDLOOP; text[0] _ text[1] _ '!; -- prefix for keys is double bang text.length _ text.length+2; key _ NameSymbolTable.MakeName[LOOPHOLE[text, REF READONLY TEXT]]; }; text: REF TEXT _ NEW[TEXT[64]]; -- to hold the name for StyleParamKey DefineSpecialOp: PUBLIC PROC [frame: Frame, text: REF READONLY TEXT, proc: PROC [Frame]] RETURNS [op: Object] = TRUSTED { TJaMOps.RegisterExplicit[frame, LOOPHOLE[text, LONG STRING], proc]; PushName[frame, NameSymbolTable.MakeName[text]]; TJaMOps.Execute[frame, load]; op _ PopObject[frame]; }; specialOp: PUBLIC Object; SpecialOp: PROC [frame: Frame] = { <> nameflag: BOOL; name: Name; var: Name; style: Ref _ StyleForFrame[frame]; Error: PROC = { PushName[frame, name]; PushText[frame, "has illegal qualifier:"L]; PushName[frame, var]; StyleError[frame, 3]; }; FindObject: PROC RETURNS [NameSymbolTable.Object] = TRUSTED { FOR x: DataList _ style.dataList, x.next UNTIL x=NIL DO xx: REF DataEntry.object = NARROW[x]; IF xx.name = var THEN RETURN [xx.object]; ENDLOOP; PushName[frame, var]; TJaMOps.Execute[frame, load]; -- get the initial value RETURN [LOOPHOLE[PopObject[frame]]]; }; Store: PROC [ob: NameSymbolTable.Object] = { style.dataList _ NEW[DataEntry _ [style.dataList, object[var, ob]]]; }; Load: PROC = { PushObject[frame, LOOPHOLE[FindObject[]]] }; AddReal: PROC [inc: REAL] = { value: REAL; Load[]; value _ PopReal[frame]; SetReal[value+inc]; }; SetReal: PROC [x: REAL] = { PushReal[frame, x]; Store[LOOPHOLE[PopObject[frame]]]; }; SetName: PROC [n: Name] = { PushName[frame, n]; Store[LOOPHOLE[PopObject[frame]]]; }; Percent: PROC [percent: REAL] = { value: REAL; Load[]; value _ PopReal[frame]; SetReal[(percent/100)*value]; }; var _ PopName[frame]; -- the name of the special parameter [name, nameflag] _ TryToPopName[frame]; IF ~nameflag THEN Store[LOOPHOLE[PopObject[frame]]] <> ELSE SELECT name FROM the => Load[]; bigger => BEGIN [name, nameflag] _ TryToPopName[frame]; IF ~nameflag THEN AddReal[PopReal[frame]] ELSE IF name=percent THEN Percent[100+PopReal[frame]] ELSE { Error; RETURN }; END; smaller => BEGIN [name, nameflag] _ TryToPopName[frame]; IF ~nameflag THEN AddReal[-PopReal[frame]] ELSE IF name=percent THEN Percent[100-PopReal[frame]] ELSE { Error; RETURN }; END; percent => Percent[PopReal[frame]]; ENDCASE => SetName[name]; }; RegisterStyleCommand: PUBLIC PROC [frame: Frame, text: REF READONLY TEXT, proc: PROC [Frame]] RETURNS [name: Name] = TRUSTED { name _ NameSymbolTable.MakeName[text]; TJaMOps.RegisterExplicit[frame, LOOPHOLE[text, LONG STRING], proc]; <<-- add it to the binding dictionary>> TJaMOps.Put[bindingDict, NameToObject[name], CVX[TJaMOps.Load[frame, NameToObject[name]]]]; }; RegisterStyleLiteral: PUBLIC PROC [frame: Frame, name: Name] = TRUSTED { <<-- add it to the binding dictionary>> TJaMOps.Put[bindingDict, name, Atom.GetPName[name]]]; <<-- add it to the current dictionary>> TJaMOps.Def[frame, name, Atom.GetPName[name]]]; }; ReportStyleErrorOp: PROC [frame: Frame] = TRUSTED { num: CARDINAL _ TJaMOps.PopCardinal[frame.opstk]; string: string TJaMBasic.Object; ok: BOOL; MessageWindow.Clear[]; IF executingName # NameSymbolTable.nullName THEN { PushText[frame, "style rule. "L]; PushName[frame, executingName]; PushText[frame, "Error in"L]; num _ num+3; }; UNTIL num=0 DO GetChar: PROC RETURNS [c: CHAR] = TRUSTED { c _ TJaMVM.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; }; load: PUBLIC command Object; get: PUBLIC command Object; run: PUBLIC command Object; start: PUBLIC command Object; StartWorks2: PUBLIC PROC = TRUSTED { InitLookNames[]; [] _ RegCom[frame, $ReportStyleError, ReportStyleErrorOp]; [] _ RegCom[frame, $StyleName, StyleNameOp]; [] _ RegCom[frame, $StyleRuleDict, StyleRuleDictOp]; [] _ RegCom[frame, $PrintRuleDict, PrintRuleDictOp]; [] _ RegCom[frame, $ScreenRuleDict, ScreenRuleDictOp]; [] _ RegCom[frame, $OpenPrintStyle, OpenPrintStyleOp]; [] _ RegCom[frame, $OpenScreenStyle, OpenScreenStyleOp]; [] _ RegCom[frame, $ResetTestStyle, ResetTestStyleOp]; [] _ RegisterStyleCommand[frame, $BeginStyle, BeginStyleOp]; [] _ RegisterStyleCommand[frame, $EndStyle, EndStyleOp]; [] _ RegisterStyleCommand[frame, $StyleRule, StyleRuleOp]; [] _ RegisterStyleCommand[frame, $PrintRule, PrintRuleOp]; [] _ RegisterStyleCommand[frame, $ScreenRule, ScreenRuleOp]; [] _ RegisterStyleCommand[frame, $AttachStyle, AttachStyleOp]; specialOp _ DefineSpecialOp[frame, $SpecialOp, SpecialOp]; TJaMOps.RegisterExplicit[frame, $StyleParam, StyleParamOp]; TJaMOps.RegisterExplicit[frame, $isComment, IsCommentOp]; TJaMOps.RegisterExplicit[frame, $isPrint, IsPrintOp]; TJaMOps.RegisterExplicit[frame, $nestingLevel, NestingLevelOp]; <<-- 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]; }; StartWorks2[]; END.