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 =
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] = {
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];
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;
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;
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] =
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] =
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] =
{len_0; FOR alT: AttributeList_ al, alT.rest UNTIL alT=NIL DO len_len+1 ENDLOOP};





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;


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.
ô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
Copied from NutDefaultImpl.EditDisplayerProc
this procedure returns either the cached $Relation property or it computes the relation from the NutInfo values
cache the result
Put up attributes names line
Put up attributes types and uniquenesses line
Display all the relships in relation e
Creates one line of buttons on the screen for one database tuple
Why the FOO won't List.Length work on AttributeLists?  compiler complains...
Relation Editor --
start code
�Ê
í˜Jš
œ™Jš
œ5™5š
œ™Jš
œ$™$Jš
œ(™(Jš
œ ™ Jš
œ%™%Jš
œ*™*J˜J˜—š
Ïk	˜	Jšœ�œ˜J˜J˜Jš�œ
˜J˜Jšœ�œ/˜:J˜J˜J˜Jš
œ˜J˜
J˜J˜
Jšœ�œ˜#Jšœ
�œ,˜;J˜J˜J˜J˜J˜—šœ�œ
�˜š
�˜Jšœ�œ2˜:J˜LJ˜J˜——Jš�œ
�œ
�œ˜J˜J˜Jšœ�œ˜$Jšœ�œ�œ.˜QJšœ�œ�œ˜6J˜J˜/J˜,J˜Jš
œ&˜&˜Jš
œD˜D—˜J˜A—˜Jš
œC˜C—J˜J˜šÏn
œ�œ˜Jš
�˜˜J˜O—˜˜EJ˜——˜J˜N—˜J˜P—˜J˜L—˜J˜N—Jš�œ
˜J˜J˜—šÏbœ˜Jš
œ,™,š
�˜Jšœ�œ	˜ Jšœ�œ
˜
Jšœ	�œ	˜J˜<J˜dJš�œ
˜J˜——šžœ�œ�œ�œ˜6Jš
œo™oJšœ�œ(˜.Jš
�œ
�œ
�œ	�œ
�œ
˜šœ�œ	˜Jšœ
�œ
˜Jšœ
�œ
˜J˜7Jšœ�œ+˜8Jš
œ™J˜*Jš�œ˜J˜——šŸœ�œ˜'š
�˜Jšœ�œ
�œ*˜;š�œ �œ
�˜,Jšœ�œ0˜EJš�œ
˜Jš�œ
˜—J˜Aš
�˜J˜,Jšœ �œ!˜DJ˜$J˜+J˜#J˜ ———˜D˜J˜-Jš�œ1˜8J˜)J˜Jš�œ
˜Jš�œ
˜J˜J˜J˜——šžœ�œ"�œ˜KJš�œ�œ
˜J˜0Jšœ
�œ
˜Jš
œ™Jš	�œ	�œ
�œ
�œÏc˜9J˜7Jšœ
�œ
˜š�œ'�œ�œ
�˜:˜!J˜RJšœ�œ#�œ˜2J˜8Jšœ
�œ
˜Jš�œ
˜——Jš
œ-™-Jšœ
�œ
˜š�œ'�œ�œ
�˜:˜!J˜˜8J˜3—J˜ Jšœ�œ-˜6J˜8Jšœ
�œ
˜Jš�œ˜	——Jš�œ˜Jš�œ
˜J˜J˜—šžœ�œ#˜CJš
œ&™&Jš
�˜Jšœ�œ˜J˜J˜(J˜*š�œ �˜'š�œ�˜˜!Jšœ<�œ�œ˜I——J˜2Jš�œ
˜—J˜Jš�œ
˜J˜J˜—šžœ�œ4�œ˜^Jš
œ@™@Jš�œ	�œ
˜Jšœ
�œ
˜Jš
œG˜GJšœ
�œ�œ
˜Jš
œ˜J˜2š�œ"�œ�œ
�˜5J˜˜!J˜J˜
J˜+Jšœ�œC˜LJš
œ4˜4—Jšœ
�œ
˜Jš�œ
˜—Jš�œ˜Jš�œ˜J˜J˜—šŸœ˜/š
�˜Jšœ�œ
˜-Jš�œ
�œ
�œ3˜Jš�œ
�˜
J˜1Jšœ�œ˜1Jš�œ
�œ	�œ
�œ
˜Jš	œ�œ�œ�œ�œ˜sJš�œ
˜—Jš�œ
˜J˜J˜J˜J˜——šžœ�œ�œ�œ˜8Jš
œL™LJšœ�œ"�œ�œ
�œ�œ˜QJ˜J˜J˜—Jš
œ™J˜J˜šŸœ�œ˜$š
�˜J˜J˜J˜Jšœ�œ*˜Aš�œ�œ
�˜+Jšœ�œ9˜LJš
�˜Jš�œ
˜—J˜gJ˜!J˜*J˜*J˜Jšœ�œ˜)˜KJšœ2�œ˜8—Jš�œ
�œ�œ
�œ
˜!J˜+š�œ*�œ�œ
�˜FJšœ�œ�œ6˜iJ˜%Jš�œ
˜——J˜5J˜Jš�œ
˜J˜J˜—šŸ
œ˜Jš
�˜Jšœ�œ	˜ Jšœ
�œ˜*Jšœ�œ&˜8Jš�œ
�œ
�œ
�œ˜6J˜-J˜'J˜Jš�œ
˜J˜J˜—šŸ	œ˜š
�˜Jšœ�œ	˜ —Jš
œ,˜,Jš�œ
�œ�œ:˜SJš�œ˜J˜Jš�œ
˜J˜J˜—šŸ	œ˜Jš
�˜Jšœ�œ	˜ Jšœ�œ
˜Jšœ	�œ	˜J˜;J˜`Jš�œ
˜J˜—šŸœ˜Jš
�˜Jšœ
�œ
˜Jš�œ
˜J˜—šžœ�	œ˜)š
�˜J˜J˜)J˜Jšœ�œ
˜Jšœ	�œ	˜Jšœ�œ�œ
˜Jšœ�œ-˜:J˜;Jšœ�œ˜$š�œ�œ
�œ6�œ�œ
�˜ZJš�œ!�œ�œ
˜3Jš�œ
˜—š�œ�œ
�œ
˜J˜Jš�œ
˜Jš�œ
˜—š	�œ
�œ
�œ�œ
�˜#J˜'J˜Jš�œ
˜—J˜Jšœ)�œ˜.J˜fJš�œ
˜J˜——š
ž
œ�	œ-�œ�œ�œ˜bJš
�˜Jšœ�œ
˜J˜J˜&Jšœ�œ˜J˜J˜Jš�œ�œ
�œ
�œ˜'J˜>Jš
�œ�œ
�œ
�œ
�œ˜!J˜3J˜6JšœI�œ�œ˜[Jš�œ�œ�œ˜:Jš�œ
˜J˜J˜—š
žœ�	œ�œ�œ	�œ˜AJš�œ
�˜Jš�œ
�œ;�œ˜OJš�œ�œ
�œ˜$J˜#Jš�œ
˜J˜J˜—šžœ�	œ�œ�œ˜?Jš
�˜š�œ
�œ
�˜Jšœ'�œ˜3Jšœ/�œ˜CJšœ*�œ˜7Jš�œ�œ
˜—Jš�œ
˜J˜J˜—Jš
œ
™
J˜
Jšœ�œ%˜AJ˜Jš�œ
˜J˜J˜J˜J˜J˜LJ˜J˜J˜FJ˜$—…—)
6ë