-- File: NutImpl.mesa
-- Contents: Implementation of Nut.mesa.
-- Created by: Rick Cattell on January, 1982
-- Last edited by:
-- Cattell on July 27, 1983 8:14 pm
-- Willie-Sue on January 21, 1983 8:55 am
-- Maxwell on July 15, 1982 12:26 pm
-- Donahue on August 15, 1983 9:15 am

DIRECTORY
Atom, DB, Nut, Rope,
DBNames,
MessageWindow USING[ Append ],
NutOps,
NutViewer,
SystemNuts,
ViewerClasses,
ViewerLocks,
ViewerOps,
VirtualDesktops USING [EnumerateViewers];

NutImpl: CEDAR MONITOR
IMPORTS
Atom, DB, DBNames, Nut, NutViewer, Rope, ViewerLocks,
ViewerOps, VirtualDesktops, SystemNuts, NutOps, MessageWindow
EXPORTS Nut
SHARES ViewerLocks =

BEGIN OPEN Nut, DB;

DomainOf: PROC[e: Entity] RETURNS[d: Domain] =
{IF e=NIL THEN RETURN[NIL] ELSE RETURN[DB.DomainOf[e]]};

-- Types and global variables

implementations: PUBLIC ImplementationList ← NIL;

ImplementationList: TYPE = LIST OF ImplementationRecord ← NIL;
ImplementationRecord: TYPE = REF ImplementationRecordObject;
ImplementationRecordObject: TYPE = RECORD[
domain: ROPE, -- name of domain
segment: DB.Segment, -- the segment of the domain
display: DisplayProc, -- nut displayer for this domain
edit: EditProc, -- nut editor for this domain
query: QueryProc, -- nut queryer for this domain
create: CreateProc, -- nut creater for this domain
update: UpdateProc, -- nut updater for this domain
transaction: TransactionProc]; -- transaction notification for this domain

defaultNutViewerProcs: ImplementationRecord← NEW[ImplementationRecordObject ← [
display: DefaultDisplay, edit: DefaultEdit,
query: DefaultQuery, create: DefaultCreate ]];

domainProcs: ImplementationRecord ← NEW[ImplementationRecordObject ← [
display: SystemNuts.DomainDisplayer, edit: SystemNuts.DomainEditor,
query: SystemNuts.DomainQueryer, create: SystemNuts.DomainCreate ]];

relationProcs: ImplementationRecord ← NEW[ImplementationRecordObject ← [
display: SystemNuts.RelationDisplayer, edit: SystemNuts.RelationEditor,
query: SystemNuts.RelationQueryer, create: SystemNuts.RelationCreate ]];

-- Exported procedures

Display: PUBLIC ENTRY PROC[ e: DB.Entity, seg: DB.Segment ← NIL,
        parent: Viewer← NIL, method: Method ← spawned] RETURNS[v: Viewer] =
