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