-- 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) Э╩RШ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ЮЬЮЬЮЬ ЮЬ ЮЬ ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬ!ЮЬЙЮЬ"ЮЬЮЬЮЬЮЬ╖ЮЬKЮЬyЮЬ0ЮЬ█ЮЬ│ЮЬ╓ЮЬхЮЬOЮЬ╪ЮЬ╙ШЖvJШЧЕЧ; Bb