-- Creates a new nut viewing entity e. If a nut implementation has
-- registered itself for e's type, that implementation will be called,
-- else the standard NutViewer browser will be used. Replace caller's nut.
BEGIN
ENABLE UNWIND => { IF v # NIL THEN ViewerOps.DestroyViewer[v] };
IF Null[e] THEN {MessageWindow.Append["Entity has been deleted!"]; RETURN};
{ eName: ROPE = NameOf[e];
d: Domain = DomainOf[e];
dName: ROPE = NameOf[d];
segment: DB.Segment = IF DB.IsSystemEntity[e] THEN seg ELSE SegmentOf[e];
implRec: ImplementationRecord = FindImpl[dName, segment];
oldV: Viewer = FindExistingViewer[displayer, d, eName, segment, parent, method];
v ← CreateNut[oldV, displayer, implRec, d, eName, segment, e];
IF v=NIL THEN RETURN[v];
IF method = spawned THEN NutViewer.SetSpawned[parent, v];
v.newVersion ← TRUE;
ViewerOps.PaintViewer[v, caption];
implRec.display[e, v, segment ! ABORTED => CONTINUE];
v.newVersion ← FALSE;
ViewerOps.PaintViewer[v, caption];
RETURN[v] }
END;

Edit: PUBLIC ENTRY PROC[ d: DB.Domain, eName: ROPE, seg: DB.Segment ← NIL,
      parent: Viewer← NIL, method: Method ← spawned] RETURNS[v: Viewer] =
BEGIN
ENABLE UNWIND => { IF v # NIL THEN ViewerOps.DestroyViewer[v] };
dName: ROPE = GetName[d];
e: Entity = FetchEntity[d, eName, seg];
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE SegmentOf[d];
implRec: ImplementationRecord = FindImpl[dName, segment];
oldV: Viewer = FindExistingViewer[editor, d, eName, segment, parent, method];
v ← CreateNut[oldV, editor, implRec, d, eName, segment, e];
IF v=NIL THEN RETURN[NIL];
IF method = spawned THEN NutViewer.SetSpawned[parent, v];
v.newVersion ← TRUE;
ViewerOps.PaintViewer[v, caption];
implRec.edit[d, eName, v, segment ! ABORTED => CONTINUE];
v.newVersion ← FALSE;
ViewerOps.PaintViewer[v, caption];
RETURN[v]
END;

Query: PUBLIC ENTRY PROC[d: DB.Domain, seg: DB.Segment ← NIL] RETURNS[v: Viewer] =
-- Creates a new nut for querying entities in d with given initial query.
BEGIN
ENABLE UNWIND => { IF v # NIL THEN ViewerOps.DestroyViewer[v] };
dName: ROPE = GetName[d];
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE SegmentOf[d];
implRec: ImplementationRecord = FindImpl[dName, seg];
v ← CreateNut[NIL, queryer, implRec, d, "?", segment];
IF v=NIL THEN RETURN[NIL];
implRec.query[d, v, segment ! ABORTED => CONTINUE];
RETURN[v]
END;

Update: PUBLIC ENTRY PROC[updateType: UpdateType, tuple: Relship] =
-- Calls any registered proc for e's domain
BEGIN
 FOR iL: ImplementationList← implementations, iL.rest UNTIL iL=NIL DO
  -- If were smart, could just call guys that could be effected by this tuple
IF iL.first.update#NIL THEN iL.first.update[updateType, tuple];
ENDLOOP;
END;

FindExistingViewer: INTERNAL PROC[
  type: Nut.NutType, d: Domain, eName: ROPE, seg: DB.Segment,
  parent: Viewer← NIL, method: Method ← oneOnly]
  RETURNS[oldV: Viewer] =
BEGIN
  -- look for an existing viewer
IF method = replace THEN oldV ← parent ELSE oldV ← NutViewer.FindSpawned[parent];
IF oldV # NIL AND oldV.newVersion THEN oldV ← NIL;
IF oldV = NIL AND method = oneOnly THEN
oldV ← NutViewer.FindViewer[type, d, eName, seg];
IF oldV # NIL AND oldV.newVersion THEN oldV ← NIL;
END;

CreateNut: INTERNAL PROC[
oldV: Viewer, type: NutType, implRec: ImplementationRecord,
d: Domain, eName: ROPE, segment: Segment, e: Entity← NIL] RETURNS [newV: Viewer] =
-- Used by Display, Edit, and Create procs: sets up a new nut in newV according to the rules.
-- Returns the new viewer and the nut record for it, or NIL if nut creation should be aborted.
-- Sets viewer state to $beingDisplayed, caller must set to $quiescent when done displaying.
-- Attaches the $Entity and $NutType properties examined by other procedures.
-- The $Entity property is a concatenation of the segment, domain, and entity NAMES rather
-- than making entities themselves properties of the viewers, so that it remains valid
-- regardless of the state of database transactions.
BEGIN
SetUpNewViewer: PROC[] = {
IF type=displayer THEN {
-- Add $Entity, used by whiteboards when AddSelected, and $EntityHandle (not used?)
e: Entity← FetchEntity[d, eName, segment];
ViewerOps.AddProp[newV, $Entity, DBNames.EntityToName[e, segment]];
ViewerOps.AddProp[ newV, $EntityHandle, e ] };
ViewerOps.AddProp[ newV, $DomainName, DB.NameOf[d] ];
ViewerOps.AddProp[ newV, $Segment, segment ];
ViewerOps.AddProp[ newV, $EntityName, eName ];
ViewerOps.AddProp[ newV, $NutType, NEW[NutType← type] ];
IF newV.icon = tool THEN
-- Set the icon if the create proc left it as default (tool) icon
newV.icon ←
IF e#NIL THEN NutViewer.GetIcon[e, segment] -- use icon for specific entity
ELSE NutViewer.GetIcon[d, segment] }; -- use icon for domain

IF segment=NIL THEN segment← DB.SegmentOf[d];
newV ← implRec.create[type, d, eName, segment, IF oldV = NIL THEN left ELSE oldV.column];
IF newV=NIL THEN RETURN;
{ ENABLE UNWIND => ViewerLocks.ReleaseWriteLock[newV];
ViewerLocks.CallUnderWriteLock[SetUpNewViewer, newV] };
IF newV = oldV THEN RETURN; -- just replacing existing viewer
IF oldV=NIL OR newV.column # oldV.column THEN
{ IF NOT newV.iconic THEN ViewerOps.ComputeColumn[newV.column];
RETURN};
IF newV.iconic # oldV.iconic THEN
ViewerOps.OpenIcon[icon: IF newV.iconic THEN newV ELSE oldV, paint: FALSE];
IF NOT newV.iconic THEN ViewerOps.ReplaceViewer[new: newV, old: oldV]
ELSE { -- ViewerOps.ReplaceViewer doesn't work well with a pair of icons
ViewerOps.DestroyViewer[oldV] }
END;

Register: PUBLIC ENTRY PROC[
domain: ROPE,
segment: DB.Segment,
display: DisplayProc← NIL,
edit: EditProc← NIL,
query: QueryProc← NIL,
create: CreateProc← NIL,
update: UpdateProc← NIL,
transaction: TransactionProc← NIL ] =
-- Registers a display, create, query, and/or notify proc for given domain. These will
-- supersede any previous non-NIL registrations for this domain.
BEGIN implRec: ImplementationRecord← FindImpl[domain, segment, TRUE];
IF display#NIL THEN implRec.display← display;
IF edit#NIL THEN implRec.edit← edit;
IF query#NIL THEN implRec.query← query;
IF create#NIL THEN implRec.create← create;
IF display#NIL THEN implRec.display← display;
IF update#NIL THEN implRec.update← update;
IF transaction#NIL THEN implRec.transaction← transaction;
END;

DeRegister: PUBLIC ENTRY PROC[segment: DB.Segment, domain: ROPE] =
BEGIN
 prev: ImplementationList← NIL;
 FOR iL: ImplementationList← implementations, iL.rest UNTIL iL=NIL DO
IF Rope.Equal[iL.first.domain, domain] AND iL.first.segment = segment THEN
{ IF prev = NIL THEN implementations← iL.rest
ELSE prev.rest← iL.rest;
EXIT;
};
prev← iL;
ENDLOOP;
END;

Notify: PUBLIC ENTRY PROC[segment: DB.Segment, type: TransactionType] = {
-- Call transaction procedures for the segment specified, or all procs if segment=NIL.
FOR iL: ImplementationList ← implementations, iL.rest UNTIL iL=NIL DO
IF segment=NIL OR segment = iL.first.segment THEN
IF iL.first.transaction # NIL THEN
iL.first.transaction[iL.first.segment, DB.GetSegmentInfo[iL.first.segment].filePath, type];
ENDLOOP;
SquirrelNotify[type, segment];
};

SquirrelNotify: INTERNAL PROC[type: TransactionType, seg: Segment] = BEGIN
-- Closes any default displayers & editors on transaction close, and re-displays them
-- on transaction abort. We know which viewers are ours by the $Implementor property;
-- Note that these nuts may be on any segment, so we must check (in OneOfMine) that
-- they are on the segment to which the transaction action pertains.
OneOfMine: PROC[v: Viewer] RETURNS[BOOL] = {
mySeg: Segment;
myImplementor: ATOM;
IF (myImplementor← NARROW[ViewerOps.FetchProp[v, $Implementor]])#NIL
AND (mySeg← NARROW[ViewerOps.FetchProp[v, $Segment]])=seg
AND myImplementor=$Squirrel THEN RETURN[TRUE]
ELSE RETURN[FALSE]};
DestroyProc: ViewerOps.EnumProc = {
IF OneOfMine[v] THEN ViewerOps.DestroyViewer[v]; RETURN[TRUE] };
AbortProc: ViewerOps.EnumProc = {
-- Figure out what kind of nut we have, and redisplay it (only for default nuts).
IF OneOfMine[v] THEN {
seg: Segment; d: Domain; eName: ROPE;
nutType: NutType← NARROW[ViewerOps.FetchProp[v, $NutType], REF NutType]^;
[seg, d, eName]← NutViewer.GetNutInfo[v];
SELECT nutType FROM
displayer =>
[]← Nut.Display[DB.FetchEntity[d, eName, seg], seg, v, replace];
editor =>
[]← Nut.Edit[d, eName, seg, v, replace];
queryer =>
NULL;
ENDCASE => ViewerOps.DestroyViewer[v];
RETURN[TRUE] }
};
SELECT type FROM
close => VirtualDesktops.EnumerateViewers[enum: DestroyProc];
abort => VirtualDesktops.EnumerateViewers[enum: AbortProc];
open => NULL;
ENDCASE => ERROR;
END;

-- Support procedures

debug: PUBLIC BOOLEAN ← FALSE;

FindImpl: INTERNAL PROC[d: ROPE, seg: Segment, create: BOOLEAN ← FALSE] RETURNS[ImplementationRecord] =
-- Try to find an implementation for domain d. If not found, return the default one.
BEGIN
IF Rope.Equal[d, "Domain"] THEN RETURN[domainProcs];
IF Rope.Equal[d, "Relation"] THEN RETURN[relationProcs];
IF ~debug THEN
FOR iL: ImplementationList ← implementations, iL.rest UNTIL iL=NIL DO
IF Rope.Equal[iL.first.domain, d] AND seg = iL.first.segment
THEN RETURN[iL.first] ENDLOOP;
IF NOT create THEN RETURN[ defaultNutViewerProcs ]
ELSE
BEGIN implRec: ImplementationRecord = NEW[ImplementationRecordObject];
implRec^ ← defaultNutViewerProcs^; implRec.domain← d;
implRec.segment ← seg;
implementations← CONS[ implRec, implementations ];
RETURN[implementations.first];
END END;

END.

Last edited by:

Rick on April 3, 1982 5:36 pm: Added new CreateProc feature so clients can create their own viewers. Added DefaultCreateProc here. Started using ReplaceViewer.

WS on April 5, 1982: Took out ReplaceViewer (can't work anyway, Scott says)

WS on April 22: changed CreateProc to pass dName&eName, return vIsOld.

Rick on April 23, 1982 9:03 am: CreateProc returns NIL if it doesn't want NutImpl to create new nut.

WS on May 6, 1982 4:08 pm: Display returns newV

Rick on May 6, 1982 6:58 pm: Check for Null entity in Display, just as defensive programming.

Maxwell on June 15, 1982 9:30 am: Changed algorithm for displaying viewers.

WS on June 23, 1982: added DBNotify stuff.

Rick & Willie-Sue on July 8, 1982: viewerSynchronizer stuff

Maxwell July 15, 1982 12:28 pm: Added "debug", NutViewer.StartTrap[]; catch ABORTED

Cattell August 3, 1982 4:40 pm: don't repaint viewers or recompute columns in Display, Edit, and Query procs.

Cattell August 5, 1982 6:54 pm: Cleaned up Display, Edit, and Query procs considerably, by putting much of their shared logic in new proc CreateNut. We no longer do any extra paint of the viewer. We no longer open the oldV if BOTH oldV and newV are iconic; this means the client wants to leave the nut iconic. We now create icons for Editors and Queryers as well as Displayers; we use the icon for the domain since there is not (necessarily) an entity associated with an editor or queryer. Simultaneously changed ViewerNutImpl so that the default icon for the domain will be used in conjuction with the domain itself. We now recompute the left column if newV is on the left, right if on the right, and neither if iconic. Added "init" parameter to Display procs and to Create procs so client can pass info through to both of these as well as Edit and Query procs. This last change involves changing Nut.

Cattell October 12, 1982 12:27 pm: Halfway fixed problem with new Viewers (3.4) destroying nuts before they are created: set "filler" field to non-zero until viewer is fully created. Added PUBLIC GetViewerState, would like to put this in NutViewer interface when possible.

WS on October 28, 1982 4:26 pm: now have inhibitDestroy bit in ViewerRec

Cattell on April 13, 1983 11:45 am: should have passed segment, not seg, in call to implRec.display in Display proc. Same with Edit and Query procs.

Cattell on May 25, 1983 1:41 pm: should have used seg of entity, not domain in Display.

Donahue on June 21, 1983: added UNWIND catch phrases to destroy viewers that may have been created but haven't been completely filled in by editor, displayer, queryer

Donahue on July 26, 1983 1:48 pm: changed Display and Edit to only keep track of viewers explicitly spawned (if you display something oneOnly, then it is not regarded as being spawned from the parent viewer)