-- NodePropsImpl.Mesa
-- written by Paxton. January 1981
-- last written by Paxton. December 28, 1982 11:12 am
Last Edited by: Maxwell, January 5, 1983 12:53 pm
DIRECTORY
NodeProps,
TextNode,
PGSupport,
RefTab,
NameSymbolTable,
Rope;
NodePropsImpl: CEDAR PROGRAM
IMPORTS NameSymbolTable, RefTab, Rope, TextNode
EXPORTS TextNode, NodeProps =
BEGIN
OPEN NodeProps;
Prop, Props: TYPE = REF NodePropsBody;
NodePropsBody: PUBLIC TYPE = RECORD [
name: ATOM, -- name of the property
next: Props, -- points to next property
value: REF ];
commentAtom: ATOM = $Comment;
commentName: ROPE = "Comment";
typeAtom: ATOM = $Format;
typeName: ROPE = "Format";
styleDefAtom: ATOM = $StyleDef;
styleDefName: ROPE = "StyleDef";
prefixAtom: ATOM = $Prefix;
prefixName: ROPE = "Prefix";
postfixAtom: ATOM = $Postfix;
postfixName: ROPE = "Postfix";
ObjectRec: TYPE = RECORD [rope: ROPE, object: Object];
true: PUBLIC REF BOOLEANNEW[BOOLEANTRUE];
false: PUBLIC REF BOOLEANNEW[BOOLEANFALSE];
ReadComment: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] = {
RETURN [IF Rope.Equal[specs,"TRUE",FALSE] THEN true ELSE false] };
WriteComment: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] = {
specs ← "FALSE";
IF value # NIL THEN WITH value SELECT FROM
x: REF BOOLEAN => IF x^ THEN specs ← "TRUE";
ENDCASE };
CopyComment, CopyPfix: PROC [name: ATOM, value: REF] RETURNS [new: REF] = {
RETURN [value] };
ReadPfix: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] = {
RETURN [specs] };
WritePfix: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] = {
RETURN [NARROW[value]] };
PrefixName: PUBLIC PROC RETURNS [ROPE] = {
RETURN [prefixName] };
PrefixAtom: PUBLIC PROC RETURNS [ATOM] = {
RETURN [prefixAtom] };
PostfixName: PUBLIC PROC RETURNS [ROPE] = {
RETURN [postfixName] };
PostfixAtom: PUBLIC PROC RETURNS [ATOM] = {
RETURN [postfixAtom] };
GetPrefixObject: PUBLIC PROCEDURE [n: TextNode.Ref]
RETURNS [ob: Object] = {
RETURN [GetPFix[n,prefixAtom]] };
GetPostfixObject: PUBLIC PROCEDURE [n: TextNode.Ref]
RETURNS [ob: Object] = {
RETURN [GetPFix[n,postfixAtom]] };
GetPFix: PROC [n: TextNode.Ref, name: ATOM] RETURNS [Object] = {
prop: Prop ← FindName[n, name, FALSE];
val: REF ObjectRec;
IF prop=NIL OR (val ← NARROW[prop.value])=NIL THEN
RETURN [NameSymbolTable.NullObject[]];
RETURN [val.object] };
FindName: PROC [n: TextNode.Ref, name: ATOM, remove: BOOLEAN]
RETURNS [prop: Prop] = {
lst, prev: Props;
IF n=NIL THEN RETURN [NIL];
lst ← n.props;
prop ← NIL; prev ← NIL;
WHILE lst#NIL DO
IF lst.name = name THEN { prop ← lst; EXIT };
prev ← lst; lst ← lst.next;
ENDLOOP;
IF prop#NIL AND remove THEN
IF prev#NIL THEN prev.next ← prop.next
ELSE n.props ← prop.next };
PutProp: PUBLIC PROCEDURE [n: TextNode.Ref, name: ATOM, value: REF] = {
prop: Prop ← FindName[n, name, FALSE];
PFix: PROC = TRUSTED {
rope: ROPENARROW[value]; -- value is rope for the prefix/postfix
ob: Object ← NameSymbolTable.MakeObject[LOOPHOLE[Rope.Flatten[rope]]];
value ← TextNode.pZone.NEW[ObjectRec ← [rope, ob]] };
IF value = NIL THEN {
IF prop#NIL THEN prop.value ← NIL;
SELECT name FROM
styleDefAtom => n.hasstyledef ← FALSE;
prefixAtom => n.hasprefix ← FALSE;
postfixAtom => n.haspostfix ← FALSE;
typeAtom => n.typename ← TextNode.nullTypeName;
commentAtom => {
txt: TextNode.RefTextNode ← TextNode.NarrowToTextNode[n];
IF txt#NIL THEN txt.comment ← FALSE };
ENDCASE;
RETURN };
SELECT name FROM
styleDefAtom => n.hasstyledef ← TRUE;
prefixAtom => { PFix; n.hasprefix ← TRUE };
postfixAtom => { PFix; n.haspostfix ← TRUE };
typeAtom => {
WITH value SELECT FROM
x: Rope.ROPE => TRUSTED {n.typename ← NameSymbolTable.MakeName[LOOPHOLE[Rope.Flatten[x]]]};
ENDCASE => ERROR;
RETURN };
commentAtom => { -- simply set the bit in the node
txt: TextNode.RefTextNode ← TextNode.NarrowToTextNode[n];
WITH value SELECT FROM
x: REF BOOLEAN => txt.comment ← x^;
ENDCASE => ERROR;
RETURN };
ENDCASE;
IF prop#NIL THEN { prop.value ← value; RETURN };
n.props ← TextNode.pZone.NEW[NodePropsBody ← [name, n.props, value]] };
GetProp: PUBLIC PROCEDURE [n: TextNode.Ref, name: ATOM]
RETURNS [value: REF] = {
prop: Prop ← FindName[n, name, FALSE];
PFix: PROC RETURNS [REF] = {
val: REF ObjectRec ← NARROW[prop.value];
RETURN [IF val=NIL THEN NIL ELSE val.rope] };
IF prop # NIL THEN SELECT name FROM
prefixAtom, postfixAtom => value ← PFix[];
ENDCASE => value ← prop.value
ELSE IF name = commentAtom THEN {
txt: TextNode.RefTextNode ← TextNode.NarrowToTextNode[n];
value ← IF txt # NIL AND txt.comment THEN true ELSE false }
ELSE IF name = typeAtom THEN
value ← IF n.typename = TextNode.nullTypeName THEN NIL ELSE
NameSymbolTable.RopeFromName[n.typename] };
RemProp: PUBLIC PROCEDURE [n: TextNode.Ref, name: ATOM] = {
[] ← FindName[n, name, TRUE]; -- removes the value
SELECT name FROM
styleDefAtom => n.hasstyledef ← FALSE;
prefixAtom => n.hasprefix ← FALSE;
postfixAtom => n.haspostfix ← FALSE;
typeAtom => n.typename ← TextNode.nullTypeName;
commentAtom => {
txt: TextNode.RefTextNode ← TextNode.NarrowToTextNode[n];
IF txt#NIL THEN txt.comment ← FALSE };
ENDCASE };
MapProps: PUBLIC PROCEDURE [n: TextNode.Ref, action: MapPropsAction, typeFlag, commentFlag: BOOLEANTRUE]
RETURNS [BOOLEAN] = {
apply the action to each name & value pair for the node
returns true if&when an action returns true
props: Props;
next: Props;
name: ATOM;
value: REF;
txt: TextNode.RefTextNode;
IF n=NIL THEN RETURN [FALSE];
props ← n.props;
IF typeFlag AND action[typeAtom,NameSymbolTable.RopeFromName[n.typename]] THEN RETURN [TRUE];
IF commentFlag AND (txt ← TextNode.NarrowToTextNode[n]) # NIL THEN
IF action[commentAtom,IF txt.comment THEN true ELSE false] THEN RETURN [TRUE];
WHILE props#NIL DO
next ← props.next; -- get it now in case action deletes current prop
SELECT name ← props.name FROM
prefixAtom, postfixAtom => {
x: REF ObjectRec ← NARROW[props.value];
value ← IF x=NIL THEN NIL ELSE x.rope };
ENDCASE => value ← props.value;
IF action[name,value] THEN RETURN [TRUE];
props ← next;
ENDLOOP;
RETURN [FALSE]};
-- ***** read, write, copy props
ReaderProcRef: TYPE = REF ReaderProcRec;
ReaderProcRec: TYPE = RECORD [proc: ReadSpecsProc];
WriterProcRef: TYPE = REF WriterProcRec;
WriterProcRec: TYPE = RECORD [proc: WriteSpecsProc];
CopierProcRef: TYPE = REF CopierProcRec;
CopierProcRec: TYPE = RECORD [proc: CopyInfoProc];
readerTable: RefTab.Ref ← RefTab.Create[zone: TextNode.pZone];
writerTable: RefTab.Ref ← RefTab.Create[zone: TextNode.pZone];
copierTable: RefTab.Ref ← RefTab.Create[zone: TextNode.pZone];
Register: PUBLIC PROC [name: ATOM,
reader: ReadSpecsProc,
writer: WriteSpecsProc,
copier: CopyInfoProc] = {
-- registers these procs for this variety of node
-- they will be called by DoSpecs, GetSpecs, and CopyInfo
IF name=NIL THEN RETURN;
[] ← RefTab.Store[readerTable,name,TextNode.pZone.NEW[ReaderProcRec ← [reader]]];
[] ← RefTab.Store[writerTable,name,TextNode.pZone.NEW[WriterProcRec ← [writer]]];
[] ← RefTab.Store[copierTable,name,TextNode.pZone.NEW[CopierProcRec ← [copier]]] };
NullRead: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] = {
RETURN [NIL] };
NullWrite: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] = {
RETURN [NIL] };
NullCopy: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] = {
RETURN [NIL] };
DoSpecs: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] = {
-- used when reading files
-- calls the registered reader for this property name
-- returns specs if no reader is registered
procRef: ReaderProcRef;
proc: ReadSpecsProc;
value ← IF name=NIL OR
(procRef ← NARROW[RefTab.Fetch[readerTable,name].val])=NIL OR
(proc ← procRef.proc)=NIL
THEN specs ELSE proc[name,specs] };
GetSpecs: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] = {
-- used when writing files
-- calls the registered writer for this property name
-- if no writer is registered, returns value if it is a rope, NIL otherwise
procRef: WriterProcRef;
proc: WriteSpecsProc;
IF name=NIL OR
(procRef ← NARROW[RefTab.Fetch[writerTable,name].val])=NIL OR
(proc ← procRef.proc)=NIL
THENIF value=NIL THEN specs ← NIL
ELSE WITH value SELECT FROM
rope: ROPE => specs ← rope;
ENDCASE => specs ← NIL
ELSE specs ← proc[name,value] };
CopyInfo: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] = {
-- used when copying nodes
-- calls the registered copier for this property name
-- if no copier is registered, returns value
procRef: CopierProcRef;
proc: CopyInfoProc;
new ← IF name=NIL OR
(procRef ← NARROW[RefTab.Fetch[copierTable,name].val])=NIL OR
(proc ← procRef.proc)=NIL
THEN value ELSE proc[name,value] };
-- ***** Initialization
StartNodeProps: PUBLIC PROC = {
Register[prefixAtom, ReadPfix, WritePfix, CopyPfix];
Register[postfixAtom, ReadPfix, WritePfix, CopyPfix];
Register[commentAtom, ReadComment, WriteComment, CopyComment] };
END.