[Indigo]<Squirrel>NewTop>RelationNutImpl.mesa!1

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: 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];

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[

sib: lastViewer];

lastViewer← BuildTitleButtons[lastViewer, e];

TRUSTED { lastViewer← NutViewer.MakeRuler[lastViewer] };

BuildRelshipWindowButtons[lastViewer, e];

ViewerOps.PaintViewer[v, 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[],

" (", 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

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[],

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

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;

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

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.