-- 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: June 8, 1983 10:08 am
-- Donahue on: May 12, 1983 9:48 am

-- Table of contents [use find command to locate]:
-- Default Editor ***
-- Default Displayer ***
-- Default Queryer ***


DIRECTORY
Atom USING [GetPropFromList, GetPName],
Buttons,
DB,
DBIcons USING [GetIcon],
EntityEditor,
Icons USING [IconFlavor, NewIconFromFile],
InputFocus USING [SetInputFocus],
IO,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
NoteEditor,
Nut,
NutOps,
NutViewer,
Rope,
SafeStorage USING [NarrowRefFault],
TuplesEditor,
TypeScript,
ViewerIO,
ViewerOps,
ViewerClasses,
ViewerTools,
VTables;


NutDefaultImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, DBIcons, IO, Nut, NutOps, NutViewer,
EntityEditor, Icons, InputFocus, Menus, NoteEditor, Rope, SafeStorage,
TuplesEditor, TypeScript, ViewerIO, ViewerOps, ViewerTools, VTables
EXPORTS Nut =

BEGIN OPEN DB, NutViewer, VTables;

Viewer: TYPE = ViewerClasses.Viewer;

-- Default Editor ************************************************************

editorMenu: Menus.Menu ← Menus.CreateMenu[];

ResetProc: Menus.MenuProc =
{viewer: Viewer = NARROW[parent];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
InputFocus.SetInputFocus[];  -- kill the caret
[] ← Nut.Edit[ d: d, eName: eName, parent: viewer, method: replace, seg: SegmentOf[d] ] };

SaveProc: Menus.MenuProc = {
-- Invoked when hit the "Save" button on an editor: makes edits and then => displayer.
-- note that there is currently no way to change the entity name, so it's always the same
-- entity as we started with
viewer: Viewer = NARROW[parent];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
e: Entity;
e ← DB.DeclareEntity[d: d, name: eName ! DB.Error => { e ← NIL; CONTINUE } ];
IF e = NIL THEN RETURN;
TRUSTED
{ 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 ];
TuplesEditor.SaveTuples[viewer: tuplesRow, newEntity: e];
EntityEditor.SaveEntities[viewer: entityRow, newOf: e];
NoteEditor.SaveNote[newEntity: e, viewer: noteRow, update: TRUE];
-- DB.MarkTransaction[trans: DB.TransactionOf[segment: SegmentOf[e]]];
[]← Nut.Display[e: e, parent: viewer, method: replace, seg: SegmentOf[e]] };
};

MergeProc: Menus.MenuProc = {
-- 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];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
e: Entity = DB.DeclareEntity[d: d, name: eName, version: OldOnly];
seg: Segment = IF e = NIL THEN NIL ELSE SegmentOf[e];
otherName: ROPE = ViewerTools.GetSelectionContents[];
otherEntity: Entity =
IF otherName=NIL THEN NIL
ELSE DB.DeclareEntity[d: d, name: otherName, version: OldOnly];
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
{ 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 ];
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
-- DB.MarkTransaction[trans: DB.TransactionOf[segment: SegmentOf[e]]];
Message[viewer, eName, " copied to ", otherName, " and deleted."];
[]← Nut.Display[e: otherEntity, parent: viewer, method: replace, seg: SegmentOf[otherEntity]];
};
};

RenameProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
e: Entity = DB.DeclareEntity[d: d, name: eName, version: OldOnly];
seg: Segment = IF e = NIL THEN NIL ELSE SegmentOf[e];
newName: ROPE = ViewerTools.GetSelectionContents[];
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, $eName, newName];
viewer.name← Rope.Cat[DB.NameOf[d],": ", newName];
-- DB.MarkTransaction[trans: DB.TransactionOf[segment: seg]];
ViewerOps.PaintViewer[viewer, caption] };
};

EraseAllProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
e: Entity = DB.DeclareEntity[d: d, name: eName, version: OldOnly];
seg: Segment = IF e = NIL THEN NIL ELSE SegmentOf[e];
IF e = NIL THEN RETURN;
Message[viewer, eName, " and all associated relationships erased."];
DB.DestroyEntity[e];
ViewerOps.DestroyViewer[viewer];
-- DB.MarkTransaction[trans: DB.TransactionOf[segment: seg]]
};

AddProc: Menus.MenuProc = TRUSTED {
viewer: Viewer = NARROW[parent];
entityRow: VTable = GetTableEntry[ table: viewer.child, row: 1 ];
selected: Viewer = ViewerTools.GetSelectedViewer[];
entity: Entity;
IF selected=NIL THEN
{NutViewer.Error[viewer, "No viewer selected!"]; RETURN};
entity← NutViewer.ConvertViewerToEntity[ParentOf[selected]];
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.EditProc =
TRUSTED BEGIN
tsOut: IO.Handle;
e: Entity = DeclareEntity[d, eName, OldOnly];
al: LIST OF Attribute = NutOps.GetRefAttributes[d];
table: VTables.VTable = VTables.Create[ parent: newV, rows: 4 ];
tsV: Viewer← TypeScript.Create[info: [parent: table, ww: newV.cw, wh: 32], paint: FALSE];
seg← IF e = NIL THEN SegmentOf[d] ELSE SegmentOf[e];
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: seg],
       border: NullBorder ];
