NodePropsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
written by Paxton. January 1981
Michael Plass, September 27, 1991 1:52 pm PDT
Rick Beach, March 28, 1985 9:57:47 am PST
Russ Atkinson (RRA) August 19, 1985 4:17:41 pm PDT
Spreitze, July 9, 1990 4:56 pm PDT
Doug Wyatt, February 9, 1993 1:42 pm PST
DIRECTORY
Atom USING [GetPName, MakeAtom],
Basics USING [NonNegative],
List USING [Length, Sort],
NodeProps USING [CopyInfoProc, MapPropsAction, ReadSpecsProc, WriteSpecsProc],
Prop USING [PropList, Get, Put, MapAction, Map],
RefTab USING [Create, Fetch, Ref, Store],
Rope USING [Concat, Equal, Fetch, FromChar, FromRefText, IsEmpty, ROPE, Size, Substr],
Rosary USING [ROSARY, FromRuns, MapRuns],
TextEdit USING [ItemFromCharSet],
Tioga USING [Node, CharSet];
NodePropsImpl: CEDAR MONITOR
IMPORTS Atom, Basics, List, Prop, RefTab, Rope, Rosary, TextEdit
EXPORTS NodeProps
~
BEGIN
ROSARY: TYPE = Rosary.ROSARY;
ROPE: TYPE = Rope.ROPE;
PropList: TYPE = Prop.PropList;
CharSet: TYPE = Tioga.CharSet;
CopyInfoProc: TYPE = NodeProps.CopyInfoProc;
MapPropsAction: TYPE = NodeProps.MapPropsAction;
ReadSpecsProc: TYPE = NodeProps.ReadSpecsProc;
WriteSpecsProc:
TYPE = NodeProps.WriteSpecsProc;
nameFormat: PUBLIC ATOM ¬ $Format;
nameComment: PUBLIC ATOM ¬ $Comment;
nameCharSets: PUBLIC ATOM ¬ $CharSets;
nameCharProps: PUBLIC ATOM ¬ $CharProps;
nameStyleDef: PUBLIC ATOM ¬ $StyleDef;
namePrefix: PUBLIC ATOM ¬ $Prefix;
namePostfix: PUBLIC ATOM ¬ $Postfix;
nameArtwork: PUBLIC ATOM ¬ $Artwork;
nameActive:
PUBLIC
ATOM ¬ $Active;
ReadComment:
PROC [name:
ATOM, specs:
ROPE]
RETURNS [value:
REF] ~ {
RETURN [ValueFromBool[Rope.Equal[specs, "TRUE", FALSE]]];
};
WriteComment:
PROC [name:
ATOM, value:
REF]
RETURNS [specs:
ROPE] ~ {
comment: BOOL ~ BoolFromValue[value];
specs ¬ IF comment THEN "TRUE" ELSE "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 => IF value = NIL THEN specs ¬ "";
};
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;
};
IntByte:
TYPE ~
MACHINE
DEPENDENT
RECORD [more:
BOOL, data: [0..128)];
NOTE: the variable-length integers in this encoding are stored high-order byte first, whereas variable-length integers elsewhere in Tioga files are stored low-order byte first! (DKW discovered this while porting Tioga to PCedar.)
GetInt:
PROC [get:
PROC
RETURNS [
BYTE]]
RETURNS [int:
INT ¬ 0] ~ {
DO byte: IntByte ~
LOOPHOLE[get[]];
int ¬ int*128+byte.data;
IF NOT byte.more THEN EXIT;
ENDLOOP;
};
PutInt:
PROC [int:
INT, put:
PROC [
BYTE], more:
BOOL ¬
FALSE] ~ {
byte: IntByte ~ [more: more, data: int MOD 128];
IF int>=128 THEN PutInt[int/128, put, TRUE];
put[LOOPHOLE[byte]];
};
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 above, and <charSet> is just encoded as a byte.
p:
PROC [q:
PROC [
REF,
INT]] ~ {
size: INT ~ Rope.Size[specs];
i: INT ¬ 0;
GetByte: PROC RETURNS [b: BYTE] ~ {b ¬ ORD[Rope.Fetch[specs, i]]; i ¬ i + 1};
UNTIL i = size
DO
repeat: INT ~ GetInt[GetByte];
charSet: BYTE ~ GetByte[];
q[TextEdit.ItemFromCharSet[charSet], repeat];
ENDLOOP;
};
RETURN [Rosary.FromRuns[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:
BYTE] ~ {
IF text.length = text.maxLength THEN Fold[];
text[text.length] ¬ VAL[b];
text.length ¬ text.length + 1;
};
charSet: CharSet ¬ 0;
rept: INT ¬ 0;
FlushRun: PROC ~ {IF rept>0 THEN { PutInt[rept, PutByte]; PutByte[charSet]; rept ¬ 0 }};
Action:
PROC [item:
REF, repeat:
INT]
RETURNS [quit:
BOOL ¬
FALSE] ~ {
new: CharSet ¬
WITH item
SELECT
FROM
r: REF CharSet => r,
ENDCASE => 0;
IF rept > 0 AND new#charSet THEN FlushRun[];
charSet ¬ new;
rept ¬ rept + 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 above.
p:
PROC [q:
PROC [
REF,
INT]] ~ {
i: INT ¬ 0;
size: INT ¬ Rope.Size[specs];
GetByte: PROC RETURNS [b: BYTE] ~ {b ¬ ORD[Rope.Fetch[specs, i]]; i ¬ i + 1};
GetRope:
PROC
RETURNS [rope:
ROPE ¬
NIL] ~ {
len: INT ~ GetInt[GetByte];
rope ¬ Rope.Substr[specs, i, len];
i ¬ i + len;
[] ¬ Basics.NonNegative[size-i];
};
UNTIL i = size
DO
repeatCount: INT ~ GetInt[GetByte];
propsCount: INT ~ GetInt[GetByte];
head, tail: Prop.PropList ¬ NIL;
THROUGH [0..propsCount)
DO
atom: ATOM ~ Atom.MakeAtom[GetRope[]];
valueSpecs: ROPE ~ GetRope[];
value: REF ~ DoSpecs[atom, valueSpecs];
new: Prop.PropList ~ CONS[[key: atom, val: value], NIL];
IF head=NIL THEN head ¬ new ELSE tail.rest ¬ new;
tail ¬ new;
ENDLOOP;
q[head, repeatCount];
ENDLOOP;
};
RETURN [Rosary.FromRuns[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: BYTE] ~ {curRope ¬ Rope.Concat[curRope, Rope.FromChar[VAL[b]]]};
PutRope: PROC [rope: ROPE] ~ {curRope ¬ Rope.Concat[curRope, rope]};
rept: INT ¬ 0;
itemSpecs: ROPE ¬ NIL;
FlushRun: PROC ~ {IF rept>0 THEN {PutInt[rept, PutByte]; 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: Prop.PropList]
RETURNS [s:
LIST
OF
REF ¬
NIL] ~ {
FOR p: Prop.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], PutByte]; PutRope[a];
PutInt[Rope.Size[v], PutByte]; PutRope[v];
s ¬ CONS[Grab[], s];
};
ENDLOOP;
};
specList: LIST OF REF ¬ List.Sort[SpecsList[NARROW[item]]];
newItemSpecs: ROPE;
PutInt[List.Length[specList], PutByte];
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;
};
emptyAtom:
ATOM ~ Atom.MakeAtom[
NIL];
AtomFromValue:
PUBLIC
PROC [value:
REF]
RETURNS [
ATOM] ~ {
WITH value
SELECT
FROM
atom: ATOM => RETURN[atom];
ENDCASE => RETURN[NIL];
};
ValueFromAtom:
PUBLIC
PROC [atom:
ATOM]
RETURNS [
REF] ~ {
RETURN[IF atom=emptyAtom THEN NIL ELSE atom];
};
refBoolFromBool:
ARRAY
BOOL
OF
REF
BOOL ~ [
FALSE: NEW[BOOL ¬ FALSE], TRUE: NEW[BOOL ¬ TRUE]
];
BoolFromValue:
PUBLIC
PROC [value:
REF]
RETURNS [
BOOL] ~ {
WITH value
SELECT
FROM
refBool: REF BOOL => RETURN[refBool];
ENDCASE => RETURN[FALSE];
};
ValueFromBool:
PUBLIC
PROC [bool:
BOOL]
RETURNS [
REF] ~ {
RETURN[refBoolFromBool[bool]];
};
PutProp:
PUBLIC
PROC [n: Tioga.Node, name:
ATOM, value:
REF] ~ {
SELECT name
FROM
nameFormat => n.format ¬ AtomFromValue[value];
nameComment => n.comment ¬ BoolFromValue[value];
nameCharSets, nameCharProps => ERROR;
ENDCASE => {
oldList: PropList ~ n.nodeProps;
newList: PropList ~ Prop.Put[oldList, name, value];
IF newList#oldList
THEN {
hasProp: BOOL ~ (value#NIL);
SELECT name
FROM
nameStyleDef => n.hasStyleDef ¬ hasProp;
namePrefix => n.hasPrefix ¬ hasProp;
namePostfix => n.hasPostfix ¬ hasProp;
nameArtwork => n.hasArtwork ¬ hasProp;
nameActive => n.hasActive ¬ hasProp;
ENDCASE;
n.nodeProps ¬ newList;
};
};
};
GetProp:
PUBLIC
PROC [n: Tioga.Node, name:
ATOM]
RETURNS [value:
REF] ~ {
SELECT name
FROM
nameFormat => RETURN[ValueFromAtom[n.format]];
nameComment => RETURN[ValueFromBool[n.comment]];
ENDCASE => RETURN[Prop.Get[n.nodeProps, name]];
};
MapProps:
PUBLIC
PROC [n: Tioga.Node, 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 {
IF formatFlag
AND n.format#
NIL
THEN {
IF action[nameFormat, ValueFromAtom[n.format]] THEN RETURN [TRUE];
};
IF commentFlag
THEN {
IF action[nameComment, ValueFromBool[n.comment]] THEN RETURN [TRUE];
};
{
-- properties other than $Format and $Comment
propAction: Prop.MapAction ~ { RETURN[action[NARROW[key], val]] };
RETURN[Prop.Map[n.nodeProps, propAction]];
};
};
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[namePrefix, ReadPfix, WritePfix, RefCopy];
SetPropertyAttributes[namePrefix, visAndInherit];
Register[namePostfix, ReadPfix, WritePfix, RefCopy];
SetPropertyAttributes[namePostfix, visAndInherit];
Register[nameFormat, ReadFormat, WriteFormat, RefCopy];
SetPropertyAttributes[nameFormat, visAndInherit];
Register[nameComment, ReadComment, WriteComment, RefCopy];
SetPropertyAttributes[nameComment, visAndInherit];
Register[nameCharSets, ReadCharSets, WriteCharSets, RefCopy];
SetPropertyAttributes[nameCharSets, visAndClient];
Register[nameCharProps, ReadCharProps, WriteCharProps, RefCopy];
SetPropertyAttributes[nameCharProps, visAndClient];
SetPropertyAttributes[nameStyleDef, visAndInherit];
SetPropertyAttributes[nameArtwork, visible];
SetPropertyAttributes[$NewlineDelimiter, visible];
SetPropertyAttributes[$FileExtension, visible];
SetPropertyAttributes[$Interpress, CONS[$ClientOnly, visible]];
SetPropertyAttributes[$Bounds, visible];
};
Init[];
END.