File: NutDefaultImpl.mesa
Contents: Implementation of the Default Create, Display, Edit, and Query windows.
Last edited by:
Willie-Sue on: January 21, 1983 8:57 am
Cattell on: January 13, 1984 6:12 pm: removed Finch stuff
Donahue on: July 13, 1984 12:06:20 pm PDT
Butler on: June 27, 1984 4:08:39 pm PDT
Table of contents [use find command to locate]:
Default Editor ***
Default Displayer ***
Default Queryer ***
DIRECTORY
Atom USING [GetPropFromList],
Buttons,
Containers,
DB,
DBIcons USING [GetIcon],
DBNames USING[MakeName, NameToEntity],
EntityEditor,
Icons USING [IconFlavor, NewIconFromFile],
IO,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
NoteEditor,
Nut,
NutOps,
NutViewer,
Rope,
SafeStorage USING [NarrowRefFault],
TiogaOps USING [InsertRope],
TuplesEditor,
TypeScript,
ViewerIO,
ViewerLocks,
ViewerOps,
ViewerClasses,
ViewerTools,
VTables;
NutDefaultImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, DBIcons, DBNames, IO, Nut, NutOps, NutViewer, EntityEditor, Icons, Menus, NoteEditor, Rope, SafeStorage, TiogaOps, TuplesEditor, TypeScript, ViewerIO, ViewerOps, ViewerTools, VTables
SHARES ViewerLocks =
BEGIN OPEN DB, NutViewer, ViewerClasses, VTables;
Viewer: TYPE = ViewerClasses.Viewer;
Default Editor ************************************************************
editorMenu: Menus.Menu ← Menus.CreateMenu[];
this procedure will return either the entity or the entity name for the viewer if the
segment in which the entity would live is not currently open
ConvertViewerToEntity: PROC[v: Viewer, create: BOOL ← FALSE] RETURNS[e: Entity, name: ROPE] =
BEGIN
eName, domain: ROPE;
segment: DB.Segment;
[segment, domain, eName] ← Nut.GetNutInfo[v];
IF segment = NIL THEN RETURN;
name ← DBNames.MakeName[segment, domain, eName];
e ← DBNames.NameToEntity[name, create]
END;
FreezeProc: Menus.MenuProc = { [] ← Nut.SetFrozenProperty[NARROW[parent], TRUE] };
ResetProc: Menus.MenuProc =
BEGIN
Resets contents of editor to its state before edits started.
viewer: Viewer = NARROW[parent];
seg: Segment;
domain: ROPE;
eName: ROPE;
[seg, domain, eName] ← Nut.GetNutInfo[viewer];
[] ← DefaultEdit[eName: eName, domain: domain, segment: seg, lastSpawned: viewer];
END;
SaveProc: Menus.MenuProc =
BEGIN
Invoked when hit the "Save" button on an editor: makes edits and then turns into displayer.
viewer: Viewer = NARROW[parent];
newV: Viewer;
seg: Segment;
d: Domain;
dName: ROPE;
eName: ROPE;
e: Entity;
[seg, dName, eName]← Nut.GetNutInfo[viewer];
d ← DB.DeclareDomain[dName, seg];
e ← DB.DeclareEntity[d, eName, NewOrOld ];
TRUSTED BEGIN
table: VTable = viewer.child;
tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ];
entityRow: VTable = GetTableEntry[ table: table, row: 2 ];
noteRow: VTable = GetTableEntry[ table: table, row: 3 ];
errors: BOOL← TuplesEditor.SaveTuples[viewer: tuplesRow, newEntity: e].errors;
EntityEditor.SaveEntities[viewer: entityRow, newOf: e];
NoteEditor.SaveNote[newEntity: e, viewer: noteRow, update: TRUE];
Replace editor with displayer iff there were no error messages
IF errors THEN
NutViewer.Message[viewer, "You may correct any errors and save again."]
ELSE BEGIN
newV ← NutViewer.ReplaceViewer[eName: eName, domain: dName, seg: seg, parent: viewer];
[] ← DefaultDisplay[eName: eName, domain: dName, segment: seg, lastSpawned: newV];
END;
END;
END;
MergeProc: Menus.MenuProc =
BEGIN
Invoked when hit the "Merge" button. Is supposed to copy all of the relationships connected
with this entity to the entity in the same domain with the selected name, then delete the
existing entity if any.
viewer: Viewer = NARROW[parent];
seg: Segment;
d: Domain;
dName: ROPE;
eName: ROPE;
e: Entity;
otherEntity: Entity;
otherName: ROPE = ViewerTools.GetSelectionContents[];
[seg, dName, eName] ← Nut.GetNutInfo[viewer];
d ← DB.DeclareDomain[dName, seg];
otherEntity ← IF otherName=NIL THEN NIL ELSE DB.FetchEntity[d, otherName, seg];
e← DB.FetchEntity[d, eName, seg ! DB.Error => { e ← NIL; CONTINUE } ];
IF e = NIL THEN
Message[viewer, "This entity does not exist yet!"]
ELSE IF otherName=NIL THEN
Message[viewer, "Please select name for entity to merge with!"]
ELSE IF otherEntity=NIL THEN
Message[viewer, "Selected entity not found in this domain!"]
ELSE TRUSTED BEGIN
table: VTable = viewer.child;
newV: Viewer;
tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ];
entityRow: VTable = GetTableEntry[ table: table, row: 2 ];
noteRow: VTable = GetTableEntry[ table: table, row: 3 ];
NutViewer.Message[
viewer, "Copying ", eName, " to ", Rope.Concat[otherName, ", and deleting it..."]];
[]← TuplesEditor.SaveTuples[viewer: tuplesRow, newEntity: otherEntity];
EntityEditor.SaveEntities[viewer: entityRow, newOf: otherEntity];
NoteEditor.SaveNote[newEntity: otherEntity, viewer: noteRow, update: TRUE];
DB.DestroyEntity[e]; -- Get rid of old entity, its relationships have been moved
newV ← NutViewer.ReplaceViewer[eName: eName, domain: dName, seg: seg, parent: viewer];
[] ← DefaultDisplay[eName: eName, domain: dName, segment: seg, lastSpawned: newV];
END;
END;
RenameProc: Menus.MenuProc = {
ENABLE DB.Error => IF code=NonUniqueEntityName THEN
{NutViewer.Message[NARROW[parent], "Entity already exists with that name!"]; CONTINUE};
viewer: Viewer = NARROW[parent];
seg: Segment;
d: Domain;
dName: ROPE;
eName: ROPE;
e: Entity;
newName: ROPE = ViewerTools.GetSelectionContents[];
[seg, dName, eName]← Nut.GetNutInfo[viewer];
d ← DB.DeclareDomain[dName, seg];
e← DB.FetchEntity[d, eName, seg ];
IF e = NIL THEN
Message[viewer, "Entity does not exist yet!"]
ELSE IF newName=NIL THEN
Message[viewer, "Please select new name for entity first!"]
ELSE {
DB.ChangeName[e, newName];
ViewerOps.AddProp[viewer, $EntityName, newName];
viewer.name← Rope.Cat[NutOps.SafeNameOf[d],": ", newName];
ViewerOps.PaintViewer[viewer, caption] };
};
EraseAllProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
seg: Segment;
d: Domain;
dName: ROPE;
eName: ROPE;
e: Entity;
[seg, dName, eName]← Nut.GetNutInfo[viewer];
d ← DB. DeclareDomain[dName, seg];
e← DB.FetchEntity[d, eName, seg ! DB.Error => { e ← NIL; CONTINUE } ];
IF e = NIL THEN RETURN;
DB.DestroyEntity[e];
ViewerOps.DestroyViewer[viewer];
};
AddProc: Menus.MenuProc = TRUSTED {
viewer: Viewer = NARROW[parent];
entityRow: VTable = GetTableEntry[ table: viewer.child, row: 2 ];
selected: Viewer = ViewerTools.GetSelectedViewer[];
entity: Entity;
IF selected=NIL THEN
{NutViewer.Error[viewer, "No viewer selected!"]; RETURN};
entity← ConvertViewerToEntity[ParentOf[selected]].e;
EntityEditor.NewEntry[ entity, entityRow ];
Install[ viewer.child, TRUE ] };
--------------------------
ParentOf: PROC[ v: Viewer ] RETURNS[ parent: Viewer ] = {
parent ← v;
WHILE parent.parent # NIL DO parent ← parent.parent ENDLOOP };
DefaultEdit: PUBLIC Nut.NutProc =
TRUSTED BEGIN
tsOut: IO.STREAM;
d: Domain = DB.DeclareDomain[domain, segment];
al: LIST OF Attribute = NutOps.GetRefAttributes[d];
need to xreate a viewer
table: VTables.VTable;
tsV: Viewer;
e: DB.Entity;
newV: ViewerClasses.Viewer = NutViewer.CreateDefaultViewer[replace: lastSpawned, domain: domain, eName: eName, segment: segment];
table ← VTables.Create[ parent: newV, rows: 4 ];
tsV ← TypeScript.Create[info: [parent: table, ww: newV.cw, wh: 32], paint: FALSE];
e ← DeclareEntity[d, eName, OldOnly];
ViewerOps.SetMenu[newV, editorMenu];
VTables.SetTableEntry[ table: table, row: 0, flavor: $Viewer,
clientData: tsV, border: [FALSE, TRUE, FALSE, FALSE] ];
VTables.SetTableEntry[ table: table, row: 1, flavor: $Viewer,
clientData: TuplesEditor.DisplayTuples[e: e, attrList: al, parent: table],
border: NullBorder ];
VTables.SetTableEntry[ table: table, row: 2, flavor: $Viewer,
clientData: EntityEditor.DisplayEntities[of: e, parent: table, in: segment],
border: NullBorder ];
VTables.SetTableEntry[ table: table, row: 3, flavor: $Viewer,
clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: segment],
border: NullBorder ];
tsOut← ViewerIO.CreateViewerStreams[NIL, tsV].out;
ViewerOps.AddProp[ newV, $Typescript, tsOut ];
VTables.Install[ table, FALSE ];
ViewerOps.PaintViewer[newV, all];
RETURN[newV]
END;
Default Displayer ************************************************************
displayerMenu: Menus.Menu ← Menus.CreateMenu[];
DefaultDisplay: PUBLIC Nut.NutProc =
TRUSTED BEGIN
table: VTables.VTable;
lastViewer: Viewer;
endOfTupleSubwindow: INTEGER;
d: DB.Domain = DB.DeclareDomain[domain, segment];
e: DB.Entity ← DB.FetchEntity[d, eName, segment];
newV: ViewerClasses.Viewer = NutViewer.CreateDefaultViewer[replace: lastSpawned, domain: domain, eName: eName, segment: segment];
ViewerOps.SetMenu[newV, displayerMenu];
lastViewer← BuildTupleWindowButtons[e, segment, newV];
IF lastViewer=NIL THEN -- Empty tuple subwindow, start immediately with related entities
endOfTupleSubwindow← 0
ELSE -- Create another zero-size button on next line just to get right y position to start at ...
endOfTupleSubwindow← NutViewer.MakeButton[
q: NutViewer.DBQueue[], name: NIL, proc: NIL,
sib: lastViewer, width: 0, newLine: TRUE].wy;
table← VTables.Create[ parent: newV, rows: 2, y: endOfTupleSubwindow];
VTables.SetTableEntry[
table: table, row: 0, flavor: $Viewer,
clientData: EntityEditor.DisplayEntities[of: e, parent: table, in: segment, noEdits: TRUE],
border: NullBorder ];
VTables.SetTableEntry[
table: table, row: 1, flavor: $Viewer,
clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: segment, noEdits: TRUE],
border: NullBorder ];
VTables.Install[ table, FALSE ];
ViewerOps.PaintViewer[newV, all];
RETURN[newV]
END;
BuildTupleWindowButtons: PROC[e: Entity, seg: Segment, v: Viewer] RETURNS [Viewer] =
BEGIN
alT: AttributeList;
t: Relship;
myRel: Relation;
tuples: RelshipSet;
lastButton: Viewer;
myAttrs: AttributeList;
myAttrs← RemoveSpecialAttributesFrom[DB.GetAllRefAttributes[e], seg];
lastButton← NutViewer.Initialize[v];
FOR alT← myAttrs, alT.rest UNTIL alT=NIL DO
IF Null[alT.first] THEN LOOP;
myRel← V2E[GetP[alT.first, aRelationIs]];
tuples← RelationSubset[myRel, LIST[[alT.first, e]]];
IF NutOps.RSetSize[RelationSubset[myRel, LIST[[alT.first, e]]]]#9999 THEN
UNTIL Null[t← NextRelship[tuples]] DO
lastButton ← BuildTuplesButtons[v, alT.first, myRel, t, lastButton];
ENDLOOP
ELSE
BuildMultiTupleButtons[v, alT.first, myRel, tuples];
ReleaseRelshipSet[tuples];
ENDLOOP;
RETURN[lastButton]
END;
BuildMultiTupleButtons: PROC[viewer: Viewer, a: Attribute, r: Relation, ts: RelshipSet] =
Overflow not yet implemented...
{Message[viewer, "Too many ", GetName[r], "s to display"]};
BuildTuplesButtons: PROC[
v: Viewer, a: Attribute, r: Relation, t: Relship, lastButton: Viewer] RETURNS[Viewer] =
Creates one line of buttons on the screen, for one database tuple
BEGIN aValue: ROPE;
al: AttributeList← NutOps.RemoveAttribute[a, DB.VL2EL[DB.GetPList[r, aRelationOf]]];
lastButton← MakeButton[
q: DBQueue[], name: GetName[r], proc: ProcessSelection,
data: r, sib: lastButton, newLine: TRUE];
FOR alT: AttributeList← al, alT.rest UNTIL alT=NIL DO
aValue← GetFS[t, alT.first];
IF aValue.Length[]>0 THEN -- only print if non-null value
lastButton← MakeButton[
q: DBQueue[], name: Rope.Cat[GetName[alT.first], ": ", aValue], proc: ProcessSelection,
sib: lastButton, data: GetF[t, alT.first] ];
ENDLOOP;
RETURN[lastButton];
END;
RemoveSpecialAttributesFrom: PROC [
old: LIST OF Attribute, seg: Segment] RETURNS[new: LIST OF Attribute] = {
Removes the "*" and "note" attributes that will be displayed in the later sections
ENABLE DB.Error => {IF code=NotFound THEN {new← old; CONTINUE}};
star: Relation = DeclareRelation["*", seg, OldOnly];
starOf: Attribute = DeclareAttribute[r: star, name: "of", version: OldOnly];
starIs: Attribute = DeclareAttribute[r: star, name: "is", version: OldOnly];
note: Relation = DeclareRelation["note", seg, OldOnly];
noteOf: Attribute = DeclareAttribute[r: note, name: "of", version: OldOnly];
new← old;
IF star # NIL THEN
{new← NutOps.RemoveAttribute[starOf, new]; new← NutOps.RemoveAttribute[starIs, new]};
IF note # NIL THEN new ← NutOps.RemoveAttribute[noteOf, new];
RETURN[new]
};
EditProc: Menus.MenuProc =
BEGIN
Invoked when hit the "Edit" button on the default displayer.
Should replace the displayer viewer with an editor viewer.
viewer: Viewer = NARROW[parent];
seg: DB.Segment;
dName: ROPE;
eName: ROPE;
[seg, dName, eName]← Nut.GetNutInfo[viewer];
[] ← DefaultEdit[ eName: eName, domain: dName, segment: seg, lastSpawned: viewer];
END;
PasteNameProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
eName: ROPE← Nut.GetNutInfo[viewer].entity;
TiogaOps.InsertRope[eName];
};
Default Queryer ************************************************************
queryerMenu: Menus.Menu ← Menus.CreateMenu[];
queryerIcon: Icons.IconFlavor← Icons.NewIconFromFile["[Indigo]<Squirrel>Icons>Nut.Icons", 11];
qNumber: INT← 0;
entryHeight: INTEGER = 14;
NextQNumber: PROC RETURNS[INT] = { RETURN[qNumber← qNumber + 1] };
DefaultQuery: PUBLIC Nut.NutProc =
BEGIN
table: VTables.VTable;
al: AttributeList;
tsOut: IO.STREAM;
tsV: Viewer;
d: DB.Domain = DB.DeclareDomain[domain, segment];
e: Entity ← FetchEntity[d, eName, segment];
newV: ViewerClasses.Viewer;
IF DB.IsSystemEntity[d] THEN
{Message[newV, "Query not allowed on system domains!"]; RETURN[NIL]};
newV ← NutViewer.CreateDefaultViewer[replace: lastSpawned, domain: domain, eName: eName, segment: segment];
ViewerOps.SetMenu[newV, queryerMenu];
newV.icon← queryerIcon;
al← DB.GetDomainRefAttributes[d];
table← VTables.Create[ parent: newV, rows: 2 ];
tsV← TypeScript.Create[info: [parent: table, ww: newV.cw, wh: 32], paint: FALSE];
VTables.SetTableEntry[
table: table, row: 0, flavor: $Viewer,
clientData: tsV, border: [FALSE, TRUE, FALSE, FALSE] ];
VTables.SetTableEntry[
table: table, row: 1, flavor: $Viewer,
clientData: TuplesEditor.DisplayTuples[e: NIL, attrList: al, parent: table], border: NullBorder ];
tsOut← ViewerIO.CreateViewerStreams[NIL, tsV].out;
VTables.Install[ table, FALSE ];
ViewerOps.AddProp[ newV, $Typescript, tsOut ];
ViewerOps.PaintViewer[newV, all];
RETURN[newV]
END;
QueryProc: Menus.MenuProc =
BEGIN
Invoked when hit the "Query" button on an editor: makes new displayer for
entities satisfying the query, if there are any.
viewer: Viewer = NARROW[parent];
seg: Segment← NARROW[ViewerOps.FetchProp[viewer, $Segment] ];
dName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $DomainName] ];
d: Domain = DeclareDomain[dName, seg];
number: INT = NextQNumber[];
table: VTable = viewer.child;
tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ];
answer: LIST OF Entity← TuplesEditor.QueryTuples[viewer: tuplesRow, domain: d];
IF answer=NIL THEN
Message[viewer, "No entities satisfied query!"]
ELSE IF answer.rest=NIL THEN BEGIN
Message[viewer, "One entity satisfied query; displaying it..."];
[] ← Nut.Display[eName: DB.NameOf[answer.first], domain: dName, segment: seg, parent: viewer];
END
ELSE BEGIN
Message[ viewer, "Entities satisfying query displayed in Answer viewer..."];
MultiDisplay[
entities: answer,
title: IO.PutFR["Answer to %g query #%g", IO.rope[dName], IO.int[number]],
icon: DBIcons.GetIcon[iconName: dName, default: queryerIcon] ];
END;
END;
MultiDisplay: PROC[entities: LIST OF Entity, title: ROPE, icon: Icons.IconFlavor] =
BEGIN v, lastButton: Viewer;
v← ViewerOps.CreateViewer[
flavor: $Container, info: [name: title, iconic: FALSE, icon: icon], paint: FALSE];
lastButton← NutViewer.Initialize[v];
FOR elT: LIST OF Entity← entities, elT.rest UNTIL elT=NIL DO
e: Entity= elT.first;
lastButton ← NutViewer.MakeButton[
q: DBQueue[], name: GetName[e], proc: ProcessSelection,
data: e, sib: lastButton, newLine: TRUE];
ENDLOOP;
ViewerOps.PaintViewer[v, all]
END;
ProcessSelection: Menus.MenuProc =
Processes a button press on a displayer button. If the shift key is held down, we
stuff the contents of the button as text at the input point; else we display the entity.
BEGIN
viewer: ViewerClasses.Viewer ← NARROW[parent];
IF shift THEN
Insert the part of the string after the attribute name and ":" (entity name or other string)
TiogaOps.InsertRope[Rope.Substr[viewer.name, Rope.Find[viewer.name, ":"]+2]]
ELSE BEGIN
e: Entity← V2E[clientData ! SafeStorage.NarrowRefFault => GO TO NotEntity];
Find the top level viewer to pass off to the display proc
FOR viewer ← viewer, viewer.parent UNTIL viewer.parent=NIL DO ENDLOOP;
[] ← Nut.Display[eName: DB.NameOf[e], domain: DB.NameOf[DB.DomainOf[e]], segment: Nut.GetNutInfo[viewer].segment, parent: viewer];
EXITS
NotEntity => NutViewer.Message[viewer, "Not an entity-valued field!"];
END;
END;
Start Code ************************************************************
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Edit", EditProc]];
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Freeze", FreezeProc]];
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Paste", PasteNameProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Freeze", FreezeProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Paste", PasteNameProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Reset", ResetProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Save", SaveProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Rename", RenameProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Merge", MergeProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "EraseAll", EraseAllProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "AddSelected", AddProc]];
Menus.AppendMenuEntry[
queryerMenu, MakeMenuEntry[DBQueue[], "Query", QueryProc]];
Nut.Register[ NIL, NIL, DefaultDisplay, DefaultEdit, DefaultQuery ];
END.
Change log [since copied some of this code into Walnut]:
Cattell March 18, 1982 1:48 pm: Palm updates
Cattell April 6, 1983 11:17 am: re-insert default displayer from old NutViewerDefaultImpl: Jim's editor is now default editor, old displayer is default displayer. No default queryer yet. Use VTables for the BuildTupleWindowButtons.
Cattell April 7, 1983 11:58 am: various fixes everywhere.
Cattell April 15, 1983 11:41 am: added Rename, Merge, EraseAll, etc. Not all checked yet. Changed "Remove" to EraseAll, as it erases all rather than what a user might think it does, i.e. removing one of the related entities.
Cattell May 30, 1983 4:15 pm: added message subwindow to editor, fixed up icon for queryer, fixed some error conditions in editor, etc.
Cattell June 22, 1983 3:49 pm: bug in RemoveSpecialAttributesFrom
Cattell July 5, 1983 5:17 pm: fixed NutImpl and all procs to uniformly use a $NutType, $DomainName, $EntityName, and $Segment prop associated with all nut viewers.
Butler June 26, 1984:
Minor changes due to reorganization of Nut. Defaults now register with
Nut instead of Nut knowing about them.