[Indigo]<Squirrel>butler>Jim>TuplesEditorImpl.mesa!2

File: TuplesEditorImpl.mesa

Created by Donahue November 16, 1982 2:38 pm

Last edited by:

Donahue, April 14, 1983 10:15 am

Cattell, June 24, 1983 3:09 pm

Butler, August 16, 1984 11:07:15 am PDT

Beach, March 28, 1984 9:25:58 pm PST

DIRECTORY

Atom,

BasicTime USING [GMT],

Buttons USING [ButtonProc, ReLabel],

Containers USING [ChildXBound],

DB,

DBEnvironment,

DefaultNutUtilities USING [AttrButtonLength, valueFont],

IO,

Menus USING[ MouseButton, Menu, CreateMenu, SetGuarded, FindEntry ],

Nut,

NutButtons,

NutOps,

NutViewer USING [Error, Message, MakeButton, Initialize, Viewer, MakeBigTextBox, MakeRuler],

Rope,

TuplesEditor,

VFonts USING[CharWidth, FontHeight, Font, EstablishFont, defaultFont, StringWidth],

ViewerIO USING [CreateViewerStreams],

ViewerOps USING [AddProp, FetchProp, PaintViewer, MoveViewer, CreateViewer, EstablishViewerPosition, DestroyViewer, SetNewVersion],

ViewerTools USING [GetContents, SetContents, SetSelection],

ViewerClasses;

TuplesEditorImpl: CEDAR MONITOR

IMPORTS

Atom, Buttons, Containers, DB, DBEnvironment, IO, Nut, NutOps, Menus,

NutViewer, Rope, VFonts, ViewerIO, ViewerOps, ViewerTools, DefaultNutUtilities

EXPORTS TuplesEditor =

