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.