{ outerTable: VTable;
table: VTable;
nextRow: INT ← 0;
nextCol: INT ← 0;
starRel: Relation = IF in = NIL THEN NIL ELSE DeclareRelation["related-entity", in, OldOnly];
starOfAttr: Attribute =
IF in = NIL OR starRel = NIL THEN NIL
ELSE DeclareAttribute[ r: starRel, name: "of", type: RopeType, version: OldOnly ];
starIsAttr: Attribute =
IF in = NIL OR starRel = NIL THEN NIL
ELSE DeclareAttribute[ r: starRel, name: "is", type: RopeType, version: OldOnly ];
entitySet: RelshipSet =
IF of = NIL OR starRel = NIL THEN NIL
ELSE RelationSubset[starRel,LIST[AttributeValue[starOfAttr, DBNames.EntityToName[of, DB.SegmentOf[of]]]]];
nextRel: Relship ← IF entitySet = NIL THEN NIL ELSE NextRelship[entitySet];
IF nextRel =
NIL
AND noEdits
THEN
{ IF entitySet # NIL THEN ReleaseRelshipSet[entitySet]; RETURN[NIL] };
outerTable ← Create[ rows: 2, parent: parent ];
ViewerOps.AddProp[ outerTable, $of, of ];
ViewerOps.AddProp[ outerTable, $segment, in ];
SetTableEntry[ table: outerTable, row: 0, name: "Related Entities:", border: NullBorder ];
table ← Create[ rows: 1, columns: 6, parent: outerTable ];
SetTableEntry[ table: outerTable, row: 1, flavor: $Viewer,
clientData: table, border: NullBorder, xoff: 5 ];
UNTIL nextRel =
NIL
DO
nextEntity: Entity = DBNames.NameToEntity[V2S[GetF[nextRel, starIsAttr]]];
IF nextEntity = NIL THEN { nextRel ← NextRelship[entitySet]; LOOP };
AddEntity[ nextEntity, in, table, nextRow, nextCol ];
nextCol ← nextCol+1 MOD 6;
IF nextCol = 0
THEN
{ nextRow ← nextRow+1;
SetRowsAndColumns[ table: table, rows: nextRow+1, columns: 6 ] };
nextRel ← NextRelship[entitySet]
ENDLOOP;
Install[ table, FALSE ];
ViewerOps.AddProp[ table, $nextRow, NEW[INT ← nextRow] ];
ViewerOps.AddProp[ table, $nextCol, NEW[INT ← nextCol] ];
ViewerOps.AddProp[ table, $edits,
NEW[
BOOLEAN ←
NOT noEdits ] ];
ReleaseRelshipSet[entitySet];
Install[ outerTable, FALSE ];
RETURN[ outerTable ] };
NewEntry:
PUBLIC
PROC[ is: Entity, table: VTable ] = {
innerTable: VTable = GetTableEntry[ table, 1 ];
segment: DB.Segment = NARROW[ ViewerOps.FetchProp[ table, $segment ] ];
nextRow: REF INT ← NARROW[ ViewerOps.FetchProp[ innerTable, $nextRow ], REF INT ];
nextCol: REF INT ← NARROW[ ViewerOps.FetchProp[ innerTable, $nextCol ], REF INT ];
FOR i:
INT
IN [0..nextRow^]
DO
FOR j:
INT
IN [0..
IF i < nextRow^
THEN 6
ELSE nextCol^)
DO
eInVName:
ROPE =
NARROW[ ViewerOps.FetchProp[GetTableEntry[table, i, j], $name], ROPE];
eInV: Entity = IF eInVName = NIL THEN NIL ELSE DBNames.NameToEntity[eInVName];
IF DB.Eq[eInV, is] THEN RETURN
ENDLOOP
ENDLOOP;
AddEntity[ is, segment, innerTable, nextRow^, nextCol^ ];
nextCol^ ← (nextCol^+1) MOD 6;
IF nextCol^ = 0
THEN
{ nextRow^ ← (nextRow^ + 1);
SetRowsAndColumns[ table: innerTable, rows: nextRow^ + 1, columns: 6 ] };
Install[ innerTable, FALSE ];
Install[ table, FALSE ] };
AddEntity:
PROC[ e: Entity, seg:
DB.Segment, table: VTable, nextRow:
INT, nextCol:
INT ] = {
icon: Icons.IconFlavor = DBIcons.GetIconForEntity[ DB.NameOf[e], DB.NameOf[DB.DomainOf[e]], seg ];
newV: Viewer =
ViewerOps.CreateViewer[ flavor: $IconEntity,
info: ViewerClasses.ViewerRec[ ww: 70, wh:64,
name: IF e = NIL THEN NIL ELSE GetName[e],
parent: table, icon: icon, border: FALSE ],
paint: FALSE ];
ViewerOps.AddProp[newV, $name,
IF e = NIL THEN NIL ELSE DBNames.EntityToName[e, seg]];
SetTableEntry[ table: table, row: nextRow, column: nextCol,
flavor: $Viewer, clientData: newV, border: NullBorder ] };
given a table set up by DisplayEntities, add all of its contents to the database
if a newOf is provided, then it will be used to create new relationships with all of the
entities that are displayed in the table; otherwise all of the existing relationships for the
entity provided when the table was created will be updated
SaveEntities:
PUBLIC
PROC[ viewer: Viewer, newOf: Entity ←
NIL ] = {
table: VTable = GetTableEntry[ viewer, 1 ];
nextRow: INT = NARROW[ ViewerOps.FetchProp[ table, $nextRow ], REF INT ]^;
nextCol: INT = NARROW[ ViewerOps.FetchProp[ table, $nextCol ], REF INT ]^;
seg: Segment = NARROW[ ViewerOps.FetchProp[ table.parent, $segment ]];
starRel: Relation = DeclareRelation["related-entity", seg, NewOrOld];
starOfAttr: Attribute = DeclareAttribute[ starRel, "of", RopeType ];
starIsAttr: Attribute = DeclareAttribute[ starRel, "is", RopeType ];
oldOf: Entity = V2E[ ViewerOps.FetchProp[ viewer, $of ] ];
of: Entity = IF newOf = NIL THEN oldOf ELSE newOf;
ofName: ROPE = DBNames.EntityToName[ of, DB.SegmentOf[of] ];
first destroy all of the old relationships for the entity
oldSet: RelshipSet =
IF of = NIL THEN ERROR SaveFailed ELSE
RelationSubset[starRel,LIST[AttributeValue[starOfAttr, ofName]]];
FOR next: Relship ← NextRelship[oldSet], NextRelship[oldSet]
UNTIL next =
NIL
DO
DestroyRelship[next];
ENDLOOP;
ReleaseRelshipSet[oldSet];
now just add the new relships
FOR i:
INT
IN [0..nextRow]
DO
FOR j:
INT
IN [0 ..
IF i < nextRow
THEN 6
ELSE nextCol)
DO
nextViewer: Viewer = GetTableEntry[ table, i, j ];
IF nextViewer #
NIL
THEN
{ entityName:
ROPE =
NARROW[ ViewerOps.FetchProp[ nextViewer, $name ],
ROPE ];
IF entityName # NIL THEN
[] ← DeclareRelship[starRel,
LIST[ AttributeValue[starOfAttr, ofName],
AttributeValue[starIsAttr, entityName]]] }
ENDLOOP
ENDLOOP };
MyPaint: ViewerClasses.PaintProc =
TRUSTED {
icon: Icons.IconFlavor = self.icon;
Icons.DrawIcon[ flavor: icon, context: context, label: self.name ] };
MyNotify: ViewerClasses.NotifyProc =
TRUSTED {
FOR list:
LIST
OF
REF
ANY ← input, list.rest
UNTIL list =
NIL
DO
WITH list.first
SELECT
FROM
z: ATOM => InterpAtom[self, z];
ENDCASE;
ENDLOOP };
InterpAtom:
PROC[ self: Viewer, atom:
ATOM ] = {
name: ROPE = NARROW[ViewerOps.FetchProp[self, $name], ROPE ];
SELECT atom
FROM
$Open =>
{ eName, domain, segment: Rope.
ROPE;
[segment, domain, eName] ← DBNames.DecomposeName[name];
[] ← Nut.Display[eName: eName, domain: domain, segment: DBNames.SegmentOf[segment].segment ] };
$Remove =>
{ name:
ROPE =
NARROW[ViewerOps.FetchProp[self, $name],
ROPE ];
e: Entity = DBNames.NameToEntity[name];
eName: Rope.ROPE = DB.NameOf[e];
IF
NOT
DB.Null[e]
AND NOT NutOps.IsSystemDomain[eName]
AND NOT NutOps.IsSystemRelation[eName] THEN DeleteEntity[e, self.parent] };
ENDCASE };
SpawnParent:
PROC[ v: Viewer ]
RETURNS [ parent: Viewer ] = {
parent ← v;
WHILE parent.parent # NIL DO parent ← parent.parent ENDLOOP };
DeleteEntity:
PROC[ e: Entity, table: VTable ] = {
nextRow:
REF
INT ←
NARROW[ ViewerOps.FetchProp[ table, $nextRow ],
REF
INT ];
nextCol: REF INT ← NARROW[ ViewerOps.FetchProp[ table, $nextCol ], REF INT ];
edits: REF BOOLEAN = NARROW[ ViewerOps.FetchProp[ table, $edits ], REF BOOLEAN ];
IF NOT edits^ THEN RETURN;
FOR i:
INT
IN [0..nextRow^]
DO
FOR j:
INT
IN [0..
IF i < nextRow^
THEN 6
ELSE nextCol^)
DO
eInVName:
ROPE =
NARROW[ ViewerOps.FetchProp[GetTableEntry[table, i, j], $name], ROPE];
eInV: Entity = IF eInVName = NIL THEN NIL ELSE DBNames.NameToEntity[eInVName];
IF
DB.Eq[eInV, e]
THEN
{ ShiftTable[ table, i, j ];
IF nextCol^ = 0 THEN { nextCol^ ← 6; nextRow^ ← nextRow^ - 1 }
ELSE nextCol^ ← nextCol^ - 1;
RETURN }
ENDLOOP
ENDLOOP};
ShiftTable:
PROC[ table: VTable, i:
INT, j:
INT ] = {
rows: INT = GetRowsAndColumns[ table ].rows;
nextI, nextJ: INT;
nextJ ← (j+1) MOD 6; nextI ← IF nextJ=0 THEN i+1 ELSE i;
SetTableEntry[ table: table, row: i, column: j, h: 64, w: 67, border: NullBorder ];
WHILE nextI < rows
DO
SwapTableEntries[ table: table, row1: i, column1: j, row2: nextI, column2: nextJ ];
j ← (j+1) MOD 6; IF j = 0 THEN i ← i + 1;
nextJ ← (j+1) MOD 6; nextI ← IF nextJ=0 THEN i+1 ELSE i
ENDLOOP;
Install[ table, FALSE ];
Install[ table.parent, TRUE ] };
Init:
PROC[]= {
tipTableName: ROPE = "NutPackage.tip";
tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable[tipTableName];
iconClass: ViewerClasses.ViewerClass ← NEW[ ViewerClasses.ViewerClassRec ← [] ];
iconClass^ ← ViewerOps.FetchViewerClass[$Button]^;
iconClass.flavor ← $IconEntity;
iconClass.notify ← MyNotify;
iconClass.tipTable ← tipTable;
iconClass.paint ← MyPaint;
iconClass.cursor ← Cursors.CursorType[crossHairsCircle];
ViewerOps.RegisterViewerClass[ flavor: $IconEntity, class: iconClass ] };
Init[];
END.