EBNullDocImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Kenneth A. Pier, October 1, 1992 11:24 am PDT
Bier, September 29, 1992 4:10 pm PDT
DIRECTORY
EBEditors, EBLanguage, EBTypes, EmbeddedButtons, EBNullDoc, IO, List, Prop, Rope, SymTab;
EBNullDocImpl:
CEDAR
PROGRAM
IMPORTS EBEditors, IO, List, Prop, Rope, SymTab
EXPORTS EBNullDoc = BEGIN
ActiveDoc: TYPE = EBTypes.ActiveDoc;
ActiveButton: TYPE = EBTypes.ActiveButton;
Variable: TYPE = EBLanguage.Variable;
VariableObj: TYPE = EBLanguage.VariableObj;
VariableType: TYPE = EBLanguage.VariableType;
VariableTypeObj: TYPE = EBLanguage.VariableTypeObj;
ROPE: TYPE = Rope.ROPE;
ActiveDoc Class
nullActiveDocClass: EBEditors.ActiveDocClass ¬
NEW[EBEditors.ActiveDocClassObj ¬ [
name: $NullDoc,
getRef: NullDocGetRef,
setRef: NullDocSetRef,
mapRef: NullDocMapRef,
getDocName: NullDocGetDocName,
feedback: NullDocButtonFeedback, -- Feedback is the name of an interface
inButton: NullDocInButton
]];
NullDoc: TYPE = REF NullDocObj;
NullDocObj:
TYPE =
RECORD [
instantiated: BOOL ← FALSE,
docName: ROPE,
buttons: SymTab.Ref -- maps button names to button datas
];
NullButton: TYPE = REF NullButtonObj;
NullButtonObj:
TYPE =
RECORD [
name: ROPE, -- button name
firstValue: NameVariablePair, -- built by Create*Button. First variable and value
moreValues: LIST OF NameVariablePair, -- built by Add*Variable. More variables and values
propList: Prop.PropList -- built by Instantiate from "firstValue" and "moreValues" fields
];
NameVariablePair:
TYPE =
RECORD [
name: ROPE,
variable: EBLanguage.Variable
VariableObj: TYPE = RECORD [
type: VariableType,
VariableTypeObj: TYPE = RECORD [
class: {boolean, atom, rope, integer, real, enumerated},
enumeration: SEQUENCE count: NAT OF REF ANY
];
value: REF
];
];
NullDocGetRef: EBEditors.GetRefProc = {
PROC [key: ATOM, button: ActiveButton, doc: ActiveDoc] RETURNS [ref: REF];
nullButton: NullButton ← NARROW[button];
ref ¬ Prop.Get[nullButton.propList, key];
};
NullDocSetRef: EBEditors.SetRefProc = {
PROC [key: ATOM, button: ActiveButton, doc: ActiveDoc, ref: REF, edited: BOOL];
nullButton: NullButton ← NARROW[button];
nullButton.propList ¬ Prop.Put[nullButton.propList, key, ref];
};
NullDocMapRef: EBEditors.MapRefProc = {
PROC [doc: ActiveDoc, mapProc: EachButtonProc] RETURNS [aborted: BOOL ¬ FALSE];
EachButtonProc: TYPE = PROC [button: ActiveButton, doc: ActiveDoc] RETURNS [done: BOOL]
ForEachButton: SymTab.EachPairAction = {
PROC [key: Key, val: Val] RETURNS [quit: BOOL]
nullButton: NullButton ← NARROW[val];
quit ¬ mapProc[nullButton, doc];
};
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
aborted ¬ SymTab.Pairs[buttons, ForEachButton];
};
NullDocGetDocName: EBEditors.GetDocNameProc ~ {
PROC [doc: ActiveDoc] RETURNS [name: ROPE];
name ← NARROW[doc.theDoc, NullDoc].docName;
};
NullDocButtonFeedback: EBEditors.FeedbackProc = {
PROC[button: ActiveButton, doc: ActiveDoc, feedback: REF] RETURNS [REF];
RETURN[NIL];
};
NullDocInButton: EBEditors.InButtonProc = {
RETURN[FALSE];
};
Interface procs
EBLanguage interface defines class: {boolean, atom, rope, integer, real, enumerated}
Create:
PUBLIC
PROC [docName:
ROPE]
RETURNS [doc: ActiveDoc] = {
nullDoc: NullDoc ← NEW[NullDocObj ← [FALSE, docName, SymTab.Create[]] ];
doc ¬ EBEditors.CreateActiveDoc[nullDoc, nullActiveDocClass];
};
emptyRope: ROPE = "";
semiRope: ROPE = "; ";
prefix: ROPE = "Poppy1\nClass: MultiStateButton\nVariables: ("; -- prefix for every button data
suffix: ROPE = ")\n";
Instantiate:
PUBLIC
PROC [doc: ActiveDoc] = {
InstantiateEachButton: EmbeddedButtons.EachButtonProc = {
EachButtonProc: TYPE = PROC [button: ActiveButton, doc: ActiveDoc] RETURNS [done: BOOL ¬ FALSE];
RopeFromNameVariablePair:
PROC [nv: NameVariablePair, semiColon:
BOOL]
RETURNS [r:
ROPE] = {
r is a ROPE of the form: "Name: TYPE = VALUE " or "Name: TYPE = VALUE; "
SELECT nv.variable.type.class
FROM
boolean => {
r ← IO.PutFR["%g: BOOL = %g%g", [rope[nv.name]], [boolean[NARROW[nv.variable.value, REF BOOL]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ];
};
atom => {
r ← IO.PutFR["%g: ATOM = %g%g", [rope[nv.name]], [atom[NARROW[nv.variable.value, ATOM]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ];
};
rope => {
r ← IO.PutFR["%g: STRING = \"%g\"%g", [rope[nv.name]], [rope[NARROW[nv.variable.value, ROPE]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ];
};
integer => {
r ← IO.PutFR["%g: INT = %g%g", [rope[nv.name]], [integer[NARROW[nv.variable.value, REF INT]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ];
};
real => {
r ← IO.PutFR["%g: REAL = %g%g", [rope[nv.name]], [real[NARROW[nv.variable.value, REF REAL]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ];
};
enumerated => {
x: {3, 7, 15} = 3; -- INT base type
x: {"Hello", "Goodbye"} = "Hello"; -- ROPE base type
x: {Foo, Bar} = Foo; -- ATOM base type
x: {34.2, 63.6, 12.2} = 63.6; -- REAL base type
x: {FALSE, TRUE} = FALSE -- BOOL base type (pretty silly)
RopeFromEnumeration:
PROC [v: VariableType]
RETURNS [e:
ROPE] = {
e ← "{"; -- open curly bracket
FOR n:
NAT
IN [1.. v.count]
DO
e ←
IO.PutFR["%g%g%g",
[rope[e]],
WITH v[n-1]
SELECT
FROM
z: ROPE => [rope[Rope.Cat["\"", z, "\""]]],
z: ATOM => [atom[z]],
z: REF INT => [integer[z]],
z: REF REAL => [real[z]],
z: REF BOOL => [boolean[z]],
ENDCASE => [rope["UnknownEnumType"]],
IF n<v.count THEN [rope[", "]] ELSE [rope[""]]
];
ENDLOOP;
e ← Rope.Concat[e, "}"]; -- close curly bracket
};
r ←
IO.PutFLR["%g: %g = %g%g",
LIST[
[rope[nv.name]],
[rope[RopeFromEnumeration[nv.variable.type]]],
WITH nv.variable.value
SELECT
FROM
z: ROPE => [rope[Rope.Cat["\"", z, "\""]]],
z: ATOM => [atom[z]],
z: REF INT => [integer[z]],
z: REF REAL => [real[z]],
z: REF BOOL => [boolean[z]],
ENDCASE => [rope["UnknownValueType"]],
[rope[IF semiColon THEN semiRope ELSE emptyRope]]
]
];
};
ENDCASE => ERROR;
};
bdRope: ROPE;
buttonData: REF;
nB: NullButton ← NARROW[button];
FOR l:
LIST
OF NameVariablePair ← nB.
moreValues, l.rest
UNTIL l=
NIL
DO
bdRope ← Rope.Concat[bdRope, RopeFromNameVariablePair[l.first, l.rest#NIL]];
ENDLOOP;
bdRope ← Rope.Concat[RopeFromNameVariablePair[nB.firstValue, nB.moreValues # NIL], bdRope];
bdRope ← Rope.Concat[prefix, bdRope]; -- concat the required prefix for buttonData
bdRope ← Rope.Concat[bdRope, suffix]; -- concat the required suffix for buttonData
bdRope ← Rope.Cat[bdRope, "Name: ", nB.name];
buttonData ¬ EBEditors.ButtonDataFromRope[rope: bdRope, instantiateNow: FALSE, button: button, doc: doc];
NullDocSetRef[key: $ButtonData, ref: buttonData, button: button, doc: doc, edited: FALSE];
};
aborted: BOOL ¬ TRUE;
thisDoc: NullDoc ← NARROW[doc.theDoc];
aborted ¬ NullDocMapRef[doc: doc, mapProc: InstantiateEachButton];
IF NOT aborted THEN thisDoc.instantiated ← TRUE;
};
CreateBOOLButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
BOOL]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF BOOL ← NEW[BOOL ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: boolean]--], value: valRef]]]]];
button.firstValue.variable.type.class ¬ boolean;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddBOOLVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
BOOL] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF BOOL ← NEW[BOOL ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: boolean]--], value: varValRef]] ];
nvPair.variable.type.class ¬ boolean;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
CreateATOMButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
ATOM]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF ATOM ← NEW[ATOM ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: atom]--], value: initialVarVal]]]]];
button.firstValue.variable.type.class ¬ atom;
button.firstValue.variable.type.enumeration ¬ ;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddATOMVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
ATOM] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF ATOM ← NEW[ATOM ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ATOM]--], value: varVal]] ];
nvPair.variable.type.class ¬ atom;
nvPair.variable.type.enumeration ¬ ;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
CreateROPEButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
ROPE]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF ROPE ← NEW[ROPE ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: rope]--], value: initialVarVal]]]]];
button.firstValue.variable.type.class ¬ rope;
button.firstValue.variable.type.enumeration ¬ ;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddROPEVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
ROPE] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF ROPE ← NEW[ROPE ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ROPE]--], value: varVal]] ];
nvPair.variable.type.class ¬ rope;
nvPair.variable.type.enumeration ¬ ;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
CreateINTButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
INT]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF INT ← NEW[INT ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: integer]--], value: valRef]]]]];
button.firstValue.variable.type.class ¬ integer;
button.firstValue.variable.type.enumeration ¬ ;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddINTVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
INT] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF INT ← NEW[INT ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: integer]--], value: varValRef]] ];
nvPair.variable.type.class ¬ integer;
nvPair.variable.type.enumeration ¬ ;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
CreateREALButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
REAL]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF REAL ← NEW[REAL ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: real]--], value: valRef]]]]];
button.firstValue.variable.type.class ¬ real;
button.firstValue.variable.type.enumeration ¬ ;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddREALVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
REAL] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF REAL ← NEW[REAL ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: real]--], value: varValRef]] ];
nvPair.variable.type.class ¬ real;
nvPair.variable.type.enumeration ¬ ;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
CreateRopeEnumerationButton is preferable to CreateEnumeratedButton because it does better type checking and avoids the spurious use of REF TEXT where ROPE is required.
CreateRopeEnumerationButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
ROPE, type:
LIST
OF
ROPE]
RETURNS [ActiveButton] = {
OPEN List;
ptr, anyList: LORA;
ptr ¬ anyList ¬ CONS[type.first, NIL];
FOR al:
LIST
OF
ROPE ¬ type.rest, al.rest
UNTIL al=
NIL
DO
ptr.rest ¬ CONS[al.first, NIL];
ptr ¬ ptr.rest
ENDLOOP;
RETURN[CreateEnumeratedButton[doc, buttonName, initialVarVal, anyList]];
};
AddRopeEnumerationVariable:
PUBLIC PROC [button: ActiveButton, varName:
ROPE, varVal:
ROPE, type:
LIST
OF
ROPE] = {
OPEN List;
ptr, anyList: LORA;
ptr ¬ anyList ¬ CONS[type.first, NIL];
FOR al:
LIST
OF
ROPE ¬ type.rest, al.rest
UNTIL al=
NIL
DO
ptr.rest ¬ CONS[al.first, NIL];
ptr ¬ ptr.rest
ENDLOOP;
AddEnumeratedVariable[button, varName, varVal, anyList];
};
See end of this document for explanation of Enumerated type
CreateEnumeratedButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal:
REF, type:
LIST
OF
REF]
RETURNS [ActiveButton] = {
count: NAT ¬ 0;
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[List.Length[type]]-- ¬ [class: enumerated]--], value: initialVarVal]]]]];
button.firstValue.variable.type.class ¬ enumerated;
FOR elements:
LIST
OF
REF ← type, elements.rest
UNTIL elements =
NIL
DO
button.firstValue.variable.type.enumeration[count] ¬ elements.first;
count ← count + 1;
ENDLOOP;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddEnumeratedVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal:
REF, type:
LIST
OF
REF] = {
count: NAT ¬ 0;
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[List.Length[type]]-- ¬ [class: ]--], value: varVal]] ];
nvPair.variable.type.class ¬ enumerated;
FOR elements:
LIST
OF
REF ← type, elements.rest
UNTIL elements =
NIL
DO
nvPair.variable.type.enumeration[count] ¬ elements.first;
count ← count + 1;
ENDLOOP;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
END.
CreateButton:
PUBLIC
PROC [doc: ActiveDoc, buttonName:
ROPE, initialVarVal: ]
RETURNS [ActiveButton] = {
button: NullButton;
buttons: SymTab.Ref ← NARROW[doc.theDoc, NullDoc].buttons;
valRef: REF ← NEW[ ¬ initialVarVal];
button ← NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ]--], value: valRef]]]]];
button.firstValue.variable.type.class ¬ ;
button.firstValue.variable.type.enumeration ¬ ;
[] ¬ SymTab.Store[buttons, buttonName, button];
RETURN[button];
};
AddVariable:
PUBLIC
PROC [button: ActiveButton, varName:
ROPE, varVal: ] = {
nvPair: NameVariablePair;
nullButton: NullButton ← NARROW[button];
varValRef: REF ← NEW[ ¬ varVal];
nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ]--], value: varValRef]] ];
nvPair.variable.type.class ¬ ;
nvPair.variable.type.enumeration ¬ ;
nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues];
};
Enumerated types in Poppy are more general than in Cedar. Any base type can form an enumerated type. For example:
x: {3, 7, 15} = 3; -- INT base type
x: {"Hello", "Goodbye"} = "Hello"; -- ROPE base type
x: {Foo, Bar} = Foo; -- ATOM base type
x: {34.2, 63.6, 12.2} = 63.6; -- REAL base type
x: {FALSE, TRUE} = FALSE -- BOOL base type (pretty silly)