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