-- 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 (iL.first.segment=NIL OR iL.first.segment=seg)
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:

Cattell on January 16, 1984 12:12 pm: passing NIL in for segment when registering means will take any segment.