<> <> <> <> <> DIRECTORY <> <> <> <> <> <> <> ISNode, <> <> <> ISToken; ISNodeImpl: CEDAR MONITOR <> EXPORTS ISNode SHARES ISToken -- only for initialization a la 'handle _ []' due to Mesa inadequacy -- = BEGIN nodePageAllocationUnit: CARDINAL = 8; <<<>-->> <> <> <<>> <> <> <> <> <<>> ImplementationChainRecord: TYPE = RECORD [ next: ImplementationChainHandle, tag: ATOM, data: ISNode.Implementation ]; ImplementationChainHandle: TYPE = REF ImplementationChainRecord; defaultImplChainHandle: ImplementationChainHandle; defaultImplChain: ImplementationChainRecord _ [ next: NIL, tag: NIL, data: NIL ]; defaultImplChainData: ISNode.ImplementationObject _ [ internalize: NIL, externalize: NIL, destroy: NIL, interpress: NIL, createWindow: NIL, enumerate: NIL, copy: NIL, getBinding: NIL, setBinding: NIL, getContentItem: NIL, implementationClass: primary ]; implementationThread: ImplementationChainHandle _ NIL; Create: PUBLIC PROCEDURE --[with: ISNode.Handle]-- RETURNS [ISNode.Handle] = BEGIN h: ISNode.Handle _ NEW [ISNode.Object]; <> <> h^ _ []; -- defaulting context records -- RETURN [h]; END; <> <> <<{long: Environment.Long _ LOOPHOLE[node];>> <> <> <<>> <> <> <> <> <>>> <> <> <> <0 THEN>> <> <> <> <> <> <> <> <> < ERROR -- count says one here but not -->> <> <> <> <> <> <> <> <<_ Space.ScratchMap[ISSessionOps.pagesPerBlock];>> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <<_ Space.ScratchMap [ISSessionOps.pagesPerBlock];>> <> <> <> <> <> <> <> <> Copy: PUBLIC PROCEDURE [old: ISNode.Handle, with: ISNode.Handle _ NIL] RETURNS [ISNode.Handle] = BEGIN new: ISNode.Handle _ Create [--IF with#NIL THEN with ELSE old--]; primaryImpl: ISNode.Implementation; primaryTag: ATOM; [primaryImpl, primaryTag] _ GetPrimaryImplAndTag [old]; --<<>>--IF primaryImpl=NIL THEN ERROR; FOR foo: ISNode.TagHandle _ old.tagThread, foo.next UNTIL foo=NIL DO SetTag [new, foo.tag]; -- put the tags first -- ENDLOOP; primaryImpl.copy [old: old, new: new]; -- let primary copy it first -- <> FOR foo: ISNode.TagHandle _ old.tagThread, foo.next UNTIL foo=NIL DO j: ISNode.Implementation _ GetImplementation [foo.tag, NIL]; IF j=NIL OR j.copy=NIL THEN ERROR; --<>-- IF foo.tag#primaryTag -- primary handled above -- AND j#NIL AND j.copy#NIL -- or error? -- THEN j.copy [old: old, new: new]; ENDLOOP; RETURN [new]; END; <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <<[j, t] _ GetPrimaryImplAndTag [node];>> <> <> <> <> <> <> <> <> <> <> <> <> <> <<<>>> <> SetContext: PUBLIC PROCEDURE [ node: REF ISNode.Object, type: ATOM, context: ISToken.InterscriptContext ] = BEGIN -- not checking for duplicates -- newContext: ISNode.ContextHandle _ NEW[ISNode.ContextRecord _ [context: context, next: NIL, type: type]]; IF node.contextThread=NIL THEN node.contextThread _ newContext ELSE FOR c: ISNode.ContextHandle _ node.contextThread, c.next DO IF c.next=NIL THEN { c.next _ newContext; EXIT; }; ENDLOOP END; GetContext: PUBLIC PROCEDURE [node: REF ISNode.Object, type: ATOM] RETURNS [context: ISToken.InterscriptContext] = BEGIN FOR foo: ISNode.ContextHandle _ node.contextThread, foo.next UNTIL foo=NIL DO IF foo.type=type THEN RETURN [foo.context]; ENDLOOP; RETURN [NIL]; -- or error? -- END; SetTag: PUBLIC PROCEDURE [ node: REF ISNode.Object, tag: ATOM ] = BEGIN IF HasTag [node, tag] THEN RETURN ELSE BEGIN foo: ISNode.TagHandle _ NEW[ISNode.TagRecord _ [tag: tag, next: node.tagThread]]; node.tagThread _ foo; node.implementationChainHandle _ NIL; -- clear accelerator -- END; END; ClearTag: PUBLIC PROCEDURE [node: REF ISNode.Object, tag: ATOM] = BEGIN node.implementationChainHandle _ NIL; -- clear accelerator -- WHILE HasTag [node, tag] DO IF node.tagThread#NIL AND node.tagThread.tag=tag THEN node.tagThread _ node.tagThread.next ELSE FOR t: ISNode.TagHandle _ node.tagThread, t.next UNTIL t.next=NIL DO IF t.next.tag=tag THEN t.next _ t.next.next; ENDLOOP; ENDLOOP; END; HasTag: PUBLIC PROCEDURE [node: REF ISNode.Object, tag: ATOM] RETURNS [BOOLEAN] = BEGIN FOR foo: ISNode.TagHandle _ node.tagThread, foo.next UNTIL foo=NIL DO IF foo.tag=tag THEN RETURN [TRUE]; ENDLOOP; RETURN [FALSE]; END; SetImplementation: PUBLIC ENTRY PROCEDURE [ tag: ATOM, family: ATOM, implementation: ISNode.Implementation] RETURNS [ISNode.Implementation] = BEGIN icr: ImplementationChainHandle; oldImpl: ISNode.Implementation; <> IF implementation.internalize=NIL THEN implementation.internalize _ defaultImplChain.data.internalize; IF implementation.externalize=NIL THEN implementation.externalize _ defaultImplChain.data.externalize; IF implementation.destroy=NIL THEN implementation.destroy _ defaultImplChain.data.destroy; IF implementation.interpress=NIL THEN implementation.interpress _ defaultImplChain.data.interpress; IF implementation.createWindow=NIL THEN implementation.createWindow _ defaultImplChain.data.createWindow; IF implementation.enumerate=NIL THEN implementation.enumerate _ defaultImplChain.data.enumerate; IF implementation.copy=NIL THEN implementation.copy _ defaultImplChain.data.copy; IF implementation.createWindow=NIL THEN implementation.createWindow _ defaultImplChain.data.createWindow; FOR icr _ implementationThread, icr.next UNTIL icr=NIL DO IF icr.tag=tag THEN {oldImpl _ icr.data; icr.data _ implementation; EXIT}; REPEAT FINISHED => BEGIN oldImpl _ defaultImplChain.data; icr _ NEW [ImplementationChainRecord]; icr^ _ [next: implementationThread, tag: tag, data: implementation]; implementationThread _ icr; END; ENDLOOP; IF tag=NIL AND family=NIL THEN defaultImplChain.data _ implementation; RETURN [oldImpl]; END; GetImplementation: PUBLIC PROCEDURE [tag: ATOM, family: ATOM] RETURNS [ISNode.Implementation] = BEGIN FOR icr: ImplementationChainHandle _ implementationThread, icr.next UNTIL icr=NIL DO IF icr.tag=tag THEN RETURN [icr.data]; ENDLOOP; RETURN [defaultImplChain.data]; END; GetImplementationChain: PUBLIC ENTRY PROCEDURE [tag: ATOM, family: ATOM] RETURNS [ImplementationChainHandle] = BEGIN FOR icr: ImplementationChainHandle _ implementationThread, icr.next UNTIL icr=NIL DO IF icr.tag=tag THEN RETURN [icr]; ENDLOOP; RETURN [defaultImplChainHandle]; END; Enumerate: PUBLIC ISNode.EnumerateChildrenProc = BEGIN i: ISNode.Implementation _ GetPrimaryImpl[node]; IF i.enumerate#NIL THEN i.enumerate [node, context, enumerationProc]; END; GetPrimaryImpl: PUBLIC PROCEDURE [node: ISNode.Handle] RETURNS [ISNode.Implementation] = BEGIN im: ImplementationChainHandle; IF node=NIL THEN ERROR;--<<>>-- IF (im_NARROW[node.implementationChainHandle])=NIL THEN BEGIN FOR d: ISNode.TagHandle _ node.tagThread, d.next UNTIL d=NIL DO im _ GetImplementationChain [d.tag, NIL]; IF im#NIL AND im.data.implementationClass=primary THEN EXIT; REPEAT FINISHED => im _ defaultImplChainHandle; ENDLOOP; -- example of defaultable node: labels _ { Label2 Label3 } -- node.implementationChainHandle _ im; END; RETURN [im.data]; END; GetPrimaryImplAndTag: PUBLIC PROCEDURE [node: ISNode.Handle] RETURNS [implementation: ISNode.Implementation, tag: ATOM] = BEGIN im: ImplementationChainHandle; IF node=NIL THEN ERROR;--<<>>-- IF (im_NARROW[node.implementationChainHandle])=NIL THEN BEGIN FOR d: ISNode.TagHandle _ node.tagThread, d.next UNTIL d=NIL DO im _ GetImplementationChain [d.tag, NIL]; IF im#NIL AND im.data.implementationClass=primary THEN EXIT; REPEAT FINISHED => im _ defaultImplChainHandle; ENDLOOP; -- example of defaultable node: labels _ { Label2 Label3 } -- node.implementationChainHandle _ im; END; RETURN [im.data, im.tag]; END; <> <> <> <> defaultImplChainHandle _ NEW[ImplementationChainRecord _ defaultImplChain]; defaultImplChain.data _ NEW[ISNode.ImplementationObject _ defaultImplChainData]; [] _ SetImplementation [NIL, NIL, defaultImplChain.data]; <<>> END.