(FILECREATED "22-SEP-83 15:25:24" {INDIGO}<LOOPS>SOURCES>LOOPSMIXIN.;4 33846
changes to: (FNS ListMetaClass.New ListMetaClass.DestroyInstance)
previous date: "20-SEP-83 12:09:19" {INDIGO}<LOOPS>SOURCES>LOOPSMIXIN.;3)
(PRETTYCOMPRINT LOOPSMIXINCOMS)
(RPAQQ LOOPSMIXINCOMS [(* Copyright (c)
1982 by Xerox Corporation)
(* USEFUL MIXINS)
(CLASSES * KERNELMIXINS)
(FNS * KERNELMIXINFNS)
(* * Classes and functions for perspectives -- A group of objects can be
associated together as different perspectives of the same thing. This is
implemented by having them all point to a Node instance which has all the
associated objects on a property list (of the variable (QUOTE perspectives))
%. Each object has a perspective name
(unique in the associated group, but perhaps used in many groups)
that is used to identify it by the other objects. The user does not need to
see the perspectiveNode, but can simply get from one object to another by
means of the message GetPersp with argument perspName.)
(CLASSES * PERSPECTIVECLASSES)
(FNS * PERSPECTIVEFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML)
(LAMA])
(* Copyright (c) 1982 by Xerox Corporation)
(* USEFUL MIXINS)
(RPAQQ KERNELMIXINS (DatedObject GlobalNamedObject IndirectObj ListMetaClass NamedObject StrucMeta
TempClass Template VarLength))
(DEFCLASSES DatedObject GlobalNamedObject IndirectObj ListMetaClass NamedObject StrucMeta TempClass
Template VarLength)
[DEFCLASS DatedObject
(MetaClass Class doc
(* * Mixin to record the creator and date of creation for objects.)
Edited: (* dgb: "22-JUN-82 11:54")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (created #(INITIAL (DATE)
NIL) doc (* data and time of creation of object))
(creator #(INITIAL (EVAL (QUOTE USERNAME))
NIL) doc (* USERNAME of creator of object)))
(Methods)]
[DEFCLASS GlobalNamedObject
(MetaClass Class Edited: (* dgb: "22-NOV-82 13:49")
doc
(* * Mixin for object to give it a name in the global name table. Note that this name is unique.
See NamedObject.)
)
(Supers NamedObject)
(ClassVariables)
(InstanceVariables (name #(NIL NIL GlobalName)))
(Methods)]
[DEFCLASS IndirectObj
(MetaClass Class Edited: (* dgb: "18-MAR-83 14:25"))
(Supers Object)
(ClassVariables)
(InstanceVariables)
(Methods (ForwardMessage IndirectObj.ForwardMessage args (dummyArg1 dummyArg2 dummyArg3 dummyArg4
dummyArg5)
doc (* will forward messages with up to five arguments
(a design choice) to object in DefaultObject, using
selector in ForwardedSelector)
)
(IVMissing IndirectObj.IVMissing args (ivName)
doc (* Find a perspective which has the IV requested, and
return its object description)
)
(MessageNotUnderstood IndirectObj.MessageNotUnderstood args (obj selector)
doc (* Set up message forwarding)
))]
[DEFCLASS ListMetaClass
(MetaClass MetaClass Edited: (* dgb: "23-NOV-82 02:21"))
(Supers Class)
(ClassVariables)
(InstanceVariables)
(Methods (DestroyInstance ListMetaClass.DestroyInstance args (class object)
doc (* Remove saved object from list and then destroy)
)
(New ListMetaClass.New args (class)))]
[DEFCLASS NamedObject
(MetaClass Class doc
(* * Mixin to give instances of this class unique names, stored in the name instance variable.
Note that the LOOPS function NameEntity already provides a facility by which objects can be given an arbitrary
number of names. This mixin is used give an object a unique name, and to indicate classes whose instances are
normally expected to have unique names.)
Edited: (* dgb: "22-NOV-82 13:46")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (name #(NIL NIL RememberName) doc (* name is stored in nameTable and as IV)
))
(Methods (Copy NamedObject.Copy args (name)
doc (*)
)
(PrintOn NamedObject.PrintOn args (file)
doc (* print "#&(ClassName name)")
)
(SetName NamedObject.SetName args (name)
doc (* Set the name IV in this object)
))]
[DEFCLASS StrucMeta
(MetaClass MetaClass doc (* Mixin for a meta class which uses its own structure
as a template for new classes.
See StrucMeta.New)
Edited: (* dgb: "18-MAR-83 16:25")
)
(Supers MetaClass)
(ClassVariables)
(InstanceVariables)
(Methods (New StrucMeta.New doc
(* Construct a new class, using IV descriptions of this class as IV descriptions for New class, and similarly for
CVs, except for those CVs which have a property Local with value T)
))]
[DEFCLASS TempClass
(MetaClass MetaClass Edited: (* dgb: "23-NOV-82 02:02"))
(Supers Class)
(ClassVariables)
(InstanceVariables)
(Methods (New TempClass.New args NIL doc (* All objects of this class will be temp objects)
))]
[DEFCLASS Template
(MetaClass MetaClass doc
(* * Special Class used for composite objects.)
Edited: (* dgb: "12-JAN-83 15:17")
)
(Supers Class)
(ClassVariables)
(InstanceVariables)
(Methods (Copy Template.Copy args (class alist)
doc
(* * Specilaizes a template class %. alist pairs template subclasses found in the IVs with their new
specializations. Most of the work is done by TemplateCopy)
)
(New Template.New doc
(* * Fills in the new instance substituting for template instances. alist pairs template subclasses found in the
IVs with their instantiations. Most of the work is done by TemplateCopy)
args
(alist))
(Specialize Template.Specialize args (alist)
doc
(* * Specializes a template class %. alist pairs template subclasses found in the IVs with their new
specializations. Most of the work is done by TemplateCopy)
))]
[DEFCLASS VarLength
(MetaClass Class doc
(* * Mixin to provide objects with a set of indexed variables, accessed by number.)
Edited: (* mjs: "29-JUN-82 14:51")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (indexedVars NIL doc (* place where indexed variables are stored for
VarLength classes.)))
(Methods (Length VarLength.Length doc (* Returns number of indexed variables allocated in this
instance.)
args NIL))]
(RPAQQ KERNELMIXINFNS (GlobalName IndirectObj.ForwardMessage IndirectObj.IVMissing
IndirectObj.MessageNotUnderstood ListMetaClass.DestroyInstance
ListMetaClass.New NamedObject.Copy NamedObject.PrintOn
NamedObject.SetName Perspective.Copy Perspective.FindIVHolder
Perspective.FindReceiver Perspective.ListViews RememberName
StrucMeta.New VarLength.Length Node.Copy Node.FindIVHolder
Node.FindReceiver Node.GetPersp Node.ListViews TempClass.New
Template.Copy Template.New Template.Specialize))
(DEFINEQ
(GlobalName
[LAMBDA (self varName name prop av) (* dgb: "28-APR-83 18:40")
(* * Used as an attached procedure for fields which are supposed to be global names. See GlobalNamedObject.
Deletes an old name if necessary, and adds the new name to the name table)
(RESETVAR CurrentNameTable GlobalNameTable (PROG (oldName (GetValue self varName))
(DoMethod self (QUOTE SetName)
(%$ Object)
name)
(COND
((EQ oldName name)
(RETURN name))
(oldName (UnNameEntity self oldName)))
(PutLocalState av name self varName prop)
(RETURN name])
(IndirectObj.ForwardMessage
[LAMBDA (self dummyArg1 dummyArg2 dummyArg3 dummyArg4 dummyArg5)
(* dgb: "18-MAR-83 14:39")
(* will forward messages with up to five arguments
(a design choice) to object in DefaultObject, using
selector in ForwardedSelector)
(ApplyMethod DefaultObject ForwardedSelector (LIST dummyArg1 dummyArg2 dummyArg3 dummyArg4
dummyArg5])
(IndirectObj.IVMissing
[LAMBDA (self ivName createDescrFlg) (* dgb: "18-MAR-83 16:18")
(* Find a perspective which has the IV requested, and
return its object description)
(COND
((SETQ DefaultObject (← self FindIVHolder ivName)) (* Get the description from the instance, or return the
one from the class)
(OR (GetIVDescr DefaultObject ivName createDescrFlg)
(FetchCIVDescr (Class DefaultObject)
ivName)))
(T (←Super
self IVMissing ivName createDescrFlg])
(IndirectObj.MessageNotUnderstood
[LAMBDA (self selector) (* dgb: "18-MAR-83 14:37")
(* Set up message forwarding)
(COND
((SETQ DefaultObject (← self FindReceiver selector))
(* If there is an object who will receive this message, the call ForwardMessage which will Apply the appropriate
method to the receiver using args)
(SETQ ForwardedSelector selector)
(QUOTE ForwardMessage))
(T (←Super
self MessageNotUnderstood selector])
(ListMetaClass.DestroyInstance
[LAMBDA (class object) (* dgb: "22-SEP-83 12:44")
(* Remove saved object from list and then destroy)
(PutClass class [DREMOVE object (LISTP (GetClass class (QUOTE AllInstances]
(QUOTE AllInstances))
(←Super
class DestroyInstance object])
(ListMetaClass.New
[LAMBDA (class name) (* dgb: "22-SEP-83 12:41")
(* Create an object, and keep a list in the class
property AllInstances)
(PROG ((newInstance (←Super
class New name)))
(PutClass class [CONS newInstance (LISTP (GetClass class (QUOTE AllInstances]
(QUOTE AllInstances))
(RETURN newInstance])
(NamedObject.Copy
[LAMBDA (self name) (* mjs: "17-FEB-83 13:11")
(*)
(PROG ((obj (←Super
self Copy)))
(← obj SetName name)
(RETURN obj])
(NamedObject.PrintOn
[LAMBDA (self file) (* dgb: "25-OCT-82 22:34")
(* print "#&(ClassName name)")
(PRIN1 "#&" file)
(PRIN2 (LIST (ClassName self)
(OR (%@ name)
(UID self)))
file)
self])
(NamedObject.SetName
[LAMBDA (self name) (* dgb: " 2-MAR-82 17:42")
(* Set the name IV in this object)
(←@
name name)
self])
(Perspective.Copy
[LAMBDA (self) (* mjs: "17-FEB-83 12:49")
(* dgb: "17-NOV-82 23:44")
(* Copy this perspectives and all perspectives form it.
Work done by CopyPesp on Node)
(GetValue (← (%@ perspectiveNode)
Copy)
(QUOTE perspectives)
(%@ self perspectiveNode myViewName])
(Perspective.FindIVHolder
[LAMBDA (self ivName) (* dgb: "18-MAR-83 15:24")
(* Find perspective having IV with name ivName)
(← (%@ perspectiveNode)
FindIVHolder ivName])
(Perspective.FindReceiver
[LAMBDA (self selector) (* dgb: "18-MAR-83 14:50")
(* Find a receiver for a message which is not understood
by me)
(← (%@ perspectiveNode)
FindReceiver selector])
(Perspective.ListViews
[LAMBDA (self) (* dgb: "18-MAR-83 15:19")
(* List all the views of this perspective, including
self)
(← (%@ perspectiveNode)
ListViews])
(RememberName
[LAMBDA (self varName newName propName av type) (* dgb: "28-APR-83 18:40")
(* * Used as an attached procedure for fields which are supposed to be names known by the database system.
Deletes an old name if necessary, and adds the new name to the name table)
(PROG ((oldName (GetValue self varName)))
(DoMethod self (QUOTE SetName)
(%$ Object)
newName)
(COND
(oldName (UnNameEntity self oldName)))
(PutLocalState (GetValueOnly self varName propName)
newName self varName propName type))
newName])
(StrucMeta.New
[LAMBDA (self name supers) (* dgb: "18-MAR-83 16:26")
(* Construct a new class, copying IV descriptions in this class as IV descriptions for New class, and copying CV
descriptions, except for those CVs which have a property Local with value T)
(PROG ((newClass (←Super
self New name supers)))
(for iv in (← self List!(QUOTE IVs)) do (← self CopyIV iv newClass))
(for cv in (← self List (QUOTE CVs)) when (NEQ T (GetCVHere self cv (QUOTE Local)))
do (← self CopyCV cv newClass))
(RETURN newClass])
(VarLength.Length
[LAMBDA (self) (* mjs: "29-JUN-82 14:50")
(* Returns number of indexed variables allocated in this
instance.)
(LENGTH (%@ indexedVars])
(Node.Copy
[LAMBDA (self) (* mjs: "17-FEB-83 12:42")
(* dgb: "17-NOV-82 23:27")
(* Copy node and all its perspectives)
(← self Sublis (for view persp in (← self List (QUOTE IVPROPS)
(QUOTE perspectives))
collect (SETQ persp (GetIVHere self (QUOTE perspectives)
view))
(PutValue persp (QUOTE perspectiveNode)
view
(QUOTE myViewName))
(LIST persp])
(Node.FindIVHolder
[LAMBDA (self ivName) (* dgb: "18-MAR-83 15:16")
(* Find a perspective which has iv named)
(for v in (← self ListViews) do (AND (← v HasIV ivName)
(RETURN v])
(Node.FindReceiver
[LAMBDA (self selector) (* dgb: "18-MAR-83 14:55")
(* Find a perpective that understands selector)
(for p v in (← self List (QUOTE IVPROPS)
(QUOTE perspectives))
do (AND (← (SETQ v (GetValue self (QUOTE perspectives)
p))
Understands selector)
(RETURN v])
(Node.GetPersp
[LAMBDA (self perspName causeError) (* dgb: "29-SEP-82 16:46")
(* Returns the perspective of this node with viewName
perspName)
(PROG (persp)
(RETURN (OR (AND (NEQ (SETQ persp (GetValue self (QUOTE perspectives)
perspName)
NotSetValue))
persp)
(AND causeError (HELPCHECK self " has no perspective " perspName)
NIL])
(Node.ListViews
[LAMBDA (self) (* dgb: "18-MAR-83 15:20")
(* List all the perspectives on this node)
(for viewName view in (← self List (QUOTE IVPROPS)
(QUOTE perspectives))
when (type? instance (SETQ view (GetValue self (QUOTE perspectives)
viewName)))
collect view])
(TempClass.New
[LAMBDA (self) (* dgb: "23-NOV-82 01:56")
(* All objects of this class will be temp objects)
(← self NewTemp])
(Template.Copy
[LAMBDA (self class alist) (* mjs: "17-FEB-83 12:29")
(* * Copies a template class %. alist pairs template subclasses found in the IVs with their new specializations.
Most of the work is done by TemplateCopy)
(PROG ((newClass (←Super
class Copy))
oldValue tcValue)
(SETQ alist (NCONC1 alist (CONS class newClass)))
[MapIVs! instance (FUNCTION (LAMBDA (self varName propName)
(PROG (tcValue oldValue)
(COND
([NEQ (SETQ oldValue (GetValueOnly self varName propName))
(SETQ tcValue (TemplateCopy oldValue alist (QUOTE Copy]
(PutValueOnly self varName tcValue propName]
(RETURN newClass])
(Template.New
[LAMBDA (class alist) (* dgb: "24-NOV-82 15:21")
(* * Fills in the new instance substituting for template instances. alist pairs template subclasses found in the
IVs with their instantiations. Most of the work is done by TemplateCopy)
(PROG ((instance (←Super
class New))
oldValue tcValue)
(SETQ alist (NCONC1 alist (CONS class instance)))
[MapIVs! instance (FUNCTION (LAMBDA (self varName propName)
(PROG (tcValue oldValue)
(COND
((NEQ (SETQ oldValue (GetValueOnly self varName propName))
(SETQ tcValue (TemplateCopy oldValue alist)))
(PutValueOnly self varName tcValue propName]
(RETURN instance])
(Template.Specialize
[LAMBDA (class alist) (* dgb: "19-APR-83 15:29")
(* * Specializes a template class %. alist pairs template subclasses found in the IVs with their new
specializations. Most of the work is done by TemplateCopy)
(PROG [oldValue tcValue (newClass (←Super
class Specialize (AND alist (LITATOM alist)
(PROG1 alist (SETQ alist NIL]
(SETQ alist (NCONC1 alist (CONS class newClass)))
[MapIVs! class (FUNCTION (LAMBDA (self varName propName)
(PROG (tcValue oldValue)
(COND
([NEQ (SETQ oldValue (GetValueOnly self varName propName))
(SETQ tcValue (TemplateCopy oldValue alist (QUOTE Specialize]
(OR (← newClass HasIV varName)
(AddCIV newClass varName))
(PutClassIV newClass varName tcValue propName]
(RETURN newClass])
)
(* * Classes and functions for perspectives -- A group of objects can be associated together as
different perspectives of the same thing. This is implemented by having them all point to a
Node instance which has all the associated objects on a property list (of the variable (QUOTE
perspectives)) %. Each object has a perspective name (unique in the associated group, but
perhaps used in many groups) that is used to identify it by the other objects. The user does
not need to see the perspectiveNode, but can simply get from one object to another by means of
the message GetPersp with argument perspName.)
(RPAQQ PERSPECTIVECLASSES (Node Perspective))
(DEFCLASSES Node Perspective)
[DEFCLASS Node
(MetaClass Class Edited: (* dgb: "18-MAR-83 14:44")
doc
(* * Perspective nodes associate together a group of objects, allowing them to find each other via their
perspective names.)
)
(Supers IndirectObj)
(ClassVariables)
(InstanceVariables (perspectives NIL doc (* Associated objects are stored on this property list
under their perspective names.)))
(Methods (AddPersp Node.AddPersp args (viewName view dontCauseError)
doc (* Adds a perspective to a node on the IV perspectives
as value of property viewName.)
)
(Copy Node.Copy args NIL doc (* dgb: "17-NOV-82 23:27"))
(DeletePersp Node.DeletePersp args (viewName view dontCauseError)
doc
(* Deletes a perspective of a node on the IV perspectives on property viewName. Checks for consistency.
Removes from IV pespectiveNode of view, self as value, and viewName from property myViewName.
If view is not that perspective, then causes an error, unless surpressed.)
)
(Destroy Node.Destroy args NIL doc (* Destroy the node after detaching all its
perspectives))
(Destroy! Node.Destroy! args NIL doc (* Destroy the node and all its perspectives)
)
(FindIVHolder Node.FindIVHolder args (ivName)
doc (* Find a perspective which has iv named)
)
(FindReceiver Node.FindReceiver args (selector)
doc (* Find a perpective that understands selector)
)
(GetPersp Node.GetPersp args (perspName causeError)
doc (* Returns the perspective of this node with viewName
perspName)
)
(ListViewNames Node.ListViewNames args NIL doc
(* List all the viewNames of perspectives on this node)
)
(ListViews Node.ListViews args NIL doc (* List all the perspectives on this node)
))]
[DEFCLASS Perspective
(MetaClass AbstractClass Edited: (* dgb: "18-MAR-83 14:45")
doc
(* This is a mixin which provides the perpsectiveNode instanceVariable for an object. This IV is used to point to
an object of type Node which itself points to all the perspectives of this object.)
)
(Supers IndirectObj)
(ClassVariables)
(InstanceVariables (perspectiveNode NIL doc (* Indirect pointer to all perspectives of this object.
Created when first needed.)))
(Methods (AddPersp Perspective.AddPersp args (viewName view)
doc (* Adds a perspective to my node.)
)
(Copy Perspective.Copy args NIL doc (* dgb: "17-NOV-82 23:44"))
(DeleteMeAsPersp Perspective.DeleteMeAsPersp args NIL doc
(* Delete this object as a perspective of node)
)
(DeletePersp Perspective.DeletePersp args (viewName view dontCauseError)
doc (* Deletes a perspective from node)
)
(Destroy Perspective.Destroy args NIL doc (* Destroy self but leave other perspectives on Node)
)
(Destroy! Perspective.Destroy! args NIL doc (* Destroy self, Node and all other perspectives on
Node))
(FindIVHolder Perspective.FindIVHolder args (ivName)
doc (* Find perspective having IV with name ivName)
)
(FindReceiver Perspective.FindReceiver args (selector)
doc (* Find a receiver for a message which is not understood
by me)
)
(GetPersp Perspective.GetPersp args (perspName causeError)
doc (* Returns the perspective of this instance with
viewName perspName)
)
(ListViews Perspective.ListViews args NIL doc (* List all the views of this perspective, including
self))
(MakePersp Perspective.MakePersp args (viewName nodeType)
doc
(* If no current perspectiveNode exists, then a node will be created of class nodeType (or Node if nodeType=NIL).
nodeType should be a subclass of Node. self will be made the value of the property viewName on IV perspectivesof
node. If self already has a node, then it is used.)
))]
(RPAQQ PERSPECTIVEFNS (Node.AddPersp Node.DeletePersp Node.Destroy Node.Destroy! Node.ListViewNames
Perspective.AddPersp Perspective.DeleteMeAsPersp
Perspective.DeletePersp Perspective.Destroy Perspective.Destroy!
Perspective.GetPersp Perspective.MakePersp))
(DEFINEQ
(Node.AddPersp
[LAMBDA (self viewName view dontCauseError) (* dgb: "27-OCT-82 08:47")
(* Adds a perspective to a node on the IV perspectives
as value of property viewName.)
(* Checks for consistency with old views if any.
On IV pespectiveNode of view, stores self as value, and
viewName as property myViewName.)
(PROG (oldViewName oldView (oldNode (%@ view perspectiveNode)))
[COND
(oldNode (SETQ oldViewName (%@ view perspectiveNode myViewName))
(COND
((NEQ oldNode self)
(OR dontCauseError (HELPCHECK view " already has node " oldNode
" as a Node.
Type OK to replace oldNode with new node.")))
((EQ oldViewName viewName) (* Already done, just return)
(RETURN view))
(oldViewName (OR dontCauseError (HELPCHECK view " was stored under viewName "
oldViewName
" previously.
Type OK to change to new view name"))
(← oldNode DeletePersp oldViewName view]
(COND
((AND (NEQ NotSetValue (SETQ oldView (GetValue self (QUOTE perspectives)
viewName)))
oldView
(NEQ oldView view))
(OR dontCauseError (HELPCHECK oldView " is currently the " viewName
" perspective of self. Type OK to replace it."))
(← self DeletePersp viewName oldView))) (* All error checks have been passed)
(←%@
view perspectiveNode self)
(←%@
view perspectiveNode myViewName viewName)
(RETURN (PutValue self (QUOTE perspectives)
view viewName])
(Node.DeletePersp
[LAMBDA (self viewName view dontCauseError) (* dgb: " 3-SEP-82 00:15")
(* Deletes a perspective of a node on the IV perspectives on property viewName. Checks for consistency.
Removes from IV pespectiveNode of view, self as value, and viewName from property myViewName.
If view is not that perspective, then causes an error, unless surpressed.)
(PROG ((oldView (GetValue self (QUOTE perspectives)
viewName)))
(COND
((EQ NotSetValue oldView)
(OR dontCauseError (HELPCHECK viewName " is not a perspective of " self
"
Type OK to continue without changing node."))
(RETURN NIL))
((NULL view)
(SETQ view oldView))
((NEQ view oldView)
(OR dontCauseError (HELPCHECK view " is not the " viewName
" of self.
Type OK to continue without changing node."))
(RETURN NIL)))
(←%@
view perspectiveNode NIL)
(←%@
view perspectiveNode viewName NIL)
(RETURN (PutValue self (QUOTE perspectives)
NIL viewName])
(Node.Destroy
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* Destroy the node after detaching all its
perspectives)
(for viewName in (← self ListViewNames) do (← self DeletePersp viewName) finally (←Super
self Destroy!])
(Node.Destroy!
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* Destroy the node and all its perspectives)
(for viewName in (← self ListViewNames) do (← (GetValue self (QUOTE perspectives)
viewName)
Destroy)
finally (←Super
self Destroy!])
(Node.ListViewNames
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* List all the viewNames of perspectives on this node)
(for viewName in (← self List (QUOTE IVPROPS)
(QUOTE perspectives))
when (type? instance (GetValue self (QUOTE perspectives)
viewName))
collect viewName])
(Perspective.AddPersp
[LAMBDA (self viewName view) (* dgb: " 3-SEP-82 00:15")
(* Adds a perspective to my node.)
(PROG (myNode)
LP (SETQ myNode (%@ perspectiveNode))
(COND
((NULL myNode)
(HELPCHECK self
" has no perspectiveNode.
To go on, make self a perspective using
(← self MakePersp viewName nodeType). Then type OK.")
(GO LP)))
(RETURN (← myNode AddPersp viewName view])
(Perspective.DeleteMeAsPersp
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* Delete this object as a perspective of node)
(← self DeletePersp (%@ self perspectiveNode myViewName)
self])
(Perspective.DeletePersp
[LAMBDA (self viewName view dontCauseError) (* dgb: " 3-SEP-82 00:15")
(* Deletes a perspective from node)
(PROG ((myNode (%@ perspectiveNode)))
[COND
((NULL myNode)
(RETURN (OR dontCauseError (HELPCHECK self " has no perspectiveNode. Type OK to go on"]
(← myNode DeletePersp viewName view dontCauseError])
(Perspective.Destroy
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* Destroy self but leave other perspectives on Node)
(PROG ((myNode (%@ perspectiveNode)))
(COND
(myNode (* Delete linkage to node)
(← self DeleteMeAsPersp)))
(←Super
self Destroy])
(Perspective.Destroy!
[LAMBDA (self) (* dgb: " 3-SEP-82 00:15")
(* Destroy self, Node and all other perspectives on
Node)
(PROG ((myNode (%@ perspectiveNode)))
(COND
(myNode (* If I have a node, then let it control destruction)
(← myNode Destroy!))
(T (* else this is already isolated, just destroy)
(←Super
self Destroy])
(Perspective.GetPersp
[LAMBDA (self perspName causeError) (* mjs: "29-SEP-82 14:47")
(* Returns the perspective of this instance with
viewName perspName)
(PROG (persp (node (%@ perspectiveNode)))
(RETURN (COND
(node (OR (AND (NEQ (SETQ persp (GetValue node (QUOTE perspectives)
perspName)
NotSetValue))
persp)
(AND causeError (HELPCHECK self " has no perspective " perspName)
NIL)))
(causeError (HELPCHECK self " has no perpectives.")
NIL])
(Perspective.MakePersp
[LAMBDA (self viewName nodeType) (* dgb: "17-NOV-82 23:35")
(* If no current perspectiveNode exists, then a node will be created of class nodeType (or Node if nodeType=NIL).
nodeType should be a subclass of Node. self will be made the value of the property viewName on IV perspectivesof
node. If self already has a node, then it is used.)
(← (OR (%@ perspectiveNode)
(← (COND
(nodeType (GetClassRec nodeType))
(T (%$ Node)))
New))
AddPersp
(OR viewName (ClassName self))
self])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (8075 20241 (GlobalName 8085 . 8777) (IndirectObj.ForwardMessage 8779 . 9323) (
IndirectObj.IVMissing 9325 . 9950) (IndirectObj.MessageNotUnderstood 9952 . 10536) (
ListMetaClass.DestroyInstance 10538 . 10938) (ListMetaClass.New 10940 . 11412) (NamedObject.Copy 11414
. 11692) (NamedObject.PrintOn 11694 . 12020) (NamedObject.SetName 12022 . 12274) (Perspective.Copy
12276 . 12769) (Perspective.FindIVHolder 12771 . 13062) (Perspective.FindReceiver 13064 . 13389) (
Perspective.ListViews 13391 . 13697) (RememberName 13699 . 14311) (StrucMeta.New 14313 . 14968) (
VarLength.Length 14970 . 15262) (Node.Copy 15264 . 15863) (Node.FindIVHolder 15865 . 16176) (
Node.FindReceiver 16178 . 16609) (Node.GetPersp 16611 . 17108) (Node.ListViews 17110 . 17550) (
TempClass.New 17552 . 17800) (Template.Copy 17802 . 18555) (Template.New 18557 . 19330) (
Template.Specialize 19332 . 20239)) (26005 33692 (Node.AddPersp 26015 . 27749) (Node.DeletePersp 27751
. 28852) (Node.Destroy 28854 . 29245) (Node.Destroy! 29247 . 29650) (Node.ListViewNames 29652 . 30094
) (Perspective.AddPersp 30096 . 30628) (Perspective.DeleteMeAsPersp 30630 . 30942) (
Perspective.DeletePersp 30944 . 31402) (Perspective.Destroy 31404 . 31853) (Perspective.Destroy! 31855
. 32449) (Perspective.GetPersp 32451 . 33079) (Perspective.MakePersp 33081 . 33690)))))
STOP