DIRECTORY NodeStyleExtra, NodeStyle, NodeStyleObject, TextLooks, TextNode, NodeProps, NameSymbolTable, Atom, Process, Rope, UserProfile, MessageWindow, JaMBasic, JaMOps, JaMVM; NodeStyleExtraImpl: MONITOR IMPORTS Atom, JaMOps, JaMVM, Process, Rope, MessageWindow, TextNode, NodeProps, NodeStyle, NodeStyleExtra, NameSymbolTable EXPORTS NodeStyle, NodeStyleExtra, NodeStyleObject = BEGIN OPEN NodeStyle, NodeStyleExtra; 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 [Rope.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 { found: BOOLEAN; AllocFrame: ENTRY PROC [name: Name, kind: OfStyle] = { ENABLE UNWIND => NULL; allocFrameCalls _ allocFrameCalls+1; IF name # NameSymbolTable.nullName THEN { 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 }}; 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 freeFrame1 # NIL THEN { frame1 _ frame; style1 _ style } ELSE IF freeFrame2 # NIL THEN { frame2 _ frame; style2 _ style } ELSE IF freeFrame3 # NIL THEN { frame3 _ frame; style3 _ style } ELSE IF freeFrame4 # 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 { styleNameObj: Object; done: BOOLEAN _ 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 }; 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: BOOLEAN _ 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] }; 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 { ENABLE UNWIND => NULL; freeFrameCalls _ freeFrameCalls+1; 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 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; }; ReadSpecsProc: SAFE PROC [name: ATOM, specs: Rope.ROPE] RETURNS [value: REF] = TRUSTED { localStyle: LocalStyle _ TextNode.pZone.NEW[LocalStyleRec]; localStyle.name _ NameSymbolTable.MakeNameFromRope[Atom.GetPName[Atom.Gensym['S]]]; 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] }; LoadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOLEAN] = 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: BOOLEAN] = 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: BOOLEAN] = 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] = { { 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] = { 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: BOOLEAN] = { obj: Object; [found,obj] _ JaMOps.TryToGet[stylesDicts[kind],NameToObject[name]]; IF found THEN d _ TypeCheckDict[obj] }; RunStyle: PROC [frame: Frame, name: Name] RETURNS [ok: BOOLEAN] = { txt: REF TEXT _ TextNode.pZone.NEW[TEXT[64]]; ext: STRING = ".style"; txtlen: NAT; hasExt, started, finished: BOOLEAN _ 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: BOOLEAN] = { started, finished: BOOLEAN _ 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] }; 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: BOOLEAN] = { 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]]; JaMOps.Put[dict,NameToObject[styleKindName],NameToObject[kindNames[kind]]]; }; found: BOOLEAN; [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 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: BOOLEAN]] = TRUSTED { val: Object; array: array Object; found: BOOLEAN; 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: BOOLEAN; 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 }; 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: BOOLEAN] = 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: BOOLEAN] = 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: BOOLEAN] = 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 }; 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]; 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]; JaMOps.Put[bindingDict,NameToObject[name],CVLit[NameToObject[name]]]; JaMOps.Def[frame,NameToObject[name],CVLit[NameToObject[name]]] }; InitDict: PROC [txt: REF READONLY TEXT, size: CARDINAL _ 100] RETURNS [name: Name, dictionary: dict Object] = { found: BOOLEAN; 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: BOOLEAN; 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: BOOLEAN; 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 [BOOLEAN] = { known: BOOLEAN; [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: BOOLEAN _ 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"]]]; 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[]; [] _ 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]; [] _ StyleCommand[frame,"clearTabStops",ClearTabStopsOp]; [] _ StyleCommand[frame,"tabStop",TabStopOp]; [] _ StyleCommand[frame,"defaultTabStops",DefaultTabStopsOp]; [] _ StyleCommand[frame,"tabStopLocations",RelativeTabStopsOp]; 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. N-- NodeStyleExtraImpl.mesa -- Written by Bill Paxton, January 1981 -- Last changed by Paxton, December 21, 1982 10:36 am Last Edited by: Maxwell, January 6, 1983 10:05 am -- Styles, StyleNames, and Frames -- 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 -- first try to find one that already has the right style -- look for any free one -- get the proper style dictionary on the frame dictionary stack -- info about active frames -- info about free frames -- name and kind are just a hint about what style dictionary is on the frame stack -- add it to cache of free frames or really free it if cache full -- remove it from active frame info -- Local styles -- Load style procedures -- fake it so looks as if had a file saying BeginStyle (default) AttachStyle EndStyle -- need to fork this so to avoid monitor deadlock in viewers -- Registered commands -- create rule name dict in baseDict -- record the style kind -- support procs -- Initialization -- add it to the binding dictionary -- add it to the binding dictionary -- add it to the current dictionary -- check if have done (start.jam) .run -- check if have done (TiogaUtils.jam) .run -- style commands for tabs -- allocate and free some frames to initialize the cache Ê ˜JšÏc™Jš'™'Jš5™5JšÏk1™1šž ˜ J˜J˜ J˜J˜ J˜ J˜ J˜J˜J˜J˜J˜ J˜J˜ J˜J˜J˜—šœž˜Jšžœs˜zJšžœ-˜4—Jšž˜Jšžœ˜J˜š!™!J˜Jšœ žœžœ˜$Jšœžœžœ/˜KJ˜Jšœžœ˜Jšœžœžœžœ ˜6J˜š Ïnœžœžœžœ žœžœ˜?Jšœ&˜&šœ'˜'Jšžœžœžœžœ˜0—J˜,Jšœ˜J˜—šŸœžœžœžœ žœžœžœžœ˜Kš Ÿœžœ žœžœžœžœ˜CšŸœžœžœžœžœžœžœ˜EJšžœ˜—Jšžœ9˜?—Jšœžœ˜!š žœžœžœ žœž˜$Jšœžœ?˜Hšœ%˜%šœžœ˜1Jšœ@˜@——Jšœžœ1˜RJ˜Jšž˜—Jšœ˜J˜—šŸœžœ-˜GJšžœžœ˜"Jš9™9Jš2™2JšA™AJšœžœ˜šŸ œžœžœ!˜7Jšžœžœžœ˜J˜$šžœ!žœ˜)Jš:™:š žœžœžœžœž˜@Jšœ#žœžœ˜1—š žœžœžœžœž˜@Jšœ#žœžœ˜1—š žœžœžœžœž˜@Jšœ#žœžœ˜1—š žœžœžœžœž˜@Jšœ#žœžœ˜2——Jš™Jšžœžœžœ$žœ˜AJš žœžœžœžœ$žœ˜FJš žœžœžœžœ$žœ˜FJš žœžœžœžœ$žœ˜Fšžœ˜J˜5J˜J˜!——šŸ œžœžœ˜Jšžœžœžœ˜Jšžœžœžœ#˜;Jšžœžœžœžœ#˜@Jšžœžœžœžœ#˜@Jšžœžœžœžœ#˜@š žœžœ&žœžœž˜>Jšžœ žœžœ)žœ˜EJšžœžœžœ*˜[Jšžœ˜ ——Jšœ9˜Ušžœ&žœ˜.Jš@™@J˜Jšœžœžœ˜J˜Kšžœžœ)˜9šžœ'žœ!˜QJ˜J˜Jšžœžœ,ž˜Jšœžœ=˜VJ˜$J˜J˜Jšœ žœžœ˜J˜J˜š Ÿ œžœžœžœžœžœ˜Oš Ÿœžœžœžœ žœ˜-Jšžœžœžœ˜šžœž˜Jšœ žœ ˜Jšœ žœ ˜Jšœ žœ ˜Jšœ žœ ˜š žœžœ&žœžœž˜DJšžœžœžœ ˜+Jšžœ˜ ———šžœžœžœ˜=šžœ žœ˜Jšžœ žœžœ˜-Jšžœ˜—Jšžœ˜—Jšžœ ˜—J˜—š™J˜Jšœ8žœ˜J˜6J˜—šŸœžœžœ˜LJšžœ˜J˜—šŸœžœ*žœ˜FJ˜5J˜—šŸœžœžœžœ˜]J˜ J˜DJšžœžœ˜'J˜—šŸœžœžœžœ˜CJš œžœžœžœžœ˜-Jšœžœ ˜Jšœžœ˜ Jšœžœžœ˜+J˜#J˜š žœžœžœ žœ"˜>Jš žœ žœ žœžœžœ˜5—Jš žœžœžœžœžœ˜@J˜Jšœžœžœžœ˜*J˜A˜Jšœ!žœ˜*Jšœžœžœ˜+Jšœžœžœ˜*Jšœ˜—Jšžœ žœ ˜ J˜—šŸœžœ&žœ˜?Jšžœžœ˜Jšœžœžœ˜#J˜Ašœ˜Jšžœžœžœžœ˜BJšœ!žœ˜*Jšœžœžœ˜+Jšœžœžœ˜*Jšœ˜—Jšžœ žœ ˜ J˜J˜——š™J˜J˜2J˜2J˜Jšœžœžœ,˜IJšœ žœžœ(˜CJšœ žœžœžœ,˜`J˜šŸ œžœ žœ žœ ˜J˜;—šŸœžœ'˜5J˜LJš$™$J˜KJš™J˜—Jšœžœ˜Jšœ.˜Cšžœžœ˜J˜J˜*J˜J˜,J˜J˜—šžœ˜J˜J˜J˜—J˜PJ˜J˜'J˜&J˜J˜EJ˜CJ˜AJ˜J˜DJ˜J˜Jšœ#˜?Jšžœœ˜-J˜—šŸ œžœ'˜JJ˜CJ˜—šŸ œžœ˜#J˜Jšœ$˜=Jšœ"˜6šžœ žœ˜J˜9J˜—šžœH˜OJšœ žœ ˜J˜8J˜6J˜!J˜ J˜!J˜ J˜—Jšžœ œ˜+J˜—Jš œžœžœ žœžœžœ žœ˜ZJš œžœžœ žœžœžœ žœ˜VJ˜JšŸ œžœ2˜CJ˜JšŸ œžœ3˜DJ˜JšŸ œžœ4˜FJ˜šŸœžœ#4˜lJ˜&J˜#J˜J˜!Jšœ%˜%J˜.šžœžœž˜J˜%Jšžœ˜—Jšœžœ˜@Jšžœžœ'žœ˜LJšœ;)˜dJ˜J˜—šŸ œžœžœ˜KJšžœJ˜PJ˜—šŸœžœžœ˜OJšžœN˜TJ˜—šŸ œžœ"˜1J˜Jšžœžœžœ˜ Jšžœ)žœžœ˜LJ˜J˜4J˜—šŸœžœ!˜KJ˜J˜—šŸœžœ!˜LJ˜J˜—šŸœžœ˜(Jšžœ žœžœ˜-J˜J˜—JšŸ œžœ.˜AJ˜JšŸ œžœ/˜BJ˜JšŸœžœ0˜DJ˜šŸ œžœ"˜3J˜)J˜J˜—šŸœžœ˜(Jš œžœžœžœžœ˜PJ˜ J˜Jšœžœ˜J˜ J˜GJšžœžœžœ˜šžœ žœž˜J˜Jšžœžœ˜—šžœžœžœž˜'J˜$Jšžœžœžœ˜'Jšžœ˜—J˜J˜—šŸ œžœ&˜MJ˜(Jšœžœ˜J˜#J˜Jšœžœ ˜#J˜ J˜/šžœžœ˜Jšžœžœ0˜Lšžœžœ˜J˜Jšžœ˜ ——J˜1Jšžœžœžœ˜J˜:J˜8J˜HJšžœžœ˜Fšžœ˜#šžœ žœž˜J˜Jšžœžœ˜—J˜ —J˜5J˜Jšœ žœžœ žœ˜;Jšžœžœžœ˜!J˜——šŸœžœ˜/Jšžœ&žœžœ˜AJ˜ Jš žœžœžœžœžœ˜6J˜šžœžœž˜Jšœ!žœžœ˜IJšœ žœžœžœ˜6Jšžœ žœ˜J˜——šŸ œžœžœžœžœžœžœ˜[J˜ Jš žœžœžœžœžœ˜GJ˜šžœžœž˜Jšœ!žœžœžœ˜@˜ J˜.J˜(J˜Jšžœžœ žœ˜%—Jšžœžœžœ˜5J˜——š Ÿ œžœžœžœžœ žœ˜Hšžœžœž˜Jšœžœžœ˜ ˜ J˜.J˜(Jšžœžœ˜ —Jšžœ˜—Jšžœ˜J˜—š Ÿ œžœžœžœžœžœ˜Ošžœžœž˜Jšœžœ˜Jšžœ˜—Jšžœ˜J˜—š Ÿœžœžœžœžœžœ˜Ušžœžœž˜Jšœ žœ˜Jšžœ˜—Jšžœ˜J˜——š™J˜š Ÿ œžœžœžœžœžœ ˜[Jšžœžœ˜J˜Jšœžœžœžœ˜?Jš#™#˜*Jšžœ+˜.J˜——š Ÿ œžœžœžœžœ˜FJšžœžœ˜ J˜Jš#™#J˜EJš#™#J˜AJ˜—š Ÿœžœžœžœžœžœ˜=Jšžœ*˜1Jšœžœ˜J˜ J˜J˜8Jšžœžœ˜+šžœ"˜&J˜5J˜——J˜:J˜J˜*J˜Jš œžœžœ žœžœžœ žœ˜XJš œžœžœ žœžœžœ žœ˜WJ˜Jš œ žœžœ žœžœžœ žœ˜aJ˜šŸœžœ˜J˜TJ˜WJ˜\J˜—šŸœžœ˜J˜JJ˜—šŸœžœ˜J˜UJ˜—šŸ œžœ˜J˜?J˜&J˜J˜—š Ÿœžœžœžœžœžœ˜FJšžœ˜Jšœžœžœžœ˜>J˜&J˜—Jšœžœ ˜1J˜Jšœ žœ˜J˜šŸ œžœ˜7Jšžœžœ˜$Jšœžœ˜J˜ J˜8Jšžœžœžœ˜Jšžœ˜!J˜—šŸ œžœžœ˜CJšžœ+˜1J˜—šŸœžœ˜)Jšœžœ#˜0Jšœ˜Jšœžœ˜ J˜šžœ*žœ˜2J˜Jšœ˜J˜Jšœ˜—šžœž˜š Ÿœž œžœžœž˜.Jšœ+˜+—Jšœžœ˜ J˜%Jšžœžœžœ˜J˜J˜