NodePropsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
written by Paxton. January 1981
Doug Wyatt, March 3, 1985 5:40:46 pm PST
Michael Plass, May 9, 1986 11:55:53 am PDT
Rick Beach, March 28, 1985 9:57:47 am PST
Russ Atkinson (RRA) August 19, 1985 4:17:41 pm PDT
DIRECTORY
Atom USING [DottedPairNode, GetPName, MakeAtom, PropList],
Basics USING [BoundsCheckHighHalf, DoubleShiftLeft, NonNegative],
IO USING [atom, int, PutFR],
List USING [Length, Sort],
MessageWindow USING [Append, Blink],
NodeProps USING [CopyInfoProc, MapPropsAction, ReadSpecsProc, WriteSpecsProc],
NodePropsExtras USING [],
RefTab USING [Create, Fetch, Ref, Store],
Rope USING [Concat, Equal, Fetch, FromChar, FromRefText, IsEmpty, ROPE, Size, Substr],
Rosary USING [FromProcProc, MapRuns, ROSARY, Size],
TextNode USING [NodeProps, NodePropsBody, Ref];
NodePropsImpl: CEDAR MONITOR
IMPORTS Atom, Basics, IO, List, MessageWindow, RefTab, Rope, Rosary
EXPORTS TextNode, NodeProps, NodePropsExtras
~
BEGIN
ROSARY: TYPE = Rosary.ROSARY;
ROPE: TYPE = Rope.ROPE;
Object: TYPE = REF;
CopyInfoProc: TYPE = NodeProps.CopyInfoProc;
MapPropsAction: TYPE = NodeProps.MapPropsAction;
ReadSpecsProc: TYPE = NodeProps.ReadSpecsProc;
WriteSpecsProc:
TYPE = NodeProps.WriteSpecsProc;
Prop, Props: TYPE = REF NodePropsBody;
NodePropsBody:
PUBLIC
TYPE =
RECORD [
name: ATOM, -- name of the property
value: REF,
next: Props -- points to next property
];
charsetsAtom: ATOM = $CharSets;
charpropsAtom: ATOM = $CharProps;
artworkAtom: ATOM = $Artwork;
commentAtom: ATOM = $Comment;
formatAtom: ATOM = $Format;
styleDefAtom: ATOM = $StyleDef;
prefixAtom: ATOM = $Prefix;
postfixAtom: ATOM = $Postfix;
true: PUBLIC REF BOOL ← NEW[BOOL ← TRUE];
false:
PUBLIC
REF
BOOL ←
NEW[
BOOL ←
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] ~ {
WITH value
SELECT
FROM
x: REF BOOL => IF x^ THEN specs ← "TRUE";
ENDCASE => specs ← "FALSE";
};
ReadFormat:
PROC [name:
ATOM, specs:
ROPE]
RETURNS [value:
REF ←
NIL] ~ {
IF NOT Rope.IsEmpty[specs] THEN value ← Atom.MakeAtom[specs];
};
WriteFormat:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE ← NIL] ~ {
WITH value
SELECT
FROM
atom: ATOM => specs ← Atom.GetPName[NARROW[atom]];
ENDCASE;
};
ReadPfix:
PROC [name:
ATOM, specs:
ROPE]
RETURNS [value:
REF] ~ {
RETURN [specs]
};
WritePfix:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE ←
NIL] ~ {
WITH value
SELECT
FROM
rope: ROPE => specs ← rope;
ENDCASE;
};
ReadCharSets:
PROC [name:
ATOM, specs:
ROPE]
RETURNS [value:
REF] ~ {
Raises a bounds fault if invalid specs are provided.
Encoding is (<repeatCount><charSet>)*, where <repeatCount> is encoded with the variable-length integer encoding scheme described in FileOps, and <charSet> is just encoded as a byte.
p:
PROC [q:
PROC [
REF,
INT]] ~ {
i: INT ← 0;
size: INT ← Rope.Size[specs];
GetByte: PROC RETURNS [b: [0..256)] ~ {b ← Rope.Fetch[specs, i]-'\000; i ← i + 1};
Combine:
PROC [a:
INT, b: [0..128)]
RETURNS [
INT] ~ {
bnd: NAT ~ LAST[NAT]/128+1;
RETURN [Basics.DoubleShiftLeft[[li[Basics.BoundsCheckHighHalf[a, bnd]]], 7].li + b];
};
GetInt:
PROC
RETURNS [int:
INT ← 0] ~ {
b: [0..256) ← GetByte[];
WHILE b > 127
DO
int ← Combine[int, b-128];
b ← GetByte[];
ENDLOOP;
int ← Combine[int, b];
};
UNTIL i = size
DO
repeat: INT ~ GetInt[];
charSet: [0..256) ~ GetByte[];
IF charSet=0 THEN q[NIL, repeat] ELSE q[NEW[[0..256) ← charSet], repeat];
ENDLOOP;
};
RETURN [Rosary.FromProcProc[p]];
};
WriteCharSets:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE ←
NIL] ~ {
text: REF TEXT ~ NEW[TEXT[48]];
Fold: PROC ~ {specs ← Rope.Concat[specs, Rope.FromRefText[text]]; text.length ← 0};
PutByte:
PROC [b: [0..256)] ~ {
IF text.length = text.maxLength THEN Fold[];
text[text.length] ← VAL[b];
text.length ← text.length + 1;
};
PutInt:
PROC [int:
INT, more:
BOOLEAN ←
FALSE] ~ {
IF int > 127 THEN {PutInt[int/128, TRUE]; int ← int MOD 128};
IF more THEN int ← int + 128;
PutByte[int];
};
charSet: [0..256) ← 0;
charSetRepeat: INT ← 0;
FlushRun:
PROC ~ {
IF charSetRepeat > 0 THEN {PutInt[charSetRepeat]; PutByte[charSet]; charSetRepeat ← 0};
};
Action:
PROC [item:
REF, repeat:
INT]
RETURNS [quit:
BOOL ←
FALSE] ~ {
new: [0..256) ←
WITH item
SELECT
FROM
r: REF [0..256) => r^,
ENDCASE => 0;
IF charSetRepeat > 0 AND new#charSet THEN FlushRun[];
charSet ← new;
charSetRepeat ← charSetRepeat + repeat;
};
[] ← Rosary.MapRuns[[NARROW[value]], Action];
FlushRun[];
Fold[];
IF Rope.Size[specs] = 0 THEN specs ← NIL;
};
ReadCharProps:
PROC [name:
ATOM, specs:
ROPE]
RETURNS [value:
REF] ~ {
Raises a bounds fault if invalid specs are provided.
Encoding is
(<repeatCount><propsCount>(<atomLen><atomBytes><valueLen><valueBytes>)*)*,
where the counts and lengths are encoded with the variable-length integer encoding scheme described in FileOps.
p:
PROC [q:
PROC [
REF,
INT]] ~ {
i: INT ← 0;
size: INT ← Rope.Size[specs];
GetByte: PROC RETURNS [b: [0..256)] ~ {b ← Rope.Fetch[specs, i]-'\000; i ← i + 1};
Combine:
PROC [a:
INT, b: [0..128)]
RETURNS [
INT] ~ {
bnd: NAT ~ LAST[NAT]/128+1;
RETURN [Basics.DoubleShiftLeft[[li[Basics.BoundsCheckHighHalf[a, bnd]]], 7].li + b];
};
GetInt:
PROC
RETURNS [int:
INT ← 0] ~ {
b: [0..256) ← GetByte[];
WHILE b > 127
DO
int ← Combine[int, b-128];
b ← GetByte[];
ENDLOOP;
int ← Combine[int, b];
};
GetRope:
PROC
RETURNS [rope:
ROPE ←
NIL] ~ {
len: INT ~ GetInt[];
rope ← Rope.Substr[specs, i, len];
i ← i + len;
[] ← Basics.NonNegative[size-i];
};
UNTIL i = size
DO
repeatCount: INT ~ GetInt[];
propsCount: INT ~ GetInt[];
propList: Atom.PropList ← NIL;
THROUGH [0..propsCount)
DO
atom: ATOM ~ Atom.MakeAtom[GetRope[]];
valueSpecs: ROPE ~ GetRope[];
value: REF ~ DoSpecs[atom, valueSpecs];
propList ← CONS[NEW[Atom.DottedPairNode ← [key: atom, val: value]], propList];
ENDLOOP;
q[propList, repeatCount];
ENDLOOP;
};
RETURN [Rosary.FromProcProc[p]];
};
WriteCharProps:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE ←
NIL] ~ {
curRope: ROPE ← NIL;
Grab: PROC RETURNS [rope: ROPE] ~ {rope ← curRope; curRope ← NIL};
PutByte: PROC [b: [0..256)] ~ {curRope ← Rope.Concat[curRope, Rope.FromChar[VAL[b]]]};
PutRope: PROC [rope: ROPE] ~ {curRope ← Rope.Concat[curRope, rope]};
PutInt:
PROC [int:
INT, more:
BOOLEAN ←
FALSE] ~ {
IF int > 127 THEN {PutInt[int/128, TRUE]; int ← int MOD 128};
IF more THEN int ← int + 128;
PutByte[int];
};
rept: INT ← 0;
itemSpecs: ROPE ← NIL;
FlushRun: PROC ~ { IF rept > 0 THEN {PutInt[rept]; PutRope[itemSpecs]; rept ← 0} };
PutItem:
PROC [newItemSpecs:
ROPE, repeat:
INT] ~ {
IF NOT Rope.Equal[newItemSpecs, itemSpecs] THEN FlushRun[];
itemSpecs ← newItemSpecs;
rept ← rept + repeat;
};
Action:
PROC [item:
REF, repeat:
INT]
RETURNS [quit:
BOOL ←
FALSE] ~ {
save: ROPE ~ Grab[];
SpecsList:
PROC [propList: Atom.PropList]
RETURNS [s:
LIST
OF
REF ←
NIL] ~ {
FOR p: Atom.PropList ← propList, p.rest
UNTIL p =
NIL
DO
atom: ATOM ~ NARROW[p.first.key];
v: ROPE ~ GetSpecs[atom, p.first.val];
IF v #
NIL
THEN {
a: ROPE ~ Atom.GetPName[atom];
PutInt[Rope.Size[a]]; PutRope[a]; PutInt[Rope.Size[v]]; PutRope[v];
s ← CONS[Grab[], s];
};
ENDLOOP;
};
specList: LIST OF REF ← List.Sort[SpecsList[NARROW[item]]];
newItemSpecs: ROPE;
PutInt[List.Length[specList]];
UNTIL specList =
NIL
DO
t: LIST OF REF ← specList;
PutRope[NARROW[t.first]];
specList ← t.rest;
t.rest ← NIL;
ENDLOOP;
newItemSpecs ← Grab[];
curRope ← save;
PutItem[newItemSpecs, repeat];
};
[] ← Rosary.MapRuns[[NARROW[value]], Action];
FlushRun[];
specs ← Grab[];
IF Rope.Size[specs] = 0 THEN specs ← NIL;
};
FindName:
PROC [n: TextNode.Ref, name:
ATOM, remove:
BOOL]
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
PROC [n: TextNode.Ref, name:
ATOM, value:
REF] ~ {
prop: Prop ← FindName[n, name, FALSE];
IF name = charpropsAtom
OR name = charsetsAtom
THEN {
value ← CheckRosarySize[NARROW[value], n, name];
};
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;
formatAtom => n.formatName ← NIL;
commentAtom => n.comment ← FALSE;
charpropsAtom => n.hascharprops ← FALSE;
charsetsAtom => n.hascharsets ← FALSE;
artworkAtom => n.hasartwork ← FALSE;
ENDCASE;
RETURN
};
SELECT name
FROM
styleDefAtom => n.hasstyledef ← TRUE;
prefixAtom => { n.hasprefix ← TRUE };
postfixAtom => { n.haspostfix ← TRUE };
formatAtom => {
n.formatName ← NARROW[value];
RETURN;
};
commentAtom => {
-- simply set the bit in the node
n.comment ← NARROW[value, REF BOOL]^;
RETURN;
};
charpropsAtom => n.hascharprops ← TRUE;
charsetsAtom => n.hascharsets ← TRUE;
artworkAtom => n.hasartwork ← TRUE;
ENDCASE;
IF prop#NIL THEN { prop.value ← value; RETURN };
n.props ← NEW[NodePropsBody ← [name: name, value: value, next: n.props]];
};
CheckRosarySize:
PROC [rosary:
ROSARY, n: TextNode.Ref, what:
ATOM]
RETURNS [
ROSARY] ~ {
IF rosary #
NIL
THEN {
rosarySize: INT ~ Rosary.Size[rosary];
ropeSize: INT ~ Rope.Size[n.rope];
IF rosarySize # ropeSize
THEN {
msg: ROPE ~ IO.PutFR["NodePropsImpl: %g property discarded because its size (%g) differed from rope size (%g).", IO.atom[what], IO.int[rosarySize], IO.int[ropeSize]];
MessageWindow.Append[msg, TRUE];
MessageWindow.Blink[];
RETURN [NIL];
};
};
RETURN [rosary];
};
GetProp:
PUBLIC
PROC [n: TextNode.Ref, name:
ATOM]
RETURNS [value:
REF] ~ {
prop: Prop ← FindName[n, name, FALSE];
IF prop #
NIL
THEN
value ← prop.value
ELSE
IF name = commentAtom
THEN
value ← IF n # NIL AND n.comment THEN true ELSE false
ELSE
IF name = formatAtom
THEN
value ← IF n.formatName = NIL THEN NIL ELSE n.formatName;
};
RemProp:
PUBLIC
PROC [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;
formatAtom => n.formatName ← NIL;
commentAtom => n.comment ← FALSE;
charpropsAtom => n.hascharprops ← FALSE;
charsetsAtom => n.hascharsets ← FALSE;
artworkAtom => n.hasartwork ← FALSE;
ENDCASE;
};
MapProps:
PUBLIC
PROC [n: TextNode.Ref, action: MapPropsAction,
formatFlag, commentFlag:
BOOL ←
TRUE]
RETURNS [quit: BOOL] ~ {
apply the action to each name & value pair for the node
returns true if&when an action returns true
IF n#
NIL
THEN {
props: Props ← n.props;
IF formatFlag AND n.formatName#NIL AND action[formatAtom, n.formatName] THEN RETURN [TRUE];
IF commentFlag AND action[commentAtom, IF n.comment THEN true ELSE false] THEN RETURN [TRUE];
WHILE props#
NIL
DO
next: Props ← props.next; -- get it now in case action deletes current prop
IF props.value # NIL AND action[props.name, props.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]]]
};
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]
};
RefCopy:
PUBLIC
PROC [name:
ATOM, value:
REF]
RETURNS [new:
REF] ~ {
RETURN [value]
};
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]
};
Property Attributes
attributeTable: LIST OF LIST OF ATOM ← NIL;
DeclarePropertyAttribute:
PUBLIC
ENTRY
PROC [name:
ATOM, attribute:
ATOM] ~ {
FOR a:
LIST
OF
LIST
OF
ATOM ← attributeTable, a.rest
UNTIL a=
NIL
DO
IF a.first.first = name
THEN {
FOR p:
LIST
OF
ATOM ← a.first.rest, p.rest
UNTIL p=
NIL
DO
IF p.first = attribute THEN RETURN;
ENDLOOP;
a.first.rest ← CONS[attribute, a.first.rest];
RETURN;
};
ENDLOOP;
attributeTable ← CONS[LIST[name, attribute], attributeTable];
};
Is:
PUBLIC
ENTRY
PROC [name:
ATOM, attribute:
ATOM]
RETURNS [
BOOL] ~ {
FOR a:
LIST
OF
LIST
OF
ATOM ← attributeTable, a.rest
UNTIL a=
NIL
DO
IF a.first.first = name
THEN {
FOR p:
LIST
OF
ATOM ← a.first.rest, p.rest
UNTIL p=
NIL
DO
IF p.first = attribute THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
};
ENDLOOP;
RETURN [FALSE];
};
GetPropertyAttributes:
PUBLIC
ENTRY
PROC [name:
ATOM]
RETURNS [
LIST
OF
ATOM] ~ {
FOR a:
LIST
OF
LIST
OF
ATOM ← attributeTable, a.rest
UNTIL a=
NIL
DO
IF a.first.first = name THEN RETURN [a.first.rest];
ENDLOOP;
RETURN [NIL];
};
SetPropertyAttributes:
PUBLIC
ENTRY
PROC [name:
ATOM, attributes:
LIST
OF
ATOM] ~ {
FOR a:
LIST
OF
LIST
OF
ATOM ← attributeTable, a.rest
UNTIL a=
NIL
DO
IF a.first.first = name THEN {a.first.rest ← attributes; RETURN};
ENDLOOP;
attributeTable ← CONS[CONS[name, attributes], attributeTable];
};
Property Attribute Documentation
$Visible says whether property affects appearance
$Inheritable says whether property may be inherited when a new node is inserted
$ClientOnly asserts EditTool interface should not change the value
Initialization
Init:
PROC ~ {
visible: LIST OF ATOM ~ LIST[$Visible];
visAndInherit: LIST OF ATOM ~ CONS[$Inheritable, visible];
visAndClient:
LIST
OF
ATOM ~
CONS[$ClientOnly, visible];
Register[prefixAtom, ReadPfix, WritePfix, RefCopy];
SetPropertyAttributes[prefixAtom, visAndInherit];
Register[postfixAtom, ReadPfix, WritePfix, RefCopy];
SetPropertyAttributes[postfixAtom, visAndInherit];
Register[formatAtom, ReadFormat, WriteFormat, RefCopy];
SetPropertyAttributes[formatAtom, visAndInherit];
Register[commentAtom, ReadFormat, WriteFormat, RefCopy];
SetPropertyAttributes[commentAtom, visAndInherit];
Register[$CharSets, ReadCharSets, WriteCharSets, RefCopy];
SetPropertyAttributes[$CharSets, visAndClient];
Register[$CharProps, ReadCharProps, WriteCharProps, RefCopy];
SetPropertyAttributes[$CharProps, visAndClient];
SetPropertyAttributes[$StyleDef, visAndInherit];
SetPropertyAttributes[$Artwork, visible];
SetPropertyAttributes[$Interpress, visible];
SetPropertyAttributes[$Bounds, visible];
};
Init[];
END.