-- SchemaImpl.mesa
-- Last edited by
-- John Maxwell on June 7, 1982 10:55 am
-- Rick Cattell on June 6, 1983 1:13 pm
-- Willie-Sue on February 22, 1983 4:26 pm
-- Jim Donahue, May 12, 1983 8:34 am

DIRECTORY
Buttons USING [Button, ButtonProc],
Convert USING [IntFromRope, ValueToRope],
DB,
Labels USING [Label],
Menus USING [Menu],
MessageWindow,
NutOps USING [GetRefAttributes, GetRelation ],
NutViewer,
Rope,
Schema,
ViewerClasses USING [Viewer],
ViewerOps,
ViewerTools USING [GetContents, SetContents];

SchemaImpl: CEDAR PROGRAM
IMPORTS
Convert, DB, MessageWindow, NutOps, NutViewer, Rope,
Schema, ViewerOps, ViewerTools
EXPORTS Schema =

BEGIN
OPEN DB, ViewerTools, Schema;

ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;

DisplayAttribute: PUBLIC PROCEDURE[r: Relation, a: Attribute,
      lastV: Viewer, segment: DB.Segment ← NIL] RETURNS[info: AttributeInfo]=
BEGIN -- r # NIL means that we are displaying a PROPERTY
-- [name: ] type: uniqueness: OptionalKey length:
info ← NEW[AttributeInfoRecord];
info.relation ← r;
info.segment ← IF segment = NIL THEN SegmentOf[r] ELSE segment;
info.nameLabel ← NutViewer.MakeButton[
q: NutViewer.DBQueue[], name: "name:", proc: NewAttribute,
sib: lastV, border: TRUE, newLine: TRUE];
info.name ← NutViewer.NextRightTextViewer[info.nameLabel, 110];
info.typeLabel ← NutViewer.MakeLabel["type:", info.name];
info.type ← NutViewer.NextRightTextViewer[info.typeLabel, 130];
info.uniqueness ← NutViewer.MakeButton[
NutViewer.DBQueue[], OptionalKeyLabel, ToggleUniqueness, info.type];
info.lengthLabel ← NutViewer.MakeLabel["length:", info.uniqueness];
info.length ← NutViewer.NextRightTextViewer[info.lengthLabel, 50];
IF a = NIL THEN {SetContents[info.uniqueness, GetUniquenessLabel[None]]; RETURN};
SetContents[info.name, GetName[IF r # NIL THEN r ELSE a]];
SetContents[info.type, GetName[V2E[GetP[a, aTypeIs]]]];
SetContents[info.uniqueness, GetUniquenessLabel[V2U[GetP[a, aUniquenessIs]]]];
SetContents[info.length, GetLengthString[a]];
END;

AddAttribute: PUBLIC PROCEDURE[button: Viewer, segment: DB.Segment,
      oldList: LIST OF AttributeInfo] RETURNS[newList: LIST OF AttributeInfo] =
BEGIN
y: INTEGER;
found: BOOLEAN;
attribute: AttributeInfo;
MoveChild: ViewerOps.EnumProc = {
IF v.wy > y THEN ViewerOps.MoveViewer[v, v.wx, v.wy + dy, v.ww, v.wh, FALSE]};
-- move everything below it down
y ← button.wy + 5;
ViewerOps.EnumerateChildren[button.parent, MoveChild];
-- append a new attribute line on the screen AND in the list
attribute ← DisplayAttribute[NIL, NIL, button, segment];
found ← FALSE;
FOR list: LIST OF AttributeInfo ← oldList, list.rest WHILE list # NIL DO
IF list.first.nameLabel # button THEN LOOP;
list.rest ← CONS[attribute, list.rest];
found ← TRUE;
EXIT; ENDLOOP;
IF ~found THEN oldList ← CONS[attribute, oldList];
RETURN[oldList];
END;

dy: INTEGER ← 17;

RemoveAttribute: PUBLIC PROCEDURE[button: Viewer, oldList: LIST OF AttributeInfo]
RETURNS[newList: LIST OF AttributeInfo, relation: Relation] =
BEGIN
y: INTEGER;
parent: Viewer;
found: BOOLEAN;
attribute: AttributeInfo;
MoveChild: ViewerOps.EnumProc = {
IF v.wy > y THEN ViewerOps.MoveViewer[v, v.wx, v.wy - dy, v.ww, v.wh, FALSE]};
-- remove attribute from list
found ← FALSE;
IF oldList = NIL THEN RETURN[NIL, NIL];
FOR list: LIST OF AttributeInfo ← oldList, list.rest DO
IF list.rest = NIL THEN EXIT;
IF list.rest.first.nameLabel # button THEN LOOP;
attribute ← list.rest.first;
list.rest ← list.rest.rest;
found ← TRUE;
EXIT; ENDLOOP;
IF ~found THEN {
IF oldList.first.nameLabel # button THEN RETURN[oldList, NIL];
attribute ← oldList.first;
oldList ← oldList.rest};
-- remove attribute from display
y ← button.wy + 5;
parent ← button.parent;
ViewerOps.DestroyViewer[attribute.nameLabel, FALSE];
ViewerOps.DestroyViewer[attribute.name, FALSE];
ViewerOps.DestroyViewer[attribute.typeLabel, FALSE];
ViewerOps.DestroyViewer[attribute.type, FALSE];
ViewerOps.DestroyViewer[attribute.uniqueness, FALSE];
ViewerOps.DestroyViewer[attribute.lengthLabel, FALSE];
ViewerOps.DestroyViewer[attribute.length, FALSE];
-- move everything below it up a line
ViewerOps.EnumerateChildren[parent, MoveChild];
RETURN[oldList, attribute.relation];
END;

NewAttribute: PUBLIC Buttons.ButtonProc = {
property: Relation;
viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer.parent, $DomainInfo]];
rInfo: RelationInfo = NARROW[ViewerOps.FetchProp[viewer.parent, $RelationInfo]];
IF dInfo # NIL
THEN IF mouseButton = red
THEN dInfo.properties ← AddAttribute[viewer, dInfo.segment, dInfo.properties]
ELSE { [dInfo.properties, property] ← RemoveAttribute[viewer, dInfo.properties];
IF property # NIL THEN dInfo.deleted ← CONS[property, dInfo.deleted]};
IF rInfo # NIL
THEN IF mouseButton = red
THEN rInfo.attributes ← AddAttribute[viewer, rInfo.segment, rInfo.attributes]
ELSE rInfo.attributes ← RemoveAttribute[viewer, rInfo.attributes].newList;
ViewerOps.PaintViewer[viewer.parent, client] };


GetDataType: PUBLIC PROCEDURE[type: ROPE, segment: DB.Segment] RETURNS[dt: DataType] =
BEGIN
dt ← FetchEntity[DomainDomain, type, segment];
IF dt = NIL THEN dt ← FetchEntity[DataTypeDomain, type, segment];
IF dt = NIL AND Rope.Equal[type, "AnyDomainType", FALSE] THEN dt ← AnyDomainType;
IF dt = NIL THEN MessageWindow.Append[Rope.Cat["INVALID TYPE: ", type]];
END;

GetLengthNumber: PROCEDURE[rope: ROPE] RETURNS[length: INT ← 0] =
INLINE BEGIN
ENABLE ANY => {MessageWindow.Append[Rope.Cat["BAD NUMBER: ", rope]]; CONTINUE};
IF rope.Length[] = 0 THEN RETURN[0];
length ← Convert.IntFromRope[rope];
END;

GetLengthString: PROCEDURE[a: Attribute] RETURNS[length: ROPE] =
{length ← Convert.ValueToRope[[signed[V2I[GetP[a, aLengthIs]]]]]};

KeyLabel: ROPE = "uniqueness: Key";
OptionalKeyLabel: ROPE = "uniqueness: OptionalKey";
NoneLabel: ROPE = "uniqueness: NonKey";

GetUniquenessValue: PROCEDURE[rope: ROPE] RETURNS[Uniqueness] =
BEGIN
SELECT TRUE FROM
rope = KeyLabel => RETURN[Key];
rope = OptionalKeyLabel => RETURN[OptionalKey];
rope = NoneLabel => RETURN[None];
ENDCASE => ERROR;
END;

GetUniquenessLabel: PROCEDURE[uniqueness: Uniqueness] RETURNS[ROPE] =
BEGIN
SELECT uniqueness FROM
Key => RETURN[KeyLabel];
OptionalKey => RETURN[OptionalKeyLabel];
None => RETURN[NoneLabel];
ENDCASE => ERROR;
END;

ToggleUniqueness: Buttons.ButtonProc =TRUSTED
BEGIN
viewer: Viewer← NARROW[parent];
SELECT GetUniquenessValue[viewer.name] FROM
None => SetContents[viewer, KeyLabel];
Key => SetContents[viewer, OptionalKeyLabel];
OptionalKey => SetContents[viewer, NoneLabel];
ENDCASE => ERROR;
viewer.newVersion ← TRUE;
END;

NextName: PUBLIC PROCEDURE[list: ROPE]
    RETURNS[token, newList: ROPE, ok: BOOLEAN ← TRUE] =
BEGIN
comma, length: INT;
-- remove leading spaces
WHILE TRUE DO
IF list.Length[] = 0 THEN RETURN[NIL, NIL, TRUE];
IF list.Fetch[0] = ' THEN list ← list.Substr[1] ELSE EXIT;
ENDLOOP;
length ← list.Length[];
-- find the terminator
comma ← Rope.Find[list, ","];
IF comma = -1 THEN comma ← Rope.Find[list, " "];
IF comma = -1 THEN comma ← length;
token ← list.Substr[0, comma];
IF comma+1 >= length
THEN newList ← NIL
ELSE newList ← list.Substr[comma+1, length];
END;

RemoveDeleted: PUBLIC PROCEDURE[info: AttributeInfo, relations: LIST OF Relation]
RETURNS[LIST OF Relation] =
BEGIN -- look for properties that have been deleted and then reinserted.
name: ROPE;
relation: Relation;
last: LIST OF Relation;
IF relations = NIL THEN RETURN[relations];
IF NoChange[info] THEN RETURN[relations];
IF info.relation # NIL THEN RETURN[relations];
name ← GetContents[info.name];
IF name.Length[] = 0 THEN RETURN[relations];
relation ← DeclareRelation[name, info.segment, OldOnly];
IF relation = NIL THEN RETURN[relations];
FOR list: LIST OF Relation ← relations, list.rest WHILE list # NIL DO
IF ~Eq[relation, list.first] THEN {last ← list; LOOP};
-- we found it!
info.relation ← relation;
IF list = relations THEN RETURN[relations.rest];
last.rest ← list.rest;
RETURN[relations];
ENDLOOP;
RETURN[relations];
END;

CheckProperty: PUBLIC PROCEDURE[d: Domain, info: AttributeInfo, deleted: LIST OF Relation]
RETURNS[ok: BOOLEAN ← TRUE] =
BEGIN
length: INT;
name: ROPE;
old: Relation;
type: DataType;
property: Attribute;
uniqueness: Uniqueness;
name ← GetContents[info.name];
IF name.Length[] = 0 OR NoChange[info] THEN RETURN[TRUE];
-- does a relation of this name already exist?
old ← DeclareRelation[name, info.segment, OldOnly];
IF old # NIL AND ~Eq[old, info.relation] THEN {
MessageWindow.Append[Rope.Cat[name, " PROPERTY ALREADY EXISTS."]];
RETURN[FALSE]};
-- check the new property
type ← GetDataType[GetContents[info.type], info.segment];
IF type = NIL THEN RETURN[FALSE];
length ← GetLengthNumber[GetContents[info.length]];
uniqueness ← GetUniquenessValue[info.uniqueness.name];
property ← DeclareProperty["xxyxx", d, type, info.segment, uniqueness !
         Error => {ok ← FALSE; CONTINUE} ];