VTables.SetTableEntry[ table: table, row: 3, flavor: $Viewer,
       clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: seg],
       border: NullBorder ];
tsOut← ViewerIO.CreateViewerStreams[NIL, tsV].out;
ViewerOps.AddProp[ newV, $Typescript, tsOut ];
VTables.Install[ table, FALSE ];
ViewerOps.AddProp[ newV, $domain, d ];
ViewerOps.AddProp[ newV, $eName, eName ];
ViewerOps.PaintViewer[newV, client];
END;

DefaultCreate: PUBLIC Nut.CreateProc = {
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE SegmentOf[d];
defaultLabel: ROPE = Rope.Cat[ NameOf[d], ": ", eName,
 IF Nut.debug THEN Rope.Cat[ " (", Atom.GetPName[segment], " segment)" ] ELSE NIL ];
info: ViewerClasses.ViewerRec = [name: defaultLabel, iconic: FALSE, column: column];
RETURN[ViewerOps.CreateViewer[flavor: $Container, info: info, paint: FALSE]] };


-- Default Displayer ************************************************************

displayerMenu: Menus.Menu ← Menus.CreateMenu[];

EditProc: Menus.MenuProc =
-- Invoked when hit the "Edit" button on the default displayer.
-- Should replace the displayer viewer with an editor viewer.
{viewer: Viewer = NARROW[parent];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
eName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $eName] ];
InputFocus.SetInputFocus[];  -- kill the caret
[] ← Nut.Edit[ d: d, eName: eName, parent: viewer, method: replace, seg: SegmentOf[d] ] };

DefaultDisplay: PUBLIC Nut.DisplayProc =
TRUSTED BEGIN
table: VTables.VTable; lastViewer: Viewer;
endOfTupleSubwindow: INTEGER;
ViewerOps.SetMenu[newV, displayerMenu];
ViewerOps.AddProp[newV, $domain, DB.DomainOf[e] ];
ViewerOps.AddProp[newV, $eName, DB.NameOf[e] ];
lastViewer← BuildTupleWindowButtons[e, 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: seg, noEdits: TRUE],
  border: NullBorder ];
VTables.SetTableEntry[
  table: table, row: 1, flavor: $Viewer,
  clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: seg, noEdits: TRUE],
  border: NullBorder ];
VTables.Install[ table, FALSE ];
ViewerOps.PaintViewer[newV, client];
END;

BuildTupleWindowButtons: PROC[e: Entity, v: Viewer] RETURNS [Viewer] =
BEGIN
alT: AttributeList;
t: Relship;
myRel: Relation;
tuples: RelshipSet;
lastButton: Viewer;
myAttrs: AttributeList;
myAttrs← RemoveSpecialAttributesFrom[DB.GetAllRefAttributes[e], DB.SegmentOf[e]];
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 = IF star # NIL THEN DeclareAttribute[star, "of"] ELSE NIL;
starIs: Attribute = IF star # NIL THEN DeclareAttribute[star, "is"] ELSE NIL;
note: Relation = DeclareRelation["note", seg, OldOnly];
noteOf: Attribute = IF note # NIL THEN DeclareAttribute[note, "of"] ELSE NIL;
IF star # NIL THEN
{ new← NutOps.RemoveAttribute[starOf, old]; new← NutOps.RemoveAttribute[starIs, new] };
IF note # NIL THEN new ← NutOps.RemoveAttribute[noteOf, new];
RETURN[new]
};


-- 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.QueryProc = {
dName: ROPE = DB.NameOf[d];
table: VTables.VTable;
al: AttributeList;
tsOut: IO.Handle; tsV: Viewer;

IF DB.IsSystemEntity[d] THEN
{Message[newV, "Query not allowed on system domains!"]; RETURN};
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;
ViewerOps.AddProp[ newV, $Typescript, tsOut ];
VTables.Install[ table, FALSE ];
ViewerOps.AddProp[ newV, $domain, d ];
ViewerOps.PaintViewer[newV, all];
};

QueryProc: Menus.MenuProc = {
-- 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];
d: Domain = V2E[ ViewerOps.FetchProp[viewer, $domain] ];
dName: ROPE = NameOf[d];
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 {
Message[viewer, "One entity satisfied query; displaying it..."];
[]← Nut.Display[e: answer.first, parent: viewer, seg: SegmentOf[d]] }
ELSE
{ 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] ] }
};

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 =
BEGIN
e: Entity← V2E[clientData ! SafeStorage.NarrowRefFault => GO TO NotEntity];
[]← Nut.Display[e];
EXITS
NotEntity => NutViewer.Message[NARROW[parent], "Not an entity-valued field!"];
END;


-- Start Code ************************************************************

Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[ DBQueue[], "Edit", EditProc]];
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]];

Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]];
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]];

END.

Change log [since copied some of this code into Walnut]:

Cattell 18-Feb-82 10:29:33: ProcessSelection checks for Null.

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.