-- 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.



�Ê,˜J•StartOfExpansion [viewer: 
ViewerClasses.Viewer]šáÏc œ
Ïk	œ	žœ(žœpžœžœ
žœžœ
žœtžœžœžœ
žœžœÏnœžœžœžœžœ
žœ
žœ
žœžœ
žœ
žœ�œžœžœžœžœ
žœžœžœžœ9žœžœžœ�œžœ	�œ�!œ�œ�œ�œ�œ"�,œ.žœ¦
žœ×
žœ·
�œ
Ÿœžœ
žœ
žœžœžœžœžœžœ�Dœ�Gœ�Lœžœžœ
žœžœžœ
žœ"žœ	žœ4žœžœ6žœžœžœ
žœžœžœé
žœžœ
žœ
žœ	žœžœ5žœMžœžœžœ-žœžœŸœžœ
žœ
žœžœžœžœžœžœžœžœžœ
žœžœžœ
žœ(žœDžœžœžœžœÛ
žœžœ
žœ
žœ
žœžœžœ3žœMžœžœžœ)žœžœŸœžœ
žœ
žœžœžœžœžœ�Jœžœžœ
žœžœžœ
žœ)žœžœžœžœžœWžœ(žœžœ
žœ
žœ
žœ#žœžœžœžœŸœžœ
žœ
žœ-�,œžœžœ2žœžœ
žœ�Lœžœžœ
žœ)žœžœŸœžœ
žœ)žœžœžœžœžœ�œžœžœžœ)žœžœ
žœžœžœžœžœ
žœžœ;žœžœ
žœžœžœžœŸ	œžœ
žœTžœžœžœ�^œ�_œ�šœžœŸœžœžœžœ	�TœÚ
žœš
žœžœžœ�Bœžœžœ
žœ� œžœ"�œžœ	žœ
žœ
žœ@žœžœ
žœžœžœžœ
žœ
žœžœ
žœgžœ
žœ
žœÐci!�
œžœžœ
žœžœžœ
žœ
žœ.žœžœžœ!žœ
žœžœžœžœ
žœ
žœ1žœ�Bœ&žœŸœžœ
žœ
žœžœ
žœ"žœžœžœžœžœ"žœ�Xœ�Aœžœ:žœžœ	žœ
žœžœžœ
žœžœžœ
žœžœžœ
žœžœ	žœ
žœžœžœ
žœžœ
žœ
žœ%žœŸ
œžœ
žœ
žœ
žœžœžœžœžœ2žœžœ
žœžœ%žœžœžœžœ
žœ"žœžœžœžœŸœžœ
žœ
žœ
žœ'�Wœžœ3žœžœ
žœžœ	žœ
žœžœžœžœ
žœ0žœ8žœ*Ðbnœžœ
žœ(žœ�Vœ�Wœ�Tœ�EœŸ	œžœžœ
žœ-žœžœžœ(žœžœ	žœ/žœžœ
žœ
žœžœ
žœ
žœ.žœžœžœ
žœ-�Rœžœžœ)žœžœ#žœBžœ	žœ0žœ‘
žœ
žœ&žœ
žœ
žœžœ�
žœžœžœžœ�œžœ
žœžœŸœžœ
žœžœžœžœžœ�Vœžœžœžœ
žœžœžœ
žœžœžœžœ3žœžœ
žœ	žœ žœžœ
žœžœ
žœžœžœ
žœžœ
žœžœžœ!žœ‰
žœ"žœžœ
žœžœ„
˜�aJ˜—…—0”7Æ