
<<NodePropsImpl.Mesa; written by Paxton.  January 1981>>
<<edited by Paxton. August 26, 1983 3:17 pm>>
<<edited by McGregor. May 12, 1983 9:08 am>>
<<edited by Maxwell, January 5, 1983 12:53 pm>>

DIRECTORY
NodeProps,
TiogaNode,
TiogaNodeOps,
RefTab,
NameSymbolTable,
Rope;

NodePropsImpl: CEDAR PROGRAM
IMPORTS NameSymbolTable, RefTab, Rope
EXPORTS NodeProps =
BEGIN
OPEN NodeProps;

Prop, Props: TYPE = REF NodePropsBody;
NodePropsBody: TYPE = RECORD [
name: ATOM, -- name of the property
next: Props, -- points to next property
value: REF ];

propertyListTable: RefTab.Ref _ RefTab.Create[512]; -- key is TiogaNode.Ref; value is Props

formatAtom: ATOM = $Format;
commentAtom: ATOM = $Comment;
branchClassAtom: ATOM = $BranchClass;
styleDefAtom: ATOM = $StyleDef;

prefixAtom: ATOM = $Prefix;
prefixName: ROPE = "Prefix";

postfixAtom: ATOM = $Postfix;
postfixName: ROPE = "Postfix";

ObjectRec: TYPE = RECORD [rope: ROPE, object: Object];

true: PUBLIC REF BOOLEAN _ NEW[BOOLEAN _ TRUE];
false: PUBLIC REF BOOLEAN _ NEW[BOOLEAN _ FALSE];

ReadComment: PROC [name: ATOM, specsRope: ROPE, start, len: INT, n: TiogaNode.Ref]
RETURNS [value: REF] = {
specs: ROPE _ Rope.Substr[specsRope, start, len];
RETURN [IF Rope.Equal[specs,"TRUE",FALSE] THEN true ELSE false] };

WriteComment: PROC [name: ATOM, value: REF, n: TiogaNode.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, from, to: TiogaNode.Ref]
RETURNS [new: REF] = { RETURN [value] };

ReadPfix: PROC [name: ATOM, specsRope: ROPE, start, len: INT, n: TiogaNode.Ref]
RETURNS [value: REF] = {
RETURN [Rope.Substr[specsRope, start, len]] };

WritePfix: PROC [name: ATOM, value: REF, n: TiogaNode.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: TiogaNode.Ref]
RETURNS [ob: Object] = { RETURN [GetPFix[n,prefixAtom]] };

GetPostfixObject: PUBLIC PROCEDURE [n: TiogaNode.Ref]
RETURNS [ob: Object] = { RETURN [GetPFix[n,postfixAtom]] };

GetPFix: PROC [n: TiogaNode.Ref, name: ATOM] RETURNS [Object] = {
prop: Prop _ FindName[n, name, FALSE].prop;
val: REF ObjectRec;
IF prop=NIL OR (val _ NARROW[prop.value])=NIL THEN
RETURN [NameSymbolTable.NullObject[]];
RETURN [val.object] };

GetPropList: PROC [n: TiogaNode.Ref] RETURNS [Props] = INLINE {
RETURN [IF ~n.hasPropList THEN NIL ELSE
NARROW[RefTab.Fetch[propertyListTable, n].val]] };

StorePropList: PROC [n: TiogaNode.Ref, val: Props] = {
IF val # NIL THEN { n.hasPropList _ TRUE; [] _ RefTab.Store[propertyListTable, n, val] }
ELSE { n.hasPropList _ FALSE; [] _ RefTab.Delete[propertyListTable, n] }};

RemProps: PUBLIC PROC [n: TiogaNode.Ref] = {
n.hasstyledef _ n.hasprefix _ n.haspostfix _ n.hasbranchclass _ FALSE;
StorePropList[n, NIL] };

FindName: PROC [n: TiogaNode.Ref, name: ATOM, remove: BOOL]
RETURNS [prop: Prop, lst: Props] = {
prev: Props;
IF n=NIL THEN RETURN [NIL, NIL];
lst _ GetPropList[n];
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 StorePropList[n, prop.next] };