{ OPEN DB, Rope, Nut, ViewerClasses;

PosPair: TYPE = RECORD[ row: CARDINAL, col: CARDINAL];

anyErrors: BOOL; -- Set if any procedure discovered user errors in saving the new entries

defaultOld: PUBLIC BOOL← TRUE; -- FALSE => attributes start in NewOrOld mode, else OldOnly

updateList: AttributeValueList;

ViewerList: TYPE = LIST OF ViewerClasses.Viewer;

allFieldsNull: BOOLEAN;

oldRelship: Relship;

buttonSize: INT = 125;

cycleFont: VFonts.Font

← VFonts.EstablishFont[family: "Helvetica", size: 8];

italicFont: VFonts.Font

← VFonts.EstablishFont[family: "TimesRoman", size: 10, italic: TRUE];

xFudge: INT ← 4;

yFudge: INT ← 2;

DisplayTuples: PUBLIC ENTRY PROC[e: Entity, attrList: AttributeList, parent: Viewer]

RETURNS[ Viewer ] =

Main procedure in this module: puts up a subviewer in the parent viewer containing

all the tuples that do or could refer to the entity e. Main loop goes through all

attributes potentially referencing e's domain, and calls AddRow to add a blank tuple

if the tupleList referencing e is empty for that attribute, or the tupleList if it is

not empty.

{ ENABLE UNWIND => NULL;

row: CARDINAL ← 0;

lastButton: NutButtons.NutButton ← NutViewer.Initialize[parent];

skipRelationName: BOOL ← FALSE;

lastAttr: Attribute ← NIL;

typeOut: IO.STREAM;

-- make error message window

lastButton ← ViewerOps.CreateViewer[ flavor: $Typescript, info:

[parent: parent, ww: parent.ww-(3*xFudge), wx: lastButton.wx+xFudge,

wh: 2*VFonts.FontHeight[DefaultNutUtilities.valueFont],

wy: lastButton.wy+yFudge, border: TRUE] ];

Containers.ChildXBound[parent, lastButton];

typeOut ← ViewerIO.CreateViewerStreams[NIL, lastButton].out;

ViewerOps.AddProp[parent, $Typescript, typeOut];

FOR attrL: AttributeList ← attrList, attrL.rest UNTIL attrL = NIL DO

tupleList: LIST OF Relship = IF e = NIL THEN NIL ELSE NutOps.GetTuples[e, attrL.first];

IF tupleList = NIL THEN

[lastButton] ← BuildTuplesButtons[

attrL.first , lastButton, skipRelationName]

ELSE

FOR tlT: LIST OF Relship ← tupleList, tlT.rest UNTIL tlT=NIL DO

[lastButton] ← BuildTuplesButtons[

attrL.first, lastButton, skipRelationName, tlT.first];

IF skipRelationName = FALSE THEN skipRelationName ← TRUE;

ENDLOOP;

IF attrL.rest # NIL THEN

IF Rope.Equal[ GetName[NutOps.GetRelation[attrL.first]],

GetName[NutOps.GetRelation[attrL.rest.first]] ] THEN

skipRelationName ← TRUE

ELSE skipRelationName ← FALSE;

ENDLOOP;

ViewerOps.AddProp[ parent, $Entity, e ];

ViewerOps.AddProp[ parent, $EntityName, NutOps.SafeNameOf[e] ];

ViewerOps.AddProp[ parent, $ChangedRels, NIL ];

RETURN[parent]

};

BuildTuplesButtons: PROC[

attribute: Attribute,

lastButton: NutButtons.NutButton,

skipRelButton: BOOL ← FALSE,

relship: Relship ← NIL ]

RETURNS[NutButtons.NutButton] =

Add a row to the table, where the entity being displayed is assumed to be the value of

the attribute supplied. If a relship is supplied, take the values of the other fields from it;

otherwise, display empty fields.

{

r: Relation = NutOps.GetRelation[attribute];

allAttrs: LIST OF Attribute ← NutOps.AttributesOf[r];

displayAttrs: LIST OF Attribute = NutOps.RemoveAttribute[attribute, allAttrs];

relationButton: NutButtons.NutButton;

visible: BOOL ← NOT skipRelButton;

lastAttrViewer: NutViewer.Viewer;

-- make a relation button

lastButton.wy ← lastButton.wy + yFudge;

relationButton← NutViewer.MakeButton[

q: NIL, proc: RelProc, sib: lastButton, data: r, name: GetName[r],

newLine: TRUE, visible: visible];

ViewerOps.AddProp[relationButton, $relShip, relship];

ViewerOps.AddProp[relationButton, $r, r];

ViewerOps.AddProp[relationButton, $attr, attribute];

ViewerOps.AddProp[relationButton, $Changes, NIL];

lastAttrViewer ← relationButton;

lastButton ← relationButton;

FOR da: LIST OF Attribute ← displayAttrs, da.rest UNTIL da = NIL DO

buttonInfo: NutButtons.ButtonFontInfo ←

NEW[ NutButtons.ButtonFontInfoRec ← [TRUE,,,] ];

nextAttr: Attribute = da.first;

attrValue: ROPE ← IF relship # NIL THEN GetFS[relship, nextAttr] ELSE "";

attrViewer: NutViewer.Viewer;

name: ROPE = Rope.Cat[DB.NameOf[nextAttr], ": ", attrValue ];

entityValuedAttr: BOOL ← FALSE;

-- make old/new button

IF NutOps.EntityValued[nextAttr] THEN BEGIN

entityValuedAttr ← TRUE;

lastButton ← NutViewer.MakeButton[q: NIL, proc: CycleNewOld, sib: lastButton,

data: r, name: IF defaultOld THEN "O" ELSE "", border: TRUE,

font: NEW[ NutButtons.ButtonFontInfoRec ← [FALSE, cycleFont,,]],

width: VFonts.CharWidth['O]+xFudge];

END;

-- make the attribute label button and add all necessary props

attrViewer ← NutViewer.MakeButton[q: NIL, proc: AttrProc, sib: lastButton, data: r,

name: name, font: buttonInfo];

ViewerOps.AddProp[ attrViewer, $attr, nextAttr ];

ViewerOps.AddProp[ lastAttrViewer, $Next, attrViewer ];

ViewerOps.AddProp[attrViewer, $Value, attrValue];

ViewerOps.AddProp[attrViewer, $Relation, relationButton];

IF entityValuedAttr THEN BEGIN

ViewerOps.AddProp[ lastButton, $attrViewer, attrViewer ];

ViewerOps.AddProp[ attrViewer, $OldNew, lastButton ];

ViewerOps.AddProp[

attrViewer, $which, NEW[INT ← IF defaultOld THEN 2 ELSE 0] ];

END;

lastAttrViewer ← attrViewer;

lastButton ← attrViewer

ENDLOOP;

RETURN[lastButton]

};

AttrProc: Buttons.ButtonProc = TRUSTED

{ attrViewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ];

attr: Attribute = V2E[ViewerOps.FetchProp[attrViewer, $attr]];

domain: Domain = V2E[GetP[attr, aTypeIs, aTypeOf]];

value: Rope.ROPE = NARROW[ ViewerOps.FetchProp[attrViewer, $Value] ];

entity: Entity;

IF shift THEN {}

ELSE

SELECT mouseButton FROM

Menus.MouseButton[red] => --edit the value

MakeAttrValueEditor[attrViewer];

Menus.MouseButton[yellow] => --display the attribute

{ entity ← DeclareEntity[ domain, value, Version[OldOnly] !

DB.Error => { entity ← NIL; CONTINUE } ];

IF entity # NIL THEN

[] ← Nut.Display[ eName: DB.NameOf[entity],

domain: DB.NameOf[domain], segment: DB.SegmentOf[entity],

parent: attrViewer.parent ]

ELSE NutViewer.Message[attrViewer, value, " not found!"] };

Menus.MouseButton[blue] => --display type of attribute

{ eType: Entity ← V2E[GetP[attr, aTypeIs, aTypeOf]];

type: Rope.ROPE ← TypeLabel[eType];

typeButton: Viewer ← NutViewer.MakeButton[ q: NIL,

sib: attrViewer,

proc: TypeProc, name: type,

font: NEW[ NutButtons.ButtonFontInfoRec ← [FALSE, italicFont,,]] ];

MoveOver[attrViewer, typeButton.ww];

ViewerOps.AddProp[typeButton, $attrViewer, attrViewer];

ViewerOps.AddProp[attrViewer, $Type, typeButton];

ViewerOps.PaintViewer[typeButton.parent, client];

};

ENDCASE; };

MakeAttrValueEditor: PROC[attrViewer: Viewer] =

creates a text viewer, below the parent & shifts all

BEGIN

v, lastV: ViewerClasses.Viewer;

value: Rope.ROPE = NARROW[ ViewerOps.FetchProp[attrViewer, $Value]];

info: ViewerClasses.ViewerRec ← [parent: attrViewer.parent, wx: attrViewer.wx,

wy: attrViewer.wy+ VFonts.FontHeight[DefaultNutUtilities.valueFont],

ww: MAX[

MIN[buttonSize, VFonts.StringWidth[value, DefaultNutUtilities.valueFont]]+xFudge,

15*VFonts.CharWidth['O] ],

wh: 4*(VFonts.FontHeight[DefaultNutUtilities.valueFont]+yFudge),

border: TRUE, scrollable: FALSE, menu: attrValueMenu ];

MoveTuples[target: attrViewer, numberOfRows: info.wh, justBelow: TRUE, abs: TRUE];

v ← ViewerOps.CreateViewer[flavor: $Container, info: info];

lastV ← NutViewer.Initialize[v];

lastV ← NutViewer.MakeButton[q: NIL, sib: lastV, proc: ValueGrow, name: "Grow"];

lastV ← NutViewer.MakeButton[q: NIL, sib: lastV, proc: ValueDone, name: "Done"];

lastV ← NutViewer.MakeButton[q: NIL, sib: lastV, proc: ValueReset, name: "Reset"];

lastV ← NutViewer.MakeRuler[lastV];

lastV ← NutViewer.MakeBigTextBox[sib: lastV,

contents: NARROW[ ViewerOps.FetchProp[attrViewer, $Value], Rope.ROPE] ];

ViewerTools.SetSelection[ lastV, NIL ];

ViewerOps.AddProp[v, $TextViewer, lastV]; --when buttoning you need the text

ViewerOps.AddProp[v, $Button, attrViewer]; --after editting you need the button

ViewerOps.AddProp[lastV, $Value, value]; --for fast resets

ViewerOps.PaintViewer[attrViewer.parent, all]

END;

RelProc: Buttons.ButtonProc = TRUSTED

BEGIN

viewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ];

attribute: Attribute = V2E[ViewerOps.FetchProp[viewer, $attr]];

u: Uniqueness = V2U[GetP[attribute, aUniquenessIs, aUniquenessOf]];

IF shift THEN {}

ELSE

IF u = Key OR u = OptionalKey THEN

{anyErrors← TRUE; NutViewer.Message[viewer, "Only one allowed!"]}

ELSE BEGIN

lastButton: NutButtons.NutButton;

r: Relation = NutOps.GetRelation[attribute];

--move all the tuples below target; create new buttons for the duplicate

-- attributes;

MoveTuples[target: viewer, justBelow: TRUE];

[lastButton] ← BuildTuplesButtons[

attribute: attribute, lastButton: viewer, skipRelButton: TRUE ];

ViewerOps.PaintViewer[viewer.parent, client];

END;

MoveTuples: PROC[ target: Viewer, numberOfRows: INT ← 1, parent: Viewer ← NIL,

justBelow: BOOL ← FALSE, abs: BOOL ← FALSE ] =

BEGIN

tempViewer: Viewer ← IF parent # NIL THEN parent.child ELSE target.parent.child;

shift: INT = IF abs THEN numberOfRows

ELSE numberOfRows*(VFonts.FontHeight[DefaultNutUtilities.valueFont]+yFudge);

search through entire sib list and move all that are to the right or

under the target

UNTIL tempViewer = NIL DO

IF justBelow THEN BEGIN

IF (tempViewer.wy-yFudge) > target.wy THEN

ViewerOps.MoveViewer[viewer: tempViewer, x: tempViewer.wx,

y: tempViewer.wy + shift, h: tempViewer.wh, w: tempViewer.ww, paint: FALSE];

END

ELSE IF (tempViewer.wx > target.wx AND tempViewer.wy >= target.wy)

OR (tempViewer.wy > target.wy AND tempViewer.wx >= target.wx)

THEN

ViewerOps.MoveViewer[viewer: tempViewer, x: tempViewer.wx,

y: tempViewer.wy + shift, h: tempViewer.wh, w: tempViewer.ww, paint: FALSE];

tempViewer ← tempViewer.sibling

ENDLOOP;

END;

MoveOver: PROC[ target: Viewer, shift: INT ← 1, mvTarget: BOOL ← FALSE ] =

BEGIN

tempViewer: Viewer ← NARROW[ViewerOps.FetchProp[target, $Next]];

IF mvTarget THEN ViewerOps.MoveViewer[viewer: target, y: target.wy,

x: target.wx + shift, h: target.wh, w: target.ww, paint: FALSE];

UNTIL tempViewer = NIL DO

oldNew: Viewer ← NARROW[ViewerOps.FetchProp[tempViewer, $OldNew]];

type: Viewer ← NARROW[ViewerOps.FetchProp[tempViewer, $Type]];

ViewerOps.MoveViewer[viewer: tempViewer, y: tempViewer.wy,

x: tempViewer.wx + shift, h: tempViewer.wh, w: tempViewer.ww, paint: FALSE];

IF oldNew # NIL THEN

ViewerOps.MoveViewer[viewer: oldNew, y: oldNew.wy,

x: oldNew.wx + shift, h: oldNew.wh, w: oldNew.ww, paint: FALSE];

IF type # NIL THEN

ViewerOps.MoveViewer[viewer: type, y: type.wy,

x: type.wx + shift, h: type.wh, w: type.ww, paint: FALSE];

tempViewer ← NARROW[ViewerOps.FetchProp[tempViewer, $Next], Viewer];

ENDLOOP;

END;

TypeProc: Buttons.ButtonProc =

BEGIN

typeButton: Viewer ← NARROW[parent];

MoveOver[ target: NARROW[ViewerOps.FetchProp[typeButton, $attrViewer], Viewer],

shift: -typeButton.ww];

ViewerOps.DestroyViewer[typeButton];

END;

TypeLabel: PROC[ type: Entity ] RETURNS[ Rope.ROPE ] =

{ IF DB.Eq[type, DB.RopeType] THEN RETURN["(String)"]

ELSE IF DB.Eq[type, DB.IntType] THEN RETURN["(Int)"]

ELSE IF DB.Eq[type, DB.BoolType] THEN RETURN["(Bool)"]

ELSE IF DB.Eq[type, DB.TimeType] THEN RETURN["(Time)"]

ELSE RETURN[ Rope.Cat["(", GetName[type], ")"] ] };

CycleNewOld: Buttons.ButtonProc = TRUSTED

{ viewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ];

attrViewer: ViewerClasses.Viewer = NARROW[ ViewerOps.FetchProp[viewer, $attrViewer] ];

Labels: ARRAY[0..3) OF ROPE = ["", "N", "O"];

attr: Attribute = V2E[ ViewerOps.FetchProp[ attrViewer, $attr ] ];

which: REF INT = NARROW[ViewerOps.FetchProp[attrViewer, $which], REF INT];

IF NOT NutOps.EntityValued[attr] THEN RETURN;

which^ ← (which^ + 1) MOD 3;

Buttons.ReLabel[viewer, Labels[which^] ];

ViewerOps.AddProp[attrViewer, $which, which ];

};

MergeTuples: PUBLIC ENTRY PROC[viewer: Viewer, newEntity: Entity ← NIL ]

RETURNS [errors: BOOL] =

{ ENABLE UNWIND => NULL;

parent: Viewer = viewer.parent;

tempViewer: Viewer ← parent.child;

newRelship: Relship;

anyErrors← FALSE;

WHILE tempViewer # NIL DO

IF ViewerOps.FetchProp[tempViewer, $r ] # NIL THEN BEGIN

rel: Relation = V2E[ViewerOps.FetchProp[tempViewer, $r ] ];

attr: Attribute = V2E[ViewerOps.FetchProp[ tempViewer, $a ] ];

oldRelship← V2E[ViewerOps.FetchProp[tempViewer, $relShip ] ];

updateList← NIL;

allFieldsNull← TRUE;

newRelship← NIL;

AddAllFields[ relation: tempViewer];

IF updateList#NIL AND NOT allFieldsNull THEN BEGIN

updateList ← CONS[ AttributeValue[ attribute: attr, lo: newEntity], updateList ];

newRelship ← CreateRelship[rel];

UpdateTuple[newRelship, updateList];

ViewerOps.AddProp[ tempViewer, $relShip, newRelship ];

END;

tempViewer ← tempViewer.sibling

ENDLOOP;

RETURN[anyErrors]

};

SaveTuples: PUBLIC ENTRY PROC[viewer: Viewer, newEntity: Entity ← NIL ]

RETURNS [errors: BOOL] =

BEGIN

ENABLE UNWIND => NULL;

changedRs: ViewerList ← NARROW[ ViewerOps.FetchProp[viewer, $ChangedRels] ];

newRelship: Relship;

IF changedRs = NIL THEN RETURN[FALSE];

FOR changedR: Viewer ← changedRs.first, changedRs.first UNTIL changedR = NIL DO

oldRelship ← V2E[ ViewerOps.FetchProp[changedR, $relShip]];

allFieldsNull ← TRUE;

AddChangedFields[changedR];

IF NOT DB.Null[oldRelship] THEN

IF allFieldsNull THEN DB.DestroyRelship[oldRelship]

ELSE UpdateTuple[oldRelship, updateList]

ELSE IF NOT allFieldsNull THEN BEGIN

updateList ← CONS[ AttributeValue[

attribute: V2E[ViewerOps.FetchProp[changedR, $a]], lo: newEntity ],

updateList ];

newRelship ← CreateRelship[V2E[ViewerOps.FetchProp[changedR, $r]]];

UpdateTuple[ newRelship, updateList ];

ViewerOps.AddProp[ changedR, $relShip, newRelship ];

END;

changedRs ← changedRs.rest;

ENDLOOP;

RETURN[anyErrors];

END;

UpdateTuple: PROC[ t: Relship, updateList: AttributeValueList ] =

Changes the Relship t as specified by updateList. If ALL of the values in the update list

are NILs, then just destroy the whole Relship, 'cause user has left all blanks.

{

First set all of the key values

FOR ul: AttributeValueList ← updateList, ul.rest UNTIL ul = NIL DO

av: AttributeValue = ul.first;

u: Uniqueness = V2U[GetP[av.attribute, aUniquenessIs]];

IF u = Key THEN SetF[ t, av.attribute, av.lo ]

ENDLOOP;

Now set all of the non-key attributes

FOR ul: AttributeValueList ← updateList, ul.rest UNTIL ul = NIL DO

av: AttributeValue = ul.first;

u: Uniqueness = V2U[GetP[av.attribute, aUniquenessIs]];

IF u # Key THEN SetF[ t, av.attribute, av.lo ]

ENDLOOP };

PropertyValueList: TYPE = LIST OF PropertyValue;

PropertyValue: TYPE = RECORD[

from: Attribute, -- entity-valued attribute of a relation

avl: AttributeValueList -- value contraints on other attributes of same relation

];

QueryTuples: PUBLIC ENTRY PROC[ viewer: Viewer ]

RETURNS [el: LIST OF Entity] =

Given a table set up by DisplayTuples, finds all the entities in the given domain

that satisfy the query filled into the table by the user. Inner loop similar to SaveTuples,

but must create PropertyValueList instead of updating tuples.

{ ENABLE UNWIND => NULL;

queryList: PropertyValueList← NIL;

changedRs: ViewerList ← NARROW[ ViewerOps.FetchProp[viewer, $ChangedRels] ];

IF changedRs = NIL THEN RETURN[NIL];

WHILE changedRs # NIL DO

allFieldsNull ← TRUE;

updateList← NIL;

AddChangedFields[changedRs.first];

IF updateList#NIL AND NOT allFieldsNull THEN

Continue only if user modified and put something in this tuple..

queryList← CONS[ [from: V2E[ViewerOps.FetchProp[changedRs.first, $attr]], avl: updateList], queryList ];

changedRs ← changedRs.rest;

ENDLOOP;

RETURN[EntityQuery[queryList]];

};

EntityQuery: PROC[pvl: PropertyValueList] RETURNS[LIST OF Entity] =

A handy procedure for finding all the entities of a domain that have the given

property values. Finds all the entities which, for each PropertyValue in the

PropertyValueList list, there exists at least one relationship whose

"from" attribute equals the entity and whose other attributes satisfy the

attribute value list.

{ f: Attribute← pvl.first.from;

r: Relation← V2E[GetP[f, aRelationIs]];

elNew: LIST OF Entity← NIL;

nestedRS: RelshipSet← RelationSubset[r, pvl.first.avl];

FOR t: Relship← NextRelship[nestedRS], NextRelship[nestedRS] UNTIL t=NIL DO

elNew← CONS[V2E[GetF[t, f]], elNew] ENDLOOP;

ReleaseRelshipSet[nestedRS];

RETURN[NestedEntityQuery[elNew, pvl.rest]]

};

NestedEntityQuery: PROC[elOld: LIST OF Entity, pvl: PropertyValueList]

RETURNS[LIST OF Entity] =

Finds the entities in elOld that satisfy pvl. We do this recursively as follows.

For each entity in elOld, we do a RelationSubset to find the tuples that satisfy pvl.first

and also reference the entity. If this list is not empty, we can keep that entity in a

new list elNew; otherwise we toss it. When all the entities in elOld that also

satisfy pvl.first have been added to elNew in this way, we recursively call

NestedEntityQuery, returning the entities in elNew which also satisfy pvl.rest.

{ IF pvl=NIL THEN RETURN[elOld] ELSE

{ f: Attribute← pvl.first.from;

r: Relation← V2E[GetP[f, aRelationIs]];

elNew, elEnd: LIST OF Entity← NIL; -- will equal those in elOld that satisfy pvl.first

FOR elOldT: LIST OF Entity← elOld, elOldT.rest UNTIL elOldT=NIL DO

nestedRS: RelshipSet← RelationSubset[r, CONS[ [f, elOldT.first], pvl.first.avl]];

The nestedRS contains tuples that reference e and also satisfy first element of pvl.

We can keep elOldT.first in the elNew list iff this list is non-empty.

IF NextRelship[nestedRS] #NIL THEN

IF elNew=NIL THEN elEnd← elNew← CONS[elOldT.first, NIL]

ELSE elEnd← elEnd.rest← CONS[elOldT.first, NIL];

ReleaseRelshipSet[nestedRS];

ENDLOOP;

RETURN[NestedEntityQuery[elNew, pvl.rest]];

}};

AddChangedFields: PROC[relation: Viewer] =

BEGIN

attrViewerList: ViewerList ← NARROW[ViewerOps.FetchProp[relation, $Changes]];

FOR attrList: ViewerList ← attrViewerList, attrList.rest

UNTIL attrList = NIL DO

AddFields[attrList.first];

ENDLOOP;

END;

AddAllFields: PROC[relation: Viewer] =

BEGIN

attrViewer: Viewer ← NARROW[ViewerOps.FetchProp[relation, $Next]];

WHILE attrViewer # NIL DO

AddFields[attrViewer];

attrViewer ← NARROW[ViewerOps.FetchProp[attrViewer, $Next]];

ENDLOOP;

END;

AddFields: PROC[attrViewer: Viewer] =

NOTE THIS PROCEDURE UPDATES GLOBAL VARIABLES AS A SIDE EFFECT.

THE MONITOR ON THIS MODULE IS TO PROTECT THESE GLOBAL VARIABLES.

Adds to updateList the attributes in row that need to be assigned in order to create

the relationship. Caller must add the first attribute (that refs the entity),

if desired. If the user does not modify a field, it does not appear in the updateList

unless there was an existing relationship and we are in "copy" mode.

Thus updateList=NIL if the user modified no fields of a tuple. Sets allFieldsNull to

FALSE if any of the fields are non-null.

BEGIN

parent: Viewer = attrViewer.parent;

attr: Attribute = V2E[ViewerOps.FetchProp[attrViewer, $attr]];

newOld: INT = IF NutOps.EntityValued[attr] THEN

NARROW[ViewerOps.FetchProp[attrViewer, $which], REF INT]^

ELSE 0; --only needs the value if its an entity

contents: ROPE = NARROW[ ViewerOps.FetchProp[attrViewer, $Value] ];

type: Entity = V2E[GetP[attr, aTypeIs, aTypeOf]];

value: DB.Value;

IF NOT Rope.Equal[contents, ""] THEN allFieldsNull← FALSE;

SELECT type FROM

IntType => {

val: INT = IF Rope.Equal[contents, ""] THEN 0 ELSE IO.GetInt[ IO.RIS[contents] ];

value ← I2V[val]};

RopeType =>

value ← S2V[ contents ];

BoolType =>

value ← B2V[ Rope.Equal[contents, "TRUE"] ];

TimeType =>

{ time: DB.GMT;

time.time ← IO.GetTime[IO.RIS[contents] ! IO.Error => TRUSTED {

anyErrors← TRUE;

NutViewer.Error[parent, "Unintelligible time/date: ", contents]}];

value ← T2V[time] };

ENDCASE =>

IF Rope.Equal[contents, ""] THEN value← NIL

ELSE SELECT newOld FROM

0 => -- NewOrOld

{ value ← DeclareEntity[ d: type, name: contents, version: OldOnly ];

IF value = NIL THEN {

NutViewer.Message[parent, "Automatically creating ", contents];

value ← DeclareEntity[ d: type, name: contents ];

IF value = NIL THEN {

allFieldsNull← TRUE; -- pretend this tuple didn't happen

anyErrors← TRUE;

NutViewer.Error[parent, " Error: ", contents, " could not be created automatically."]; } } };

1 => -- NewOnly

{ value ← CreateEntity[ d: type, name: contents !

DBEnvironment.Error => TRUSTED {

codeRef: REF DBEnvironment.ErrorCode ~ NEW[DBEnvironment.ErrorCode ← code];

NutViewer.Error[parent, IO.PutFR["%g", IO.refAny[codeRef]], " Error trying to create \"", contents, "\" entity."];

allFieldsNull← TRUE; -- pretend this tuple didn't happen

anyErrors← TRUE;

CONTINUE}]};

2 => -- OldOnly

{ value ← DeclareEntity[ type, contents, Version[OldOnly] ];

IF value = NIL THEN {

allFieldsNull← TRUE; -- pretend this tuple didn't happen

anyErrors← TRUE;

NutViewer.Error[parent, " Error: ", contents, " does not exist."] }};

ENDCASE;

updateList ← CONS[ AttributeValue[attribute: attr, lo: value], updateList ];

END;

ResetTuples: PUBLIC ENTRY PROC[viewer: Viewer] =

BEGIN

ViewerOps.AddProp[viewer, $ChangedRels, NIL];

viewer.newVersion ← FALSE;

END;

attrValueMenu: Menus.Menu ← Menus.CreateMenu[1];

ValueGrow doubles the length of a textViewer and adjusts the screen

accordingly

ValueGrow: Buttons.ButtonProc =

BEGIN

edViewer: ViewerClasses.Viewer ← (NARROW[parent, Viewer]).parent;

textViewer: ViewerClasses.Viewer ←

NARROW[ ViewerOps.FetchProp[edViewer, $TextViewer]];

shiftHeight: INT ← 2*textViewer.wh;

shiftWidth: INT ← textViewer.ww/2;

edViewer.wh ← edViewer.wh+shiftHeight;

textViewer.wh ← textViewer.wh+shiftHeight;

IF (edViewer.ww + shiftWidth+ edViewer.wx) < edViewer.parent.ww THEN BEGIN

edViewer.ww ← edViewer.ww + shiftWidth;

textViewer.ww ← textViewer.ww + shiftWidth;

END;

MoveTuples[ target: edViewer,

numberOfRows: shiftHeight, abs: TRUE, justBelow: TRUE];

ViewerOps.EstablishViewerPosition[viewer: edViewer, x: edViewer.wx,

y: edViewer.wy, h: edViewer.wh, w: edViewer.ww];

ViewerOps.EstablishViewerPosition[viewer: textViewer, x: textViewer.wx,

y: textViewer.wy, h: textViewer.wh, w: textViewer.ww];

ViewerOps.PaintViewer[edViewer.parent, all];

END;

ValueReset resets the contents of an editor window to be that

of the original value in the attr:value button

ValueReset: Buttons.ButtonProc =

BEGIN

edViewer: ViewerClasses.Viewer ← (NARROW[parent, Viewer]).parent;

textViewer: ViewerClasses.Viewer ← NARROW[ ViewerOps.FetchProp[edViewer, $TextViewer]];

oldValue: Rope.ROPE ← NARROW[ViewerOps.FetchProp[textViewer, $Value]];

ViewerTools.SetContents[ textViewer, oldValue ];

ViewerOps.PaintViewer[edViewer.parent, all];

END;

ValueDone gets the contents of the text in the associated textViewer

and updates the attr:value button with the contents of the textViewer

as the new value. The editor window is then destroyed.

ValueDone: Buttons.ButtonProc =

BEGIN

edViewer: ViewerClasses.Viewer ← (NARROW[parent, Viewer]).parent;

textViewer: ViewerClasses.Viewer ← NARROW[

ViewerOps.FetchProp[edViewer, $TextViewer] ];

newValue: Rope.ROPE ← ViewerTools.GetContents[textViewer];

attrViewer: ViewerClasses.Viewer ← NARROW[ ViewerOps.FetchProp[edViewer, $Button]];

newWidth: INT = DefaultNutUtilities.AttrButtonLength[attrViewer.name, newValue, mouseButton];

MoveTuples[target: attrViewer, numberOfRows: -edViewer.wh,

parent: attrViewer.parent, abs: TRUE, justBelow: TRUE];

IF newValue # ViewerOps.FetchProp[textViewer, $Value] THEN BEGIN

oldWidth: INT ← attrViewer.ww;

relButton: Viewer = NARROW[ ViewerOps.FetchProp[attrViewer, $Relation]];

pastChanges: ViewerList ← NARROW[ ViewerOps.FetchProp[relButton, $Changes]];

attrViewer.name ← Rope.Cat[PreColon[attrViewer.name], Rope.Cat[" ", newValue]];

ViewerOps.EstablishViewerPosition[viewer: attrViewer, x: attrViewer.wx,

y: attrViewer.wy, h: attrViewer.wh, w: newWidth];

MoveOver[ target: attrViewer, shift: attrViewer.ww-oldWidth];

ViewerOps.AddProp[attrViewer, $Value, newValue];

ViewerOps.SetNewVersion[attrViewer.parent];

IF pastChanges = NIL THEN BEGIN

relList: ViewerList ← NARROW[ ViewerOps.FetchProp[relButton.parent, $ChangedRels]];

relList ← CONS[relButton, relList];

ViewerOps.AddProp[relButton.parent, $ChangedRels, relList];

END;

pastChanges ← CONS[attrViewer, pastChanges];

ViewerOps.AddProp[ relButton, $Changes, pastChanges ];

IF Menus.FindEntry[attrViewer.parent.menu, "Reset"] # NIL THEN --editor viewer

Menus.SetGuarded[ Menus.FindEntry[attrViewer.parent.menu, "Reset"], TRUE ]

ELSE --queryer viewer

Menus.SetGuarded[ Menus.FindEntry[attrViewer.parent.menu, "Clear"], TRUE ];

END

ELSE IF newWidth # attrViewer.ww THEN --user bluebuttoned so viewer should grow

ViewerOps.EstablishViewerPosition[viewer: attrViewer, x: attrViewer.wx,

y: attrViewer.wy, h: attrViewer.wh, w: newWidth];

ViewerOps.DestroyViewer[edViewer];

END;

PreColon: PROC[label: ROPE] RETURNS[ROPE] =

BEGIN

colonPos: INT ← Rope.Find[s1: label, s2: ":"];

IF colonPos = -1 THEN --Not a label

RETURN[label]

ELSE RETURN[ Rope.Substr[base: label, len: colonPos+1] ];

END;

Change Log:

Edited on March 21, 1984 9:17:51 pm PST, by Beach

added Cedar formatting via TiogaMesa.

changes to: AddFields to detect errors more often when creating entities automatically.

Edited on March 28, 1984 9:25:52 pm PST, by Beach

cosmetic changes to the {} conventions and indentation.

changes to: RelProc to preserve the newVersion status when expanding a relation row with the blue button.

Edited on August 9, 1984 11:24:10 am PDT, by Butler

changes to: DisplayTuples, BuildTuplesButtons, RelProc, AddFields, ValueDone, MakeAttrValueViewer, RelProc, DIRECTORY, BuildTuplesButtons, ValueDone, ValueDone, DoTuples, SaveTuples, NestedEntityQuery, AddNewFields, AddFields, ValueDone, AddNewFields, ResetTuples, SaveTuples, MakeAttrValueViewer, DIRECTORY, AttrProc, DoTuples, SaveTuples, SaveTuples, ResetTuples, MergeTuples, SaveTuples, AddChangedFields, AddAllFields, AddFields, QueryTuples, QueryTuples, ValueDone, QueryTuples, ValueDone, QueryTuples, QueryTuples, AttrButtonLength