(FILECREATED "21-Apr-84 20:48:13" {INDIGO}<LOOPS>SOURCES>LOOPSMIXIN.;15 35138
changes to: (CLASSES TextItem)
previous date: "29-Feb-84 09:06:47" {INDIGO}<LOOPS>SOURCES>LOOPSMIXIN.;14)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT LOOPSMIXINCOMS)
(RPAQQ LOOPSMIXINCOMS [(* Copyright (c)
1982 by Xerox Corporation)
(* USEFUL MIXINS)
(CLASSES * KERNELMIXINS)
(FNS * KERNELMIXINFNS)
(METHODS IndirectObj.ForwardMessage IndirectObj.IVMissing IndirectObj.MessageNotUnderstood
ListMetaClass.DestroyInstance ListMetaClass.New NamedObject.Copy NamedObject.PrintOn
NamedObject.SetName NamedObject.UnSetName StrucMeta.New TempClass.New Template.Copy
Template.New Template.Specialize VarLength.Length)
(* * Classes and methods 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)
(METHODS Node.AddPersp Node.Copy Node.DeletePersp Node.Destroy Node.Destroy!
Node.FindIVHolder Node.FindReceiver Node.GetPersp Node.ListViewNames Node.ListViews
Perspective.AddPersp Perspective.Copy Perspective.DeleteMeAsPersp
Perspective.DeletePersp Perspective.Destroy Perspective.Destroy!
Perspective.FindIVHolder Perspective.FindReceiver Perspective.GetPersp
Perspective.ListViews Perspective.MakePersp)
(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 TextItem VarLength))
(DEFCLASSES DatedObject GlobalNamedObject IndirectObj ListMetaClass NamedObject StrucMeta TempClass
Template TextItem 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)
(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)))]
[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)
(InstanceVariables (name #(NIL NIL GlobalName)))]
[DEFCLASS IndirectObj
(MetaClass Class Edited: (* dgb: "18-MAR-83 14:25"))
(Supers Object)]
[DEFCLASS ListMetaClass
(MetaClass MetaClass Edited: (* dgb: "23-NOV-82 02:21"))
(Supers Class)]
[DEFCLASS NamedObject
(MetaClass Class doc
(* * Mixin to give instances of this class unique names, stored in the name instance variable.
Note that Object.SetName 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: "18-OCT-83 15:10")
)
(Supers Object)
(InstanceVariables (name #(NIL NIL RememberName) doc (* name is stored in nameTable and as IV)
))]
[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)]
[DEFCLASS TempClass
(MetaClass MetaClass Edited: (* dgb: "23-NOV-82 02:02"))
(Supers Class)]
[DEFCLASS Template
(MetaClass MetaClass doc
(* * Special Class used for composite objects.)
Edited: (* dgb: "12-JAN-83 15:17")
)
(Supers Class)]
[DEFCLASS TextItem
(MetaClass Class doc (* Simplest structured text object)
Edited: (* dgb: "12-OCT-82 23:09")
)
(Supers NamedObject)
(InstanceVariables (subs NIL doc (* list of other elemetns which are subparts of this
one))
(text "" doc (* local text for this item)))]
[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)
(InstanceVariables (indexedVars NIL doc (* place where indexed variables are stored for
VarLength classes.)))]
(RPAQQ KERNELMIXINFNS (GlobalName RememberName TemplateCopy))
(DEFINEQ
(GlobalName
[LAMBDA (self varName name prop av type) (* dgb: "26-DEC-83 22:26")
(* * 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)
(RESETLST (RESETSAVE CurrentNameTable NIL)
(RESETSAVE CurrentUIDTable NIL)
(RememberName self varName name prop av type])
(RememberName
[LAMBDA (self varName name prop av type) (* dgb: "24-Feb-84 10:44")
(* * 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))
(NameEntity self name)
(MARKASCHANGED name (SELECTQ (TYPENAME self)
(class (QUOTE CLASSES))
(QUOTE INSTANCES)))
(COND
((EQ oldName name)
(RETURN name))
(oldName (DeleteObjectName self oldName)))
(PutLocalState av name self varName prop type)
(RETURN name))
name])
(TemplateCopy
[LAMBDA (oldValue alist specSelector) (* dgb: "28-APR-83 18:40")
(* Subroutine of NewTemplateIVs. Copies a value from the Instance Variable Description, making substitutions for
classes appearing in alist. If a class is encountered whose metaClass is Template, then creates new instantiation
recursively using New message.)
(SELECTQ (TYPENAME oldValue)
[activeValue (* Here if oldValue is active value.)
(PROG (newloc newgf newpf (ls (fetch localState of oldValue))
(gf (fetch getFn of oldValue))
(pf (fetch putFn of oldValue)))
(SETQ newloc (TemplateCopy ls alist specSelector))
(SETQ newgf (TemplateCopy gf alist specSelector))
(SETQ newpf (TemplateCopy pf alist specSelector))
(RETURN (COND
((AND (EQ ls newloc)
(EQ pf newpf)
(EQ gf newgf))
(* If no copying done in elements, don't copy now)
oldValue)
(T (create activeValue
localState ← newloc
getFn ← newgf
putFn ← newpf]
[LISTP (* Here if oldValue is a list.
Invoke TemplateCopy recursively on the elements of the
list. specSelector)
(COND
((EQ (CAR oldValue)
(QUOTE *))
oldValue)
(T (PROG ((A (TemplateCopy (CAR oldValue)
alist specSelector))
(D (TemplateCopy (CDR oldValue)
alist specSelector)))
(RETURN (COND
((AND (EQ A (CAR oldValue))
(EQ D (CDR oldValue)))
(* If no copying done in elements, don't copy now)
oldValue)
(T (CONS A D]
(class (COND
[(← oldValue InstOf!(QUOTE Template))
(* If class is a template, then return the substitution.
If class is not on alist, then first instantiate it
recursively.)
(OR (CDR (FASSOC oldValue alist))
(COND
(specSelector (DoMethod oldValue specSelector NIL alist))
(T (← oldValue New alist]
(T (* Non-template classes treated as constants.)
oldValue)))
oldValue])
)
[METH IndirectObj ForwardMessage (dummyArg1 dummyArg2 dummyArg3 dummyArg4 dummyArg5)
(* will forward messages with up to five arguments (a design choice)
to object in DefaultObject, using selector in ForwardedSelector)]
[METH IndirectObj IVMissing (ivName)
(* Find a perspective which has the IV requested, and return its object description)]
[METH IndirectObj MessageNotUnderstood (obj selector)
(* Set up message forwarding)]
[METH ListMetaClass DestroyInstance (class object)
(* Remove saved object from list and then destroy)]
[METH ListMetaClass New (class)
NIL]
[METH NamedObject Copy (name)
(* Copy the contents and then name the object)
(method NamedObject.Copy caveat (* Copying a named object causes the previous one to become
unnamed))]
[METH NamedObject PrintOn (file)
(* print "#&(ClassName name)")]
[METH NamedObject SetName (name)
(* Set the name IV in this object.)]
[METH NamedObject UnSetName (name)
(* P ut NotSetValue in name)]
[METH StrucMeta New NIL
(* 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)]
[METH TempClass New NIL
(* All objects of this class will be temp objects)]
[METH Template Copy (class alist)
(* * Specilaizes a template class %. alist pairs template subclasses found in the IVs with
their new specializations. Most of the work is done by TemplateCopy)]
[METH Template New (alist)
(* * 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)]
[METH Template Specialize (alist)
(* * Specializes a template class %. alist pairs template subclasses found in the IVs with
their new specializations. Most of the work is done by TemplateCopy)]
[METH VarLength Length NIL
(* Returns number of indexed variables allocated in this instance.)]
(DEFINEQ
(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) (* dgb: "18-OCT-83 14:28")
(* Copy the contents and then name the object)
(PROG ((obj (←Super
self Copy)))
(← obj SetName name)
(RETURN obj])
(NamedObject.PrintOn
[LAMBDA (self file) (* dgb: " 3-OCT-83 14:52")
(* print "#&(ClassName name)")
(COND
((@ name)
(PRIN1 "#&" file)
(PRIN2 (LIST (ClassName self)
(@ name))
file))
(T (←Super
self PrintOn file)))
self])
(NamedObject.SetName
[LAMBDA (self name) (* dgb: " 2-MAR-82 17:42")
(* Set the name IV in this object)
(←@
name name)
self])
(NamedObject.UnSetName
[LAMBDA (self name) (* dgb: " 6-DEC-83 16:55")
(* P ut NotSetValue in name)
(←Super
self UnSetName name)
(PutValueOnly self (QUOTE name)
NotSetValue)
self])
(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])
(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])
(VarLength.Length
[LAMBDA (self) (* mjs: "29-JUN-82 14:50")
(* Returns number of indexed variables allocated in this
instance.)
(LENGTH (%@ indexedVars])
)
(* * Classes and methods 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)
(InstanceVariables (perspectives NIL doc (* Associated objects are stored on this property list
under their perspective names.)))]
[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)
(InstanceVariables (perspectiveNode NIL doc (* Indirect pointer to all perspectives of this object.
Created when first needed.)))]
[METH Node AddPersp (viewName view dontCauseError)
(* Adds a perspective to a node on the IV perspectives as value of property viewName.)]
[METH Node Copy NIL
(* dgb: "17-NOV-82 23:27")]
[METH Node DeletePersp (viewName view dontCauseError)
(* 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.)]
[METH Node Destroy NIL
(* Destroy the node after detaching all its perspectives)]
[METH Node Destroy! NIL
(* Destroy the node and all its perspectives)]
[METH Node FindIVHolder (ivName)
(* Find a perspective which has iv named)]
[METH Node FindReceiver (selector)
(* Find a perpective that understands selector)]
[METH Node GetPersp (perspName causeError)
(* Returns the perspective of this node with viewName perspName)]
[METH Node ListViewNames NIL
(* List all the viewNames of perspectives on this node)]
[METH Node ListViews NIL
(* List all the perspectives on this node)]
[METH Perspective AddPersp (viewName view)
(* Adds a perspective to my node.)]
[METH Perspective Copy NIL
(* dgb: "17-NOV-82 23:44")]
[METH Perspective DeleteMeAsPersp NIL
(* Delete this object as a perspective of node)]
[METH Perspective DeletePersp (viewName view dontCauseError)
(* Deletes a perspective from node)]
[METH Perspective Destroy NIL
(* Destroy self but leave other perspectives on Node)]
[METH Perspective Destroy! NIL
(* Destroy self, Node and all other perspectives on Node)]
[METH Perspective FindIVHolder (ivName)
(* Find perspective having IV with name ivName)]
[METH Perspective FindReceiver (selector)
(* Find a receiver for a message which is not understood by me)]
[METH Perspective GetPersp (perspName causeError)
(* Returns the perspective of this instance with viewName perspName)]
[METH Perspective ListViews NIL
(* List all the views of this perspective, including self)]
[METH Perspective MakePersp (viewName nodeType)
(* 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.)]
(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.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.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.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.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])
(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])
(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.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.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.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.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.ListViews
[LAMBDA (self) (* dgb: "18-MAR-83 15:19")
(* List all the views of this perspective, including
self)
(← (%@ perspectiveNode)
ListViews])
(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 )
)
(PUTPROPS LOOPSMIXIN COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5808 9467 (GlobalName 5818 . 6276) (RememberName 6278 . 6994) (TemplateCopy 6996 . 9465
)) (11624 19178 (IndirectObj.ForwardMessage 11634 . 12178) (IndirectObj.IVMissing 12180 . 12805) (
IndirectObj.MessageNotUnderstood 12807 . 13391) (ListMetaClass.DestroyInstance 13393 . 13793) (
ListMetaClass.New 13795 . 14267) (NamedObject.Copy 14269 . 14590) (NamedObject.PrintOn 14592 . 14965)
(NamedObject.SetName 14967 . 15219) (NamedObject.UnSetName 15221 . 15536) (StrucMeta.New 15538 . 16193
) (TempClass.New 16195 . 16443) (Template.Copy 16445 . 17198) (Template.New 17200 . 17973) (
Template.Specialize 17975 . 18882) (VarLength.Length 18884 . 19176)) (23522 34920 (Node.AddPersp 23532
. 25266) (Node.Copy 25268 . 25867) (Node.DeletePersp 25869 . 26970) (Node.Destroy 26972 . 27363) (
Node.Destroy! 27365 . 27768) (Node.FindIVHolder 27770 . 28081) (Node.FindReceiver 28083 . 28514) (
Node.GetPersp 28516 . 29013) (Node.ListViewNames 29015 . 29457) (Node.ListViews 29459 . 29899) (
Perspective.AddPersp 29901 . 30433) (Perspective.Copy 30435 . 30928) (Perspective.DeleteMeAsPersp
30930 . 31242) (Perspective.DeletePersp 31244 . 31702) (Perspective.Destroy 31704 . 32153) (
Perspective.Destroy! 32155 . 32749) (Perspective.FindIVHolder 32751 . 33042) (Perspective.FindReceiver
33044 . 33369) (Perspective.GetPersp 33371 . 33999) (Perspective.ListViews 34001 . 34307) (
Perspective.MakePersp 34309 . 34918)))))
STOP