PutProp: PUBLIC PROCEDURE [n: TiogaNode.Ref, name: ATOM, value: REF] = {
prop: Prop;
lst: Props;
PFix: PROC = TRUSTED {
rope: ROPE _ NARROW[value]; -- value is rope for the prefix/postfix
ob: Object _ NameSymbolTable.MakeObject[LOOPHOLE[Rope.Flatten[rope]]];
value _ NEW[ObjectRec _ [rope, ob]] };
[prop, lst] _ FindName[n, name, FALSE];
IF value = NIL THEN {
IF prop#NIL THEN prop.value _ NIL;
SELECT name FROM
branchClassAtom => n.hasbranchclass _ FALSE;
styleDefAtom => n.hasstyledef _ FALSE;
prefixAtom => n.hasprefix _ FALSE;
postfixAtom => n.haspostfix _ FALSE;
formatAtom => n.format _ TiogaNode.nullName;
commentAtom => n.comment _ FALSE;
ENDCASE;
RETURN };
SELECT name FROM
branchClassAtom => n.hasbranchclass _ TRUE;
styleDefAtom => n.hasstyledef _ TRUE;
prefixAtom => { PFix; n.hasprefix _ TRUE };
postfixAtom => { PFix; n.haspostfix _ TRUE };
formatAtom => {
WITH value SELECT FROM
x: Rope.ROPE => TRUSTED {n.format _ NameSymbolTable.MakeName[LOOPHOLE[Rope.Flatten[x]]]};
ENDCASE => ERROR;
RETURN };
commentAtom => { -- simply set the bit in the node
WITH value SELECT FROM
x: REF BOOLEAN => n.comment _ x^;
ENDCASE => ERROR;
RETURN };
ENDCASE;
IF prop#NIL THEN { prop.value _ value; RETURN };
StorePropList[n, NEW[NodePropsBody _ [name, lst, value]]] };

GetProp: PUBLIC PROCEDURE [n: TiogaNode.Ref, name: ATOM]
RETURNS [value: REF] = {
prop: Prop _ FindName[n, name, FALSE].prop;
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
value _ IF n.comment THEN true ELSE false
ELSE IF name = formatAtom THEN
value _ IF n.format = TiogaNode.nullName THEN NIL ELSE
NameSymbolTable.RopeFromName[n.format] };

RemProp: PUBLIC PROCEDURE [n: TiogaNode.Ref, name: ATOM] = {
[] _ FindName[n, name, TRUE]; -- removes the value
SELECT name FROM
branchClassAtom => n.hasbranchclass _ FALSE;
styleDefAtom => n.hasstyledef _ FALSE;
prefixAtom => n.hasprefix _ FALSE;
postfixAtom => n.haspostfix _ FALSE;
formatAtom => n.format _ TiogaNode.nullName;
commentAtom => n.comment _ FALSE;
ENDCASE };

MapProps: PUBLIC PROCEDURE [n: TiogaNode.Ref, action: MapPropsAction, formatFlag, commentFlag: BOOLEAN _ TRUE]
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;
IF n=NIL THEN RETURN [FALSE];
props _ GetPropList[n];
IF formatFlag AND action[formatAtom, NameSymbolTable.RopeFromName[n.format]] THEN RETURN [TRUE];
IF commentFlag AND action[commentAtom, IF n.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[];
writerTable: RefTab.Ref _ RefTab.Create[];
copierTable: RefTab.Ref _ RefTab.Create[];

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,NEW[ReaderProcRec _ [reader]]];
[] _ RefTab.Store[writerTable,name,NEW[WriterProcRec _ [writer]]];
[] _ RefTab.Store[copierTable,name,NEW[CopierProcRec _ [copier]]] };

HasWriter: PUBLIC PROC [name: ATOM] RETURNS [BOOL] = { --returns true if there is a non-null writer
procRef: WriterProcRef;
proc: WriteSpecsProc;
IF name=NIL OR
(procRef _ NARROW[RefTab.Fetch[writerTable, name].val])=NIL OR
(proc _ procRef.proc)=NIL OR proc=NullWrite THEN RETURN[FALSE];
RETURN [TRUE] };

NullRead: PUBLIC PROC [name: ATOM, specsRope: ROPE, start, len: INT, n: TiogaNode.Ref]
RETURNS [value: REF] = { RETURN [NIL] };

NullWrite: PUBLIC PROC [name: ATOM, value: REF, n: TiogaNode.Ref] RETURNS [specs: ROPE] = {
RETURN [NIL] };

NullCopy: PUBLIC PROC [
name: ATOM, value: REF, from, to: TiogaNode.Ref] RETURNS [new: REF] = {
RETURN [NIL] };

DoSpecs: PUBLIC PROC [name: ATOM, specsRope: ROPE, start, len: INT, n: TiogaNode.Ref]
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 Rope.Substr[specsRope,start,len] ELSE proc[name,specsRope,start,len,n] };

GetSpecs: PUBLIC PROC [name: ATOM, value: REF, n: TiogaNode.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
THEN    IF value=NIL THEN specs _ NIL
ELSE WITH value SELECT FROM
rope: ROPE => specs _ rope;
ENDCASE => specs _ NIL
ELSE specs _ proc[name,value,n] };

CopyInfo: PUBLIC PROC [
name: ATOM, value: REF, from, to: TiogaNode.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,from,to] };


<<***** Initialization>>

StartNodeProps: PROC = {
Register[prefixAtom, ReadPfix, WritePfix, CopyPfix];
Register[postfixAtom, ReadPfix, WritePfix, CopyPfix];
Register[commentAtom, ReadComment, WriteComment, CopyComment] };

StartNodeProps[];

END.