-- 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

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


RelationNutImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, InputFocus, Nut, NutOps, NutViewer, Rope, Schema,
Menus, MessageWindow, ViewerOps, ViewerTools, Convert
EXPORTS SystemNuts =

BEGIN OPEN DB, Schema, 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
{viewer: Viewer = NARROW[parent];
  rInfo: RelationInfo = NARROW[ ViewerOps.FetchProp[viewer, $RelationInfo] ];
  seg: DB.Segment = rInfo.segment;
rName: ROPE = rInfo.rName;
InputFocus.SetInputFocus[];  -- kill the caret
ViewerOps.DestroyViewer[viewer.child];
[] ← Nut.Edit[d: RelationDomain, eName: rName, parent: viewer, method: replace, seg: seg]};

----------------------------
RelationCreate: PUBLIC Nut.CreateProc =
{ RETURN[ Nut.DefaultCreate[nutType, d, eName, seg, column] ] };

RelationDisplayer: PUBLIC Nut.DisplayProc =
BEGIN
IF NutOps.IsSystemRelation[e] THEN
{ NutViewer.Message[NIL, "Displaying system relation not implemented" ]; RETURN };
{ lastViewer: Viewer← NutViewer.Initialize[newV];
rInfo: RelationInfo = NEW[ RelationInfoRecord ];
ViewerOps.SetMenu[newV, displayerMenu];
ViewerOps.AddProp[newV, $RelationInfo, rInfo];
--ViewerOps.AddProp[newV, $Domain, DB.RelationDomain];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
rInfo.rName ← NameOf[e];
rInfo.segment ← seg;
rInfo.relation ← e;
lastViewer← NutViewer.MakeLabel[
  name: Rope.Cat["------------------", NameOf[e], ": ------------------"], sib: lastViewer];
lastViewer← BuildTitleButtons[lastViewer, e];
lastViewer← NutViewer.MakeRuler[lastViewer];
BuildRelshipWindowButtons[lastViewer, e];
ViewerOps.PaintViewer[newV, all] }
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: NutViewer.ProcessSelection,
data: NEW[NutViewer.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
[] ← Nut.Display[e: V2E[GetP[fd.attribute, fd.property]], parent: (v← NARROW[parent]).parent];
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.EditProc =
BEGIN
info: RelationInfo;
lastV: Buttons.Button;
attributes: AttributeList;
segment: Segment = seg;
IF NutOps.IsSystemRelation[DB.DeclareRelation[name: eName, segment: seg, version: OldOnly]]
THEN {
NutViewer.Error[NIL, eName, " is a system relation. You may not edit it."]; RETURN};
ViewerOps.SetMenu[newV, editorMenu];
lastV← NutViewer.Initialize[newV];
info ← NEW[RelationInfoRecord];
info.segment← segment;
info.relation ← FetchEntity[d, eName, segment];
info.rName← eName;
lastV ← NutViewer.MakeButton[
q: NutViewer.DBQueue[], name: "NEW ATTRIBUTE", proc: NewAttribute,
sib: lastV, border: TRUE];
IF info.relation = NIL THEN {ViewerOps.AddProp[newV, $RelationInfo, info]; RETURN};
attributes ← NutOps.AttributesOf[info.relation];
FOR attributes ← attributes, attributes.rest WHILE attributes # NIL DO
info.attributes←CONS[
DisplayAttribute[NIL, attributes.first, lastV, info.segment], info.attributes];
lastV ← info.attributes.first.length;
ENDLOOP;
info.attributes ← Reverse[info.attributes];
ViewerOps.AddProp[newV, $RelationInfo, info];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
END;

RenameProc: Menus.MenuProc =
BEGIN
  viewer: Viewer = NARROW[parent];
rInfo: 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: 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: RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
viewer.child ← NIL;
ViewerOps.PaintViewer[viewer, client];
IF rInfo # NIL THEN
RelationEditor[RelationDomain, rInfo.rName, viewer, rInfo.segment];
END;

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

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

SaveAttribute: PROCEDURE[r: Relation, info: 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 ← 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;

RelationQueryer: PUBLIC Nut.QueryProc = { Nut.DefaultQuery[d, newV, segment] };

-- start code
BuildMenus[];

END.

Change log.

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