DestroyRelation[DeclareRelation["xxyxx", info.segment, OldOnly]];
IF ~ok THEN MessageWindow.Append[Rope.Cat["BAD PROPERTY: ", name]];
END;

SaveProperty: PUBLIC PROCEDURE[d: Domain, info: AttributeInfo] =
BEGIN
length: INT;
name: ROPE;
type: DataType;
property: Attribute;
old, new: Relation;
uniqueness: Uniqueness;
name ← GetContents[info.name];
IF NoChange[info] OR name.Length[] = 0 THEN RETURN;
-- create the new property
old ← info.relation;
type ← GetDataType[GetContents[info.type], info.segment];
length ← GetLengthNumber[GetContents[info.length]];
uniqueness ← GetUniquenessValue[info.uniqueness.name];
property ←
DeclareProperty[IF old = NIL THEN name ELSE "xxyxx", d, type, info.segment, uniqueness];
-- destroy the old property (might have a different name)
IF old # NIL THEN {
new ← DeclareRelation["xxyxx", info.segment, OldOnly];
Schema.CopyRelships[old, new];
DestroyRelation[old];
SetName[new, name]};
END;

NoChange: PROCEDURE[info: AttributeInfo] RETURNS[BOOLEAN] =
INLINE BEGIN
RETURN[~info.name.newVersion AND ~info.uniqueness.newVersion AND
~info.type.newVersion AND ~info.length.newVersion];
END;

