
<<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, July 17, 1984 5:17:28 pm PDT>>
<<Butler on:  August 13, 1984 8:15:17 pm PDT>>


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


RelationNutImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, Nut, NutOps, NutViewer, Rope, SchemaNut, VFonts,
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[];

--Fonts used when displaying Relations
headerFont: VFonts.Font
 _ VFonts.EstablishFont[family: "TimesRoman", size: 10, bold: TRUE];
labelFont: VFonts.Font
 _ VFonts.EstablishFont[family: "Tioga", size: 10, italic: TRUE];
entryFont: VFonts.Font
 _ VFonts.EstablishFont[family: "Helvetica", size: 10, bold: TRUE];


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];
entity: ROPE;
segment: DB.Segment;
[segment: segment, entity: entity] _ Nut.GetNutInfo[viewer];
[] _ RelationEditor[eName: entity, domain: "RelationDomain", segment: segment, lastSpawned: viewer];
END;

GetRelation: PROC[v: Viewer] RETURNS[d: DB.Domain] = {
<<this procedure returns either the cached $Relation property or it computes the relation from the NutInfo values>>
d _ DB.V2E[ViewerOps.FetchProp[v, $Relation]];
IF NOT DB.Null[d] THEN RETURN;
{ segment: DB.Segment;
entity: Rope.ROPE;
relation: DB.Relation;
[entity: entity, segment: segment] _ Nut.GetNutInfo[v];
relation _ DB.DeclareRelation[entity, segment, OldOnly];
<<cache the result>>
ViewerOps.AddProp[v, $Relation, relation];
RETURN[ relation ] } };

RelationDisplayer: PUBLIC Nut.NutProc =
BEGIN
e: DB.Entity = DB.DeclareRelation[eName, segment, OldOnly];
IF NutOps.IsSystemRelation[eName] THEN BEGIN
NutViewer.Message[NIL, "Displaying system relation not implemented"];
RETURN 
END;
v _ NutViewer.ReplaceViewer[eName, domain, segment, lastSpawned];
BEGIN
lastViewer: Viewer_ NutViewer.Initialize[v];
rInfo: SchemaNut.RelationInfo = NEW[ SchemaNut.RelationInfoRecord ];
ViewerOps.SetMenu[v, displayerMenu];
ViewerOps.AddProp[v, $RelationInfo, rInfo];
ViewerOps.AddProp[v, $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[v, 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;
font2: NutButtons.ButtonFontInfo _ NEW[ NutButtons.ButtonFontInfoRec ];
firstOnLine: BOOL_ TRUE;
font2.singleFont _ entryFont;
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, font: font2];
firstOnLine_ FALSE;
ENDLOOP;
RETURN[lastViewer]
END; 


ProcessAttributeSelection: Buttons.ButtonProc =
BEGIN
fd: AttributeFieldHandle_ NARROW[clientData];
IF fd.property=NIL THEN MessageWindow.Append["Not an entity-valued field"]
ELSE BEGIN
e: Entity _ V2E[GetP[fd.attribute, fd.property]];
parent: Viewer = (NARROW[parent, Viewer]).parent;
IF DB.Null[e] THEN RETURN;
[] _ Nut.Display[eName: DB.NameOf[e], domain: DB.NameOf[DB.DomainOf[e]], segment: DB.SegmentOf[e], parent: parent];
END;
END;


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


<<Relation Editor -->>


RelationEditor: PUBLIC Nut.NutProc =
BEGIN
info: SchemaNut.RelationInfo;
lastV: Buttons.Button;
attributes: AttributeList;
relation: Relation _ DB.DeclareRelation[eName, segment, OldOnly];
IF NutOps.IsSystemRelation[eName]THEN BEGIN
NutViewer.Error[NIL, eName, " is a system relation.  You may not edit it."];
RETURN
END;
v _ NutViewer.ReplaceViewer[eName: eName, domain: "RelationDomain", seg: segment, parent: lastSpawned];
ViewerOps.SetMenu[v, editorMenu];
ViewerOps.AddProp[v, $Relation, relation];
ViewerOps.AddProp[v, $RelationInfo, info];
lastV_ NutViewer.Initialize[v];
info _ NEW[SchemaNut.RelationInfoRecord];
lastV _ NutViewer.MakeButton[q: NutViewer.DBQueue[], name: "NEW ATTRIBUTE",
proc: SchemaNut.NewAttribute, sib: lastV, border: TRUE];
IF DB.Null[relation] THEN RETURN;
attributes _ NutOps.AttributesOf[relation];
FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO
info.attributes_CONS[SchemaNut.DisplayAttribute[NIL, attributes.first, lastV, segment], info.attributes];
lastV _ info.attributes.first.length;
ENDLOOP;
info.attributes _ SchemaNut.Reverse[info.attributes];
ViewerOps.PaintViewer[v, all]
END;


RenameProc: Menus.MenuProc =
BEGIN
viewer: Viewer = NARROW[parent];
relation: DB.Domain = GetRelation[viewer];
newName: Rope.ROPE = ViewerTools.GetSelectionContents[];
IF relation#NIL THEN DB.ChangeName[relation, newName];
viewer.name_ Rope.Cat["Relation: ", newName];
ViewerOps.PaintViewer[viewer, caption];
Nut.ChangeName[viewer, newName]
END;


EraseProc: Menus.MenuProc = 
BEGIN
viewer: Viewer = NARROW[parent];
relation: DB.Relation = GetRelation[viewer];
IF DB.Null[relation] THEN NutViewer.Message[viewer, "Relation does not yet exist!"]
ELSE DestroyRelation[relation];
ResetProc[viewer];
END;


ResetProc: Menus.MenuProc = 
BEGIN
viewer: Viewer = NARROW[parent];
eName: Rope.ROPE;
segment: DB.Segment;
[entity: eName, segment: segment] _ Nut.GetNutInfo[viewer];
DefaultNutUtilities.Reset[eName: eName, domain: "RelationDomain", seg: segment, viewer: viewer];
END;

SaveProc: Menus.MenuProc = 
BEGIN
SaveRelation[NARROW[parent]];
END;

SaveRelation: PROCEDURE[viewer: Viewer] =
BEGIN
new: Relation;
relation: Relation = GetRelation[viewer];
info: SchemaNut.RelationInfo;
eName: Rope.ROPE;
segment: DB.Segment;
ok: BOOLEAN _ TRUE;
info _ NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
[entity: eName, segment: segment] _ Nut.GetNutInfo[viewer];
new _ DeclareRelation[NIL, 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 NOT DB.Null[relation] THEN BEGIN
SchemaNut.CopyRelships[relation, new]; 
DestroyRelation[relation];
END;
SetName[new, eName];
ViewerOps.AddProp[viewer, $RelationInfo, NIL];
[] _ RelationDisplayer[eName: eName, domain: "RelationDomain", segment: segment, lastSpawned: viewer];
END;

SaveAttribute: PROCEDURE[r: Relation, info: SchemaNut.AttributeInfo] RETURNS[ok: BOOLEAN _ TRUE] =
BEGIN
name: ROPE;
type: DataType;
segment: DB.Segment = DB.SegmentOf[r];
length: INT _ 0;
uniqueness: Uniqueness;
name _ GetContents[info.name];
IF name.Length[] = 0 THEN RETURN[TRUE];
type _ SchemaNut.GetDataType[GetContents[info.type], 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.