<> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Ascii, Atom, Convert, MessageWindow, NameSymbolTable, NodeProps, NodeStyle, NodeStyleOps, NodeStyleWorks, Process, Rope, TextLooks, TJaMBasic, TJaMInternal, TJaMOps, TJaMVM, UserProfile; NodeStyleWorksImpl: CEDAR MONITOR IMPORTS TJaMOps, TJaMVM, Process, Rope, MessageWindow, NodeStyleOps, NodeStyleWorks, NameSymbolTable EXPORTS NodeStyleWorks = BEGIN OPEN NodeStyle, NodeStyleWorks; <> FrameInfo: TYPE = REF FrameInfoBody; FrameInfoBody: TYPE = RECORD [ frame: Frame, style: Ref, rest: FrameInfo ]; GetFrame: PUBLIC 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 style bombs during load>> found: BOOL; AllocFrame: ENTRY PROC [name: Name, kind: OfStyle] = TRUSTED { 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 _ TJaMOps.NewFrame[]; frameAlloc _ frameAlloc+1; TJaMOps.Begin[frame, sysdict]; TJaMOps.Begin[frame, styledict]; }; }; SaveStyleInfo: ENTRY PROC = TRUSTED { 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 # NameSymbolTable.nullName THEN { <<-- get the proper style dictionary on the frame dictionary stack>> styleNameObj: Object; done: BOOL _ FALSE; [found, styleNameObj] _ TJaMOps.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] _ TJaMOps.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 TJaMOps.TopDict[frame.dictstk] # styledict DO TJaMOps.End[frame]; ENDLOOP; }; IF ~done THEN TJaMOps.Begin[frame, GetStyleDict[frame, styleName, kind]] } ELSE WHILE TJaMOps.TopDict[frame.dictstk] # styledict DO TJaMOps.End[frame]; ENDLOOP; SaveStyleInfo[]; }; FreeFrame: PUBLIC ENTRY 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; TJaMOps.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; }; frame1, frame2, frame3, frame4: Frame _ NIL; -- small cache of active frames frameAlloc: INT _ 0; -- number of frames allocated from TJaM frameFree: INT _ 0; -- number of frames freed by TJaM allocFrameCalls: INT _ 0; -- number of times called AllocFrame freeFrameCalls: INT _ 0; -- number of times called FreeFrame. should = allocFrameCalls style1, style2, style3, style4: Ref; -- style bodies associated with active frames 1,2,3,4 frameList: FrameInfo; -- chain of known frames beyond the small cache here freeFrame1, freeFrame2, freeFrame3, freeFrame4: Frame _ NIL; styleName1, styleName2, styleName3, styleName4: Name _ NameSymbolTable.nullName; styleKind1, styleKind2, styleKind3, styleKind4: OfStyle _ screen; debugFlag: BOOL _ TRUE; debugStyle: Ref; StyleForFrame: PUBLIC PROC [frame: Frame] RETURNS [style: Ref] = TRUSTED { GetIt: ENTRY PROC RETURNS [s: Ref] = TRUSTED 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 _ NodeStyleOps.Create[]; RETURN [debugStyle] }; ERROR }; RETURN [style]; }; <> GetStyleDict: PUBLIC PROC [frame: Frame, name: Name, kind: OfStyle, def: Rope.ROPE _ NIL] RETURNS [d: dict Object] = { found, ok: BOOL; name _ ForceLowerName[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: PUBLIC PROC [frame: Frame, name: Name] = TRUSTED { <> { ENABLE { WhatStyle => { styleName _ name; RESUME }; StartOfStyle => RESUME; EndOfStyle => RESUME; }; BeginStyleOp[frame]; IF name # NodeStyleOps.defaultStyleName THEN { PushName[frame, NodeStyleOps.defaultStyleName]; AttachStyleOp[frame]; }; EndStyleOp[frame]; }; Process.Detach[FORK BadStyleMessage[name]]; PushName[frame, name]; PushText[frame, "style was bad."L]; 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] = TRUSTED { -- creates dict for style RETURN [TJaMOps.Dict[50]]; }; EnterStyleDict: PROC [name: Name, d: Object, kind: OfStyle] = TRUSTED INLINE { TJaMOps.Put[stylesDicts[kind], NameToObject[name], d]; }; CheckStyleDict: PROC [name: Name, kind: OfStyle] RETURNS [d: dict Object, found: BOOL] = TRUSTED { obj: Object; [found, obj] _ TJaMOps.TryToGet[stylesDicts[kind], NameToObject[name]]; IF found THEN d _ TypeCheckDict[obj]; }; RunStyle: PUBLIC PROC [frame: Frame, name: Name] RETURNS [ok: BOOL] = TRUSTED { txt: REF TEXT _ 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]]; TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]]; TJaMOps.Execute[frame, run ! WhatStyle => { styleName _ name; RESUME }; StartOfStyle => { started _ TRUE; RESUME }; EndOfStyle => { finished _ TRUE; RESUME }; ]; RETURN [started AND finished]; }; RunStyleString: PUBLIC PROC [frame: Frame, name: Name, def: Rope.ROPE] RETURNS [ok: BOOL] = TRUSTED { started, finished: BOOL _ FALSE; TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]]; TJaMOps.Execute[frame, CVX[TJaMOps.MakeString[LOOPHOLE[Rope.Flatten[def], LONG STRING]]] ! WhatStyle => { styleName _ name; RESUME }; StartOfStyle => { started _ TRUE; RESUME }; EndOfStyle => { finished _ TRUE; RESUME }; ]; RETURN [started AND finished]; }; sysdict: PUBLIC dict Object; userdict: PUBLIC dict Object; styledict: PUBLIC dict Object; <