-- 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 BOOLEAN ← NEW[BOOLEAN ← TRUE];
false: PUBLIC REF BOOLEAN ← NEW[BOOLEAN ← FALSE];
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: ROPE ← NARROW[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:
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;
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
THEN
IF 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.