-- File: RelationNutImpl.mesa
-- Contents: Implementation of the Relation Nut windows.
-- Last edited by:
 -- Cattell on: August 10, 1983 11:45 am
 -- Willie-Sue on: February 22, 1983 3:51 pm
 -- Maxwell on: June 8, 1982 8:43 am
-- Donahue, May 11, 1983 4:35 pm
-- Butler on: June 27, 1984 3:55:02 pm PDT


DIRECTORY
Atom USING [GetPropFromList],
Buttons,
Convert,
DB,
DefaultNutUtilities,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
MessageWindow,
Nut,
NutOps,
NutViewer,
Rope,
SchemaNut,
ViewerOps USING [AddProp, FetchProp, PaintViewer, SetMenu],
ViewerTools,
ViewerClasses;



RelationNutImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, Nut, NutOps, NutViewer, Rope, SchemaNut,
DefaultNutUtilities, Menus, MessageWindow, ViewerOps, ViewerTools, Convert =


BEGIN OPEN DB, ViewerTools;


Viewer: TYPE = ViewerClasses.Viewer;
AttributeFieldObject: TYPE = RECORD[ attribute: Attribute, property: Attribute ];
AttributeFieldHandle: TYPE = REF AttributeFieldObject;

displayerMenu: Menus.Menu ← Menus.CreateMenu[];
editorMenu: Menus.Menu = Menus.CreateMenu[];


BuildMenus: PROC =
BEGIN
Menus.AppendMenuEntry[
displayerMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Edit", EditProc]];
Menus.AppendMenuEntry[
displayerMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Freeze",
NutViewer.DefaultFreezeProc]];
Menus.AppendMenuEntry[
editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Erase", EraseProc]];
Menus.AppendMenuEntry[
editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Rename", RenameProc]];
Menus.AppendMenuEntry[
editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Save", SaveProc]];
Menus.AppendMenuEntry[
editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Reset", ResetProc]];
END;


EditProc: Menus.MenuProc =
-- Copied from NutDefaultImpl.EditDisplayerProc
BEGIN
viewer: Viewer = NARROW[parent];
rInfo: SchemaNut.RelationInfo = NARROW[ ViewerOps.FetchProp[viewer, $RelationInfo] ];
DefaultNutUtilities.Edit[eName: rInfo.rName, d: RelationDomain, seg: rInfo.segment, parent: viewer];
END;

----------------------------

RelationDisplayer: PUBLIC Nut.ProcType =
BEGIN
e: DB.Entity = FetchEntity[d, eName];
IF newV = NIL THEN
newV ← NutViewer.SpawnViewer[e: e, eName: eName, d: RelationDomain, seg: seg];
IF NutOps.IsSystemRelation[e] THEN BEGIN
NutViewer.Message[NIL, "Displaying system relation not implemented" ];
RETURN
END;
BEGIN
lastViewer: Viewer← NutViewer.Initialize[newV];
rInfo: SchemaNut.RelationInfo = NEW[ SchemaNut.RelationInfoRecord ];
ViewerOps.SetMenu[newV, displayerMenu];
ViewerOps.AddProp[newV, $RelationInfo, rInfo];
--ViewerOps.AddProp[newV, $Domain, DB.RelationDomain];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
rInfo.rName ← eName;
rInfo.segment ← seg;
rInfo.relation ← e;
lastViewer← NutViewer.MakeLabel[
name: Rope.Cat["------------------", eName, ": ------------------"],
sib: lastViewer];
lastViewer← BuildTitleButtons[lastViewer, e];
TRUSTED { lastViewer← NutViewer.MakeRuler[lastViewer] };
BuildRelshipWindowButtons[lastViewer, e];
ViewerOps.PaintViewer[newV, all]
END;
END;


BuildTitleButtons: PROC[lastViewer: Viewer, e: Relation] RETURNS [Viewer] =
BEGIN firstOnLine: BOOL;
myAttrs: AttributeList = NutOps.AttributesOf[e];
colWidth: INTEGER;
-- Put up attributes names line
 IF myAttrs=NIL THEN RETURN[lastViewer]; -- no attributes!
 colWidth ← lastViewer.parent.ww / ALength[myAttrs] - 1;
firstOnLine← TRUE;
FOR alT: AttributeList← myAttrs, alT.rest UNTIL alT=NIL DO
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[alT.first], proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, NIL]],
  width: colWidth, sib: lastViewer, newLine: firstOnLine];
 firstOnLine← FALSE;
 ENDLOOP;
-- Put up attributes types and uniquenesses line
 firstOnLine← TRUE;
FOR alT: AttributeList← myAttrs, alT.rest UNTIL alT=NIL DO
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[],
  name: Rope.Cat[GetName[V2E[GetP[alT.first, aTypeIs]]],
  " (", NutOps.GetUniquenessString[alT.first], ")" ],
  proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, aTypeIs]],
  width: colWidth, sib: lastViewer, newLine: firstOnLine];
 firstOnLine← FALSE;
 ENDLOOP;