Optimized: PUBLIC PROCEDURE[d: Domain] RETURNS[opt: BOOLEAN] =
BEGIN
rs: RelshipSet;
relation: Relation;
uniqueness: Uniqueness;
attributes: AttributeList;
attributes ← NutOps.GetRefAttributes[d];
FOR attributes ← attributes, attributes.rest WHILE attributes # NIL DO
IF Null[attributes.first] THEN LOOP;
uniqueness ← V2U[GetP[attributes.first, aUniquenessIs]];
IF uniqueness # Key THEN LOOP;
relation ← NutOps.GetRelation[attributes.first];
IF ~V2B[GetP[relation, DB.r1to1Prop]] THEN LOOP;
rs ← RelationSubset[relation];
opt ← ~Null[NextRelship[rs]];
ReleaseRelshipSet[rs];
IF opt THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;


Reverse: PUBLIC PROCEDURE[old: LIST OF AttributeInfo] RETURNS[new: LIST OF AttributeInfo]=
BEGIN
FOR old ← old, old.rest WHILE old # NIL DO
new ← CONS[old.first, new];
ENDLOOP;
END;

END . .

Change log


Changed by Cattell on August 10, 1982 1:52 pm: Removed refn to DBViewPrivate.r1to1Prop. Removed 10-line using list for DBView.

Change log.

Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system properties

Cattell February 24, 1983 5:05 pm: fixed overlapping last item on domain editor. Also need to pass segment to various procedures. Also need to catch NotImplemented and RESUME on DeclareSubType.