-- 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: October 7, 1983 4:19 pm
-- Donahue on: July 29, 1983 2:41 pm

-- 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,
-- FinchSmarts USING [PlaceCall],
Icons USING [IconFlavor, NewIconFromFile],
InputFocus USING [SetInputFocus],
IO,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
NoteEditor,
Nut,
NutOps,
NutViewer,
Rope,
PrincOpsUtils USING [IsBound],
SafeStorage USING [NarrowRefFault],
SquirrelTool USING [squirrel],
TuplesEditor,
TypeScript,
ViewerIO,
ViewerOps,
ViewerClasses,
ViewerTools,
VTables;


NutDefaultImpl: CEDAR PROGRAM
IMPORTS
Atom, DB, DBIcons, IO, Nut, NutOps, NutViewer,
EntityEditor, -- FinchSmarts,-- Icons, InputFocus, Menus, NoteEditor, Rope, PrincOpsUtils, SafeStorage,
SquirrelTool, 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 = {
-- Resets contents of editor to its statebefore edits started.
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE; e: Entity;
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
e← DB.FetchEntity[d, eName, seg ! DB.Error => { e ← NIL; CONTINUE } ];
InputFocus.SetInputFocus[]; -- kill the caret
[] ← Nut.Edit[ d: d, eName: eName, parent: viewer, method: replace, seg: seg] };

SaveProc: Menus.MenuProc = {
-- Invoked when hit the "Save" button on an editor: makes edits and then turns into displayer.
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE; e: Entity;
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
e ← DB.DeclareEntity[d, eName, NewOrOld ];
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 ];
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
[]← 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];
seg: Segment; d: Domain; eName: ROPE; e: Entity; otherEntity: Entity;
otherName: ROPE = ViewerTools.GetSelectionContents[];
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
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
{ 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 ];
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
[]← Nut.Display[e: otherEntity, parent: viewer, method: replace, seg: SegmentOf[otherEntity]];
};
};

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; eName: ROPE; e: Entity;
newName: ROPE = ViewerTools.GetSelectionContents[];
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
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[DB.NameOf[d],": ", newName];
ViewerOps.PaintViewer[viewer, caption] };
};

EraseAllProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE; e: Entity;
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
e← DB.FetchEntity[d, eName, seg ! DB.Error => { e ← NIL; CONTINUE } ];
IF e = NIL THEN RETURN;
-- Print message in Squirrel window since this one won't be there ...
NutViewer.Message[SquirrelTool.squirrel, eName, " and all associated relationships erased."];
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← NutViewer.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.EditProc =
TRUSTED BEGIN
tsOut: IO.STREAM;
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 ];
ViewerOps.AddProp[ newV, $Implementor, $Squirrel ];
VTables.Install[ table, FALSE ];
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[];
auxDisplayerMenu: Menus.Menu ← Menus.CreateMenu[];

DefaultDisplay: PUBLIC Nut.DisplayProc =
TRUSTED BEGIN
table: VTables.VTable; lastViewer: Viewer;
endOfTupleSubwindow: INTEGER;
dName: ROPE = DB.NameOf[DB.DomainOf[e]];
-- IF PrincOpsUtils.IsBound[FinchSmarts.PlaceCall] AND
-- (dName.Equal["Organization"] OR dName.Equal["Person"]) THEN
-- ViewerOps.SetMenu[newV, auxDisplayerMenu]
-- ELSE
ViewerOps.SetMenu[newV, displayerMenu];
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.AddProp[ newV, $Implementor, $Squirrel ];
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 = 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 = {
-- Invoked when hit the "Edit" button on the default displayer.
-- Should replace the displayer viewer with an editor viewer.
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE;
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
[] ← Nut.Edit[ d: d, eName: eName, parent: viewer, method: replace, seg: seg ] };

PhoneHomeProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE;
ok: PROC[s: ROPE] RETURNS[BOOL] = {RETURN[s.Equal["home", FALSE]]};
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
Phone[DB.FetchEntity[d, eName, seg], ok];
};

PhoneWorkProc: Menus.MenuProc = {
viewer: Viewer = NARROW[parent];
seg: Segment; d: Domain; eName: ROPE;
ok: PROC[s: ROPE] RETURNS[BOOL] = {RETURN[NOT s.Equal["home", FALSE]]};
[seg, d, eName]← NutViewer.GetNutInfo[viewer];
Phone[DB.FetchEntity[d, eName, seg], ok];
};

Phone: PROC [e: Entity, ok: PROC[ROPE] RETURNS [BOOL]] = {
seg: Segment = SegmentOf[e];
phone: Relation = DB.DeclareRelation["phone", seg, OldOnly];
phoneOf: Attribute = DeclareAttribute[r: phone, name: "of", version: OldOnly];
phoneIs: Attribute = DeclareAttribute[r: phone, name: "is", version: OldOnly];
phoneAt: Attribute = DeclareAttribute[r: phone, name: "at", version: OldOnly];
phones: RelshipSet← DB.RelationSubset[phone, LIST[[phoneOf, e]]];
-- FOR pRel: Relship← NextRelship[phones], NextRelship[phones] UNTIL pRel=NIL DO
-- IF ok[GetFS[pRel, phoneAt]] THEN TRUSTED
-- {FinchSmarts.PlaceCall[number: GetFS[pRel, phoneIs], rName: NameOf[e]]; RETURN};
-- ENDLOOP;
NutViewer.Error[NIL, "Can't find phone number for ", NameOf[e]];
};

-- 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.STREAM; 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;
VTables.Install[ table, FALSE ];
ViewerOps.AddProp[ newV, $Typescript, tsOut ];
ViewerOps.AddProp[ newV, $Implementor, $Squirrel ];
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];
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 {
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: e, seg: NIL, parent: GetTopLevel[NARROW[parent]], method: spawned];
EXITS
NotEntity => NutViewer.Message[NARROW[parent], "Not an entity-valued field!"];
END;

GetTopLevel: PROC [v: Viewer] RETURNS [top: Viewer] =
{FOR top← v, top.parent UNTIL top.parent=NIL DO ENDLOOP};


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

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

Menus.AppendMenuEntry[
auxDisplayerMenu, MakeMenuEntry[DBQueue[], "Edit", EditProc]];
Menus.AppendMenuEntry[
auxDisplayerMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]];
Menus.AppendMenuEntry[
auxDisplayerMenu, MakeMenuEntry[DBQueue[], "Phone", PhoneWorkProc]];
Menus.AppendMenuEntry[
auxDisplayerMenu, MakeMenuEntry[DBQueue[], "PhoneHome", PhoneHomeProc]];

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.

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.