RETURN[lastViewer]
END;


BuildRelshipWindowButtons: PROC[lastViewer: Viewer, e: Relation] =
-- Display all the relships in relation e
 BEGIN
count: INT← 0;
t: Relship;
myTuples: RelshipSet← RelationSubset[e];
al: AttributeList← NutOps.AttributesOf[e];
UNTIL Null[t← NextRelship[myTuples]] DO
IF (count← count+1)>100 THEN
{lastViewer← NutViewer.MakeLabel[
"... more than 100 tuples: rest truncated ...", lastViewer, TRUE]; EXIT};
lastViewer← BuildTuplesButtons[lastViewer, al, t];
ENDLOOP;
ReleaseRelshipSet[myTuples];
END;


BuildTuplesButtons: PROC[lastViewer: Viewer, al: AttributeList, t: Relship] RETURNS [Viewer] =
-- Creates one line of buttons on the screen for one database tuple
 BEGIN aValue: ROPE;
colWidth: INTEGER;
firstOnLine: BOOL← TRUE;
colWidth ← lastViewer.parent.ww / ALength[al] - 1;
FOR alT: AttributeList← al, alT.rest UNTIL alT=NIL DO
aValue← GetFS[t, alT.first];
lastViewer← NutViewer.MakeButton[
q: NutViewer.DBQueue[],
name: aValue,
proc: DefaultNutUtilities.ProcessSelection,
data: NEW[DefaultNutUtilities.FieldObject← [t, alT.first]], sib: lastViewer,
width: colWidth, newLine: firstOnLine];
firstOnLine← FALSE;
ENDLOOP;
RETURN[lastViewer]
END;


ProcessAttributeSelection: Buttons.ButtonProc =
BEGIN
fd: AttributeFieldHandle← NARROW[clientData];
v: Viewer;
IF fd.property=NIL THEN MessageWindow.Append["Not an entity-valued field"]
ELSE BEGIN
e: Entity ← V2E[GetP[fd.attribute, fd.property]];
parent: Viewer ← (v← NARROW[parent]).parent;
newV: Viewer ← NutViewer.SpawnViewer[e: e, eName: NutOps.SafeNameOf[e], parent: parent];
Nut.Display[e: e, eName: NutOps.SafeNameOf[e], newV: newV];
END;
END;


ALength: PROC[al: AttributeList] RETURNS[len: INTEGER] =
-- Why the FOO won't List.Length work on AttributeLists? compiler complains...
 {len𡤀 FOR alT: AttributeList← al, alT.rest UNTIL alT=NIL DO len←len+1 ENDLOOP};



-- Relation Editor --


RelationEditor: PUBLIC Nut.ProcType =
BEGIN
info: SchemaNut.RelationInfo;
lastV: Buttons.Button;
attributes: AttributeList;
segment: Segment = seg;
e: Entity ← FetchEntity[d, eName, segment];
IF newV = NIL THEN
newV ← NutViewer.SpawnViewer[e: e, eName: eName, d: d, seg: segment];
IF NutOps.IsSystemRelation[DB.DeclareRelation[name: eName, segment: seg, version: OldOnly]]
THEN BEGIN
NutViewer.Error[NIL, eName, " is a system relation. You may not edit it."];
RETURN
END;
ViewerOps.SetMenu[newV, editorMenu];
lastV← NutViewer.Initialize[newV];
info ← NEW[SchemaNut.RelationInfoRecord];
info.segment← segment;
info.relation ← e;
info.rName← eName;
lastV ← NutViewer.MakeButton[q: NutViewer.DBQueue[], name: "NEW ATTRIBUTE",
proc: SchemaNut.NewAttribute, sib: lastV, border: TRUE];
IF info.relation = NIL THEN BEGIN
ViewerOps.AddProp[newV, $RelationInfo, info];
RETURN;
END;
attributes ← NutOps.AttributesOf[info.relation];
FOR attributes ← attributes, attributes.rest WHILE attributes # NIL DO
info.attributes←CONS[SchemaNut.DisplayAttribute[NIL, attributes.first, lastV, info.segment], info.attributes];
lastV ← info.attributes.first.length;
ENDLOOP;
info.attributes ← SchemaNut.Reverse[info.attributes];
ViewerOps.AddProp[newV, $RelationInfo, info];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
END;


RenameProc: Menus.MenuProc =
BEGIN
  viewer: Viewer = NARROW[parent];
rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
rInfo.rName← ViewerTools.GetSelectionContents[];
IF rInfo.relation#NIL THEN SetName[rInfo.relation, rInfo.rName];
viewer.name← Rope.Cat["Relation: ", rInfo.rName];
ViewerOps.PaintViewer[viewer, caption];
END;


EraseProc: Menus.MenuProc =
BEGIN
  viewer: Viewer = NARROW[parent];
rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
IF rInfo.relation = NIL THEN NutViewer.Message[viewer, "Relation does not yet exist!"]
ELSE DestroyRelation[rInfo.relation];
ResetProc[viewer];
END;


ResetProc: Menus.MenuProc =
BEGIN
viewer: Viewer = NARROW[parent];
rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
viewer.child ← NIL;
ViewerOps.PaintViewer[viewer, client];
IF rInfo # NIL THEN
DefaultNutUtilities.Reset[eName: rInfo.rName, d: RelationDomain, seg: rInfo.segment, parent: viewer];
END;

SaveProc: Menus.MenuProc =
BEGIN
viewer: Viewer = NARROW[parent];
rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
IF rInfo # NIL THEN SaveRelation[viewer];
END;

SaveRelation: PROCEDURE[viewer: Viewer] =
BEGIN
new: Relation;
info: SchemaNut.RelationInfo;
ok: BOOLEAN ← TRUE;
newV: Viewer;
e: Entity;
info ← NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
new ← DeclareRelation[NIL, info.segment];
FOR list: LIST OF SchemaNut.AttributeInfo ← info.attributes, list.rest WHILE list # NIL DO
IF ~SaveAttribute[new, list.first] THEN ok ← FALSE;
ENDLOOP;
IF ~ok THEN BEGIN
DestroyRelation[new];
RETURN;
END;
IF info.relation # NIL THEN BEGIN
SchemaNut.CopyRelships[info.relation, new];
DestroyRelation[info.relation];
END;
SetName[new, info.rName];
viewer.child ← NIL;
ViewerOps.AddProp[viewer, $RelationInfo, NIL];
e ← FetchEntity[NIL, info.rName];
newV ← NutViewer.ReplaceViewer[e: e, eName: info.rName, seg: info.segment, parent: viewer];
Nut.Display[e: e, eName: info.rName, seg: info.segment, newV: newV];
END;

SaveAttribute: PROCEDURE[r: Relation, info: SchemaNut.AttributeInfo] RETURNS[ok: BOOLEAN ← TRUE] =
BEGIN
name: ROPE;
type: DataType;
length: INT ← 0;
uniqueness: Uniqueness;
name ← GetContents[info.name];
IF name.Length[] = 0 THEN RETURN[TRUE];
type ← SchemaNut.GetDataType[GetContents[info.type], info.segment];
IF type = NIL THEN RETURN[FALSE];
length ← GetLengthNumber[GetContents[info.length]];
uniqueness ← GetUniquenessValue[info.uniqueness.name];
[]← DeclareAttribute[r, name, type, uniqueness, length ! Error => { ok ← FALSE; CONTINUE}];
IF ~ok THEN NutViewer.Error[NIL, "Bad attribute: ", name];
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;


GetUniquenessValue: PROCEDURE[rope: ROPE] RETURNS[Uniqueness] =
BEGIN
SELECT TRUE FROM
Rope.Equal[rope, "uniqueness: Key"] => RETURN[Key];
Rope.Equal[rope, "uniqueness: OptionalKey"] => RETURN[OptionalKey];
Rope.Equal[rope, "uniqueness: NonKey"] => RETURN[None];
ENDCASE => ERROR;
END;


-- start code
BuildMenus[];
Nut.Register["Relation", NIL, RelationDisplayer, RelationEditor];

END.


Change log.

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

Butler June 26, 1984:
Updated to register relation displayer and editor. Many minor changes
to comply with new Nut organization.