From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:44:33 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>LensAbsentee</name> <environment>Lens</environment> <super></super> <private>false</private> none <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensAbsentee
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensAbsentee is the root of an independent class hierarchy that is completely separate from that rooted at Object. This hiearrchy includes the various proxy and surrogate classes that serve the ObjectLens. LensAbsentee's primary purpose is to serve as a superclass for these 'stub' objects, which use doesNotUnderstand: to trap almost all messages. It provides only those messages that cannot be overridden or are necessary to prevent the user interface from blowing up if an instance must be handled while debugging.
</comment> <class> <name>LensQuerySurrogate</name> <environment>Lens</environment> <super>Lens.LensAbsentee</super> <private>false</private> none type <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensQuerySurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensQuerySurrogate is the root of a hierarchy of classes used to translate blocks involved in querying, specifically selection blocks (passed in select: and detect: messages), result blocks (passed in answer: messages), and ordering blocks (passed in orderBy: messages). All of these kinds of blocks are translated in a uniform manner, by being evaluated on an array of object surrogates, and are expected to answer some surrogate that is the root of a network of surrogates called the block's "parse graph" and which represents its semantics in a database-independent form. LensQuerySurrogate is a subclass of LensAbsentee, allowing use of doesNotUnderstand: to trap evaluation of expressions in blocks and to generate parts of the parse graph. LensQuerySurrogate also provides handling of standard arithmetic, comparison, boolean, and nil-checking messages, which also generate or manipulate the parse graph. This provides the basic mechanism for symbolic evaluation of the block bodies. LensQuerySurrogate has the following immediate subclasses: LensExpressionSurrogate - represents general expressions LensChildrenSetSurrogate - represents children sets, i.e., the value of children variables Many methods defined on surrogates take arguments named 'valueOrSurrogate', indicating that the argument may either be an ordinary "literal" Smalltalk object (such as a temporary or persistent employee, a string, or a number), or some kind of query surrogate. Query surrogates employ a set of "internal" messages for intercommunication among surrogates, not intended to be used by application-level objects. At the same time, query surrogates are carefully designed to not understand messages that are typical of application-level objects. These two conditions are met by capitalizing the internal messages' selectors. Query surrogates generally hold onto metadata (such as types and variables) as a way to specify the set of actual objects they represent, and to type-check the query operation block expressions during symbolic block evaluation. Type checking failures raise ObjectLens exceptions, and attempt to clearly identify the offending expression in the block being evaluated. Instance Variables: type <LensType> the type of object represented by the querySurrogate Class Variables: BooleanType <LensDataType> DateType <LensDataType> FloatType <LensDataType> IntegerType <LensDataType> StringType <LensDataType> cached basis types, used as operation result types
</comment> <class> <name>LensExpressionSurrogate</name> <environment>Lens</environment> <super>Lens.LensQuerySurrogate</super> <private>false</private> none isAscending <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensExpressionSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The abstract class LensExpressionSurrogate provides behavior common to expressions within queries, specifically variables, operations, and navigation paths. In particular, it understands standard arithmetic, comparison, boolean, and nil-checking messages, constructing operationSurrogates in response. LensExpressionSurrogate has the following immediate subclasses: LensOperationSurrogate - represents computations and comparisons among values LensValueSurrogate - represents objects, values of object attributes, and subquery results LensCommandVariable - represents variable bindings occuring in generated DML Protocol 'comparing' includes methods for comparing surrogates with other surrogates or literals, and generally answer operation surrogates representing the comparison. Similarly, protocol 'computing' includes methods for performing arithmetic between surrogates and other surrogates or literals,also answering operation surrogates.
</comment> <class> <name>LensCommandVariable</name> <environment>Lens</environment> <super>Lens.LensExpressionSurrogate</super> <private>false</private> none name variable <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensCommandVariable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensCommandSurrogate represent variable bindings in generated DML, whose values are application-level objects (not surrogates). Instance Variables: name <String> the variable name in the DML variable <LensStructureVariable> a variable describing the variable's legal values
</comment> <class> <name>LensLinkedDictionary</name> <environment>Lens</environment> <super>Core.Dictionary</super> <private>false</private> objects bucketTally hashTable <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensLinkedDictionary
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A LensLinkedDictionary is a Dictionary which uses hash buckets and linked lists rather than a linear inline hash table. It is optimized for the role of mapping key values to the LensGlobalDescriptor of the object which represents the row with the key values. This means that equality comparisons are not as rigorous as in Dictionary (notably species doesn't get checked as it is assumed to be the same). Instance Variables: bucketTally <Integer> A count of the number of buckets with at least one entry. hashTable <Array of: (LensLinkedAssociation | or nil)> The hash table containing chains of LensLinkedAssociation or nothing.
</comment> <class> <name>LensProtectedLinkedDictionary</name> <environment>Lens</environment> <super>Lens.LensLinkedDictionary</super> <private>false</private> objects accessLock <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensProtectedLinkedDictionary
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A LensProtectedLinkedDictionary is a LensLinkedDictionary which uses a Semaphore to control concurrent mutation of the hash table and chains. Instance Variables: accessLock <Semaphore> Used to enforce critical sections to control mutation access.
</comment> <class> <name>LensException</name> <environment>Lens</environment> <super>Core.Error</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensException
LensException is super class of lens exceptions.
</comment> <class> <name>LensResumableException</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensResumableException
LensResumableException is super class of lens resumable exceptions.
</comment> <class> <name>DoNotProceed</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DoNotProceed
DoNotProceed is used to tell the user abort of current operations.
</comment> <class> <name>LensTranscoder</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none block <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensTranscoder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This class is the implementation class for Lens decoders and encoders. It holds a block, and provides more informative messages for invoking the block than #value:value: or #value:value:value:. Instance Variables: block <BlockClosure> the block that implements the transcoder.
</comment> <class> <name>DataDefinitionError</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DataDefinitionError
DataDefinitionError is used to indicate that a data definition error occured.
</comment> <class> <name>LensColumnSizeConstraint</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none length encodingName <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <class> <name>DataDefinitionWarning</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DataDefinitionWarning
DataDefinitionWarning is used to indicate that a data definition warning occured.
</comment> <class> <name>UnhandledCircularReference</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.UnhandledCircularReference
UnhandledCircularReference is raised when trying to insert objects with circular references that include notNil references.
</comment> <class> <name>ComposedBlock</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none blocks isAnd <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.ComposedBlock
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. ComposedBlock represents a multi-term logical expression, to be used in the 'WHERE' part of a QueryOperation. Either a simple conjunction or a simple disjunction, with an arbitrary number of terms, each of which is implemented as a BlockContext or a ComposedBlock by itself. blocks <OrderedCollection of BlockClosure|ComposedBlock> one per term in the expression; the number of arguments for each block matches in arity, and is the arity of the composed block. The arity should match the arity required in the query operation. isAnd <Boolean> if true, the expression is a conjunction, otherwise a disjunction
</comment> <class> <name>ObjectNotUniquelyIdentified</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.ObjectNotUniquelyIdentified
ObjectNotUniquelyIdentified is used to indicate that the second object with same identity has been detected.
</comment> <class> <name>VariableUndefined</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.VariableUndefined
VariableUndefined is used to indicate that a variable is undefined.
</comment> <class> <name>ErrorWhilePosting</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.ErrorWhilePosting
ErrorWhilePosting is used to complain about errors while posting.
</comment> <class> <name>LensMetadata</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensMetadata
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensMetadata provides support for encoding ObjectLens data definition as literal arrays for storage in a method on a class. Subclasses control which instance variables and how they are encoded by defining the encodedAspects and valueEncoder class messages. For more details about what is expected from these messages refer to the literalArrayEncoding method comment.
</comment> <class> <name>LensTableKey</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none table columns keyType <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensTableKey
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensTableKey defines the structure of a key for a table. Instance Variables: table <LensDatabaseTable> A reference to the table for which this is a key. keyType <#primary | #unique> Indicates whether this key is the primary key, or just unique. columns <SequenceableCollection of: LensTableColumn | nil> The columns which comprise the key, in order.
</comment> <class> <name>DatabaseTypeMapping</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none fieldType columnType isLongType maxSize <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DatabaseTypeMapping
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of DatabaseTypeMapping represent datatype mappings between object attributes seen by applications, and the data types of corresponding database columns. Encoding of data values follows the following path: [attribute value -> attribute field -> database column], while decoding follows the inverse path. Instance Variables: fieldType <LensType> the type of values as encoded prior to being sent to the database columnType <String> the database-specific column data type isLongType <Boolean> true if the type is considered "long" (e.g. "blob" types are long)
</comment> <class> <name>LensScope</name> <environment>Lens</environment> <super>Kernel.LocalScope</super> <private>false</private> none <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensScope
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>LensContainer</name> <environment>Lens</environment> <super>Core.Collection</super> <private>false</private> none lensSession transporter type <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensContainer
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensContainers are used to access the persistent objects residing in database tables. LensContainers are a kind of collection, so may be accessed and manipulated using a superset of standard Collection protocol, thereby allowing the Smalltalk programmer to use databases without having to know DBMS languages. Every container is associated with a session that provides an access path to the database table(s) underlying the container. LensContainer is an abstract class, with two concrete subclasses: LensBaseContainer - contains persistent objects representing rows in individual tables LensCompositeContainer - contains tuples of persistent objects drawn from two or more base containers, used to effectuate joins across tables, and/or to efficiently retrieve complex objects (smalll networks of related objects fetched as a unit) LensContainer protocol extends standard Collection protocol to provide the full power of SQL querying in a Smalltalk context. Specifically, the following messages are added: answer: <BlockClosure> - specifies the shape of the result objects distinct - suppresses duplicate answers groupBy: <BlockClosure> - specifies the grouping of result objects locking - specifies that rows underlying answer objects are to be locked match: <Object> - specifies selection via matching of the given template object orderBy: <BlockClosure> - specifies the ordering of result objects select: <BlockClosure> answer: <BlockClosure> - combines selection and answer specification unique - verifies that exactly one result object is to be returned Instance Variables: lensSession <LensSession> the session defining the database connection and transaction transporter <LensBasicTransporter> INTERNAL an object that performs the actual transport and translation between the application and the database type <LensStructureType> defines the type of objects held in the container Class Variables: CannotQueryLocalVariableSignal <ExternalDatabaseSignal> signal raised when attempting to query through a local attribute CannotUpdateSignal <ExternalDatabaseSignal> signal raised when attempting to perform an illegal update IdentityConflictSignal <ExternalDatabaseSignal> signal raised to indicate attempting to add an object with the same identity (external ID) as an existing materialized object InvalidAggregateFunctionSignal <ExternalDatabaseSignal> signal indicating invoking an undefined aggregate function InvalidPredicateSignal <ExternalDatabaseSignal> signal indicating invoking a predicate in a selection block that directly references instance variables ObjectInAnotherLensContainerSignal <ExternalDatabaseSignal> signal indicating that an object is persistent in another container ObjectNotPersistentSignal <ExternalDatabaseSignal> signal indicating that an object isn't persistent ObjectNotUniquelyIdentifiedSignal <ExternalDatabaseSignal> signal indicating that more than one object has the same externalId QueryErrorSignal <ExternalDatabaseSignal> signal indicating the occurance of a query error Implementation Details: LensContainers use transporters to translate the high-level container requests into database commands, and to submit the commands and get results. The class of the transporter depends on the kind of database being accessed, allowing containers to remain database-independent. See comments on LensBasicTransporter for more details. When asked to perform a query (such as when asked to select:), containers create an operation accessor, and pass the query request to the operation accessor. The request may result in immediately executing the query (such as a select:), yielding a result collection or stream. Alternatively, the request may simply specify a facet of the query but defer execution, such as attaching an order-by block; in this case, further messages may be sent to the operation to specify additional facets, or to request execution. See comments on class QueryOperation and QueryOperationAccessor for more details.
</comment> <class> <name>LensCompositeContainer</name> <environment>Lens</environment> <super>Lens.LensContainer</super> <private>false</private> none components <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensCompositeContainer
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensCompositeContainer provide access to multiple database tables within a single query. Composite continars may be used to join data across several tables, or to efficiently retrieve complex objects (smalll networks of related objects fetched as a unit). LensCompositeContainers are created by combining two or more base containers (called the composite's "components") using the comma operator. A composite container may be thought of as the Cartesian product of its components, containing all possible tuples (represented as ordinary arrays) of persistent objects drawn from the respective components. LensCompositeContainers are queried with the #select: protocol, where the argument - a block closure - takes an argument per component, in the order of components. Composite containers are considered read-only, i.e. refuse to perform #add: and #remove:. Instance Variables: components <OrderedCollection of: LensBaseContainer> the component base containers from which tuples are to be drawn when querying the composite container
</comment> <class> <name>InvalidPredicate</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.InvalidPredicate
InvalidPredicate is used to indicate that predicate directly references instance variable.
</comment> <class> <name>QueryOperation</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none name description containerNames command selectBlock selectBlockSource answerBlock answerBlockSource orderByBlock orderByBlockSource groupByBlock groupByBlockSource emptyResultBlock isUnique isDistinct isStreaming isLocking arguments argumentBindings resultType returnsFirstValue interface wasExtracted mode useStreaming alternateSQL postFlag <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryOperation
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of QueryOperation are static (database-connection-independent) speciifcations of querying (and possibly other) operations that may be performed. Query operations may be directly created programmatically or via the Query Editor. Query operations are also dynamically created and filled-in when containers are sent querying messages, by way of their intermediate query operation accessors. Each query operation caches a database command, which it submits to the External Database Interface when asked to execute. Query operations are invoked in the context of a specific session via query operation accessors. See class QueryOperationAccessor for more details. Instance Variables: name <Symbol> the selector by which the operation may be invoked via a DatabaseHandle instance description <String> a description of the query for presentation to the user (used like a class comment) containerNames <OrderedCollection of: (Symbol | UIDataReference)> the names of the container (same as the names of their types) that are to be queried. If they are references than the name of the container is the referred one command <DatabaseCommand | nil> the cached command for the query selectBlock <BlockClosure> the block specifying which objects to return answerBlock <BlockClosure | nil> if non-nil, defines the contents of result arrays (instead of the container's objects) orderByBlock <BlockClosure | nil> if non-nil, defines the order in which query results are to be returned grouprByBlock <BlockClosure | nil> if non-nil, defines how query results are to be grouped emptyResultBlock <BlockClosure | nil> if non-nil, is evaluated if the result is empty isUnique <Boolean> if true and the result contains more than one object, raises Container objectNotUniquelyIdentifiedSignal isDistinct <Boolean> if true, suppresses return of two or more objects with the same value isStreaming <Boolean> true => queries return streams false => queries return ordered collections isLocking <Boolean> if true, query results are locked on query arguments <OrderedCollection of: LensStructureVariable> the formal arguments of the query, to be bound to actual arguments when invoked argumentBindings <OrderedCollection> INTERNAL a collection of bindings used internally to generate the command resultType <LensType> the type of expected result objects returnsFirstValue <Boolean> true => queries will answer the first result object false => queries answer collections or streams (see isStreaming) interface <#(objectLens sqlAccess)> #objectLens => queries via Object Lens #sqlAccess => queries via External Database Interface wasExtracted <Boolean> true => the receiver was extracted from a stored procedure (in which case its various blocks are underfined) false => the receiver was created from block closures selectBlockSource, answerBlockSource, orderByBlockSource, groupByBlockSource <String> each one is the string that is the source for the respective block. These are used by the query editor to recover the source for each block so they can be edited postFlag <Boolean> set to false ONLY when doing a single row lock Class Variables: SelectAllBlocks <Array of: BlockClosure> an array of block closures that answer true, indexed by the number of args they take
</comment> <class> <name>LensQuery</name> <environment>Lens</environment> <super>Lens.QueryOperation</super> <private>false</private> none session <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensQuery
LensQueries are created by methods generated by the Query Editor. LensQuery provides the public interface to the ObjectLens functionality for database queries. This functionality includes evaluating a query and getting the results as either a collection or as a stream. This class also provides the method 'alternateSQL:' to be used to override the automatically generated SQL SELECT statement. The given SQL statement MUST match EXACTLY in the columns selected and their order with the generated SQL. To access the generated SQL, enable the tracing of database commands by sending the message #toggleTracing to ExternalDatabaseConnection. All SQL commands executed will then appear in the System Transcript. Instance variables: session <a LensSession> the session where the query is evaluated
</comment> <class> <name>RowForObjectNotFound</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.RowForObjectNotFound
RowForObjectNotFound is used to indicate that an object or proxy does not have a corresponding row in the database.
</comment> <class> <name>LensDatabaseTable</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDatabaseTable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensDatabaseTable represent tables living in database data dictionaries. In general, all data dictionary entities can only be read as persistent objects, not created, deleted, or modified. Instead, all modifications are achieved through the use of DDL statements. LensDatabaseTableColumn does not define any instance variables so that subclasses have full control over the ordering.
</comment> <class> <name>LensApplicationModel</name> <environment>Lens</environment> <super>UI.ApplicationModel</super> <private>false</private> none parent children session lensDataModels <imports></imports> <category>Lens-Applications-Framework</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensApplicationModel
LensApplicationModel is an abstract superclass for ApplicationModels intended for use in conjunction with the ObjectLens, for presenting information drawn from objects made persistent via the ObjectLens. Subclasses are either applications that may be used stand-alone, or DataForm components for use in building applications. At this level of abstraction, the concerns addressed are parent child relationships among an application and its DataForms, the maintenance of an ObjectLens session, and the distribution of events to do with windows, sessions, and transactions over this structure. Instance Variables parent <LensApplicationModel | nil> The application that embeds the child DataForm as an embedded component or satelite window, and which supplies the session to be used children <Set of: LensDataManager> DataForms embedded in this application as components, or linked to it as satelite windows session <LensSession> The session to be used for transacting changes to persistent objects Class Side Instance Variables lensDataModels <IdentityDictionary> A cache of compiled LensDataModels, maintained to avoid the overhead of recompilation
</comment> <class> <name>LensMainApplication</name> <environment>Lens</environment> <super>Lens.LensApplicationModel</super> <private>false</private> none <imports></imports> <category>Lens-Applications-Framework</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensMainApplication
LensMainApplication is an abstract superclass for 'top-level' application components. These components are responsible for maintaining and controlling an ObjectLens session for the benefit of one or more linked or embedded DataForms. This class includes necessary machinery for supporting automatically generated subclasses.
</comment> <class> <name>SerialNumberRequest</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.SerialNumberRequest
SerialNumberRequest is raised if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation and the LensSession does not have a serialNumberGeneratorBlock.
</comment> <class> <name>OverlappingVariablesValueConflict</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.OverlappingVariablesValueConflict
OverlappingVariablesValueConflict is used to indicate that overlapping variables have been set to conflicting values.
</comment> <class> <name>QueryCompilerErrorHandler</name> <environment>Lens</environment> <super>Kernel.NonInteractiveCompilerErrorHandler</super> <private>false</private> none <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryCompilerErrorHandler
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I am the QueryCompiler's nonInteractiveCompilerErrorHandler. Instead of merely logging non-interactive errors in the Transcript, I bring up a dialog. In addition, I consider undeclared variables fatal and abort.
</comment> <class> <name>ObjectNotPersistent</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.ObjectNotPersistent
ObjectNotPersistent is used to indicate that the object is not persistent.
</comment> <class> <name>LensTemporaryMain</name> <environment>Lens</environment> <super>Lens.LensMainApplication</super> <private>false</private> none <imports></imports> <category>Lens-Applications-Framework</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensTemporaryMain
LensTemporaryMain is a kind of LensMainApplication that can be used to support testing of newly generated or coded DataForms in isolation, prior to inclusion in an application.
</comment> <class> <name>LensAbstractProxy</name> <environment>Lens</environment> <super>Lens.LensAbsentee</super> <private>false</private> none lensContainer <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensAbstractProxy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensAbstractProxy (an abstract class) represents generic behavior of all proxies, which "stand in" for to-be-fetched objects in a database. Proxies use #doesNotUnderstand to trap accesses and to fetch and become the objects for which they stand. Instance Variables: container <LensBaseContainer> INTERNAL the object's container
</comment> <class> <name>LensProxy</name> <environment>Lens</environment> <super>Lens.LensAbstractProxy</super> <private>false</private> none externalId hasBeenTriggered <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensProxy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensProxy represent individual to-be-fetched persistent objects. Instance Variables: externalId <Object> INTERNAL the external ID of the represented object hasBeenTriggered <Boolean> INTERNAL a flag indicating that the proxy has been triggered, used to detect attempts to trigger the proxy when the associated row doesn't exist
</comment> <class> <name>OptimisticConflictDetected</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.OptimisticConflictDetected
OptimisticConflictDetected is raised when an optimistic lock conflict is detected.
</comment> <class> <name>UIDataReference</name> <environment>Lens</environment> <super>UI.Model</super> <private>false</private> none referred name <imports></imports> <category>Lens-Private-Applications-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.UIDataReference
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of this class are used to describe the row types of application subclasses of DataManager. Since the type of a row may refer to a given Class or StructureType more than once, the reference includes a tag or name to distinguish it from other references of the same type. This class is referred to from generated rowClass methods Instance Variables referred <Symbol | LensStructureType | ClassDescription> designate the type of the datum name <String | Symbol> names this particular reference
</comment> <class> <name>LensGraphReference</name> <environment>Lens</environment> <super>Lens.UIDataReference</super> <private>false</private> none children application cascade position <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensGraphReference
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. See parent class comment. Added instance variables: children <collection of LensGraphReference or nil> a collection caching the children of the reference. The children are computed in sub classes application <any application, probably the LensApplicationSpecEditor> cascade <a collection of symbols> the way needed to get to us position <a number> my position inside the children collection of my parent
</comment> <class> <name>LensType</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none name memberClass <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensType is an abstract class and is the root of the type subsystem. Instance Variables: name <String | nil> the name of the type if non-nil (else defaults to the memberClass's name) memberClass <Class> the class of the type's members Class Variables: AttributeUndefinedSignal <Signal> DefinitionErrorSignal <Signal> TypeViolationSignal <Signal> see signal method definitions
</comment> <class> <name>LensStructureType</name> <environment>Lens</environment> <super>Lens.LensType</super> <private>false</private> none dataModel supertype variables encoder decoder table idVariable defersPostingUpdates idGeneratorType externalIdClosure indexes <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensStructureType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensObjectStructure describe the structure of objects from the database perspective. Instance Variables: dataModel <LensDataModel | nil> the data model for which this type maps objects, if non-nil supertype <LensType> Records the type of the first superclass to have a type in this data model. variables <Array of: LensObjectVariable> the variables describing objects' instance variables encoder <LensTranscoder> encodes objects prior to writing to database decoder <LensTranscoder> decodes objects after being read from database table <DatabaseTable | nil> the table to which objects are mapped, if non-nil idVariable <LensObjectVariable> the variable describing the external IDs of objects defersPostingUpdates <Boolean> true if updates to objects are to be defered to the next synchronization point, false if updates are to be immediately sent to the database idGeneratorType <#(userDefinedId surrogateId sequenceId)> defines how IDs for new objects are to be generated sequence <DatabaseSequence | nil> the sequence for generating new IDs (only sequence IDs for now) externalIdClosure <LensTranscoder> computes the externalID for user-keyed objects indexes <OrderedCollection of: DatabaseIndex | nil> collection of index descriptions for the associated table
</comment> <class> <name>LensCollectionType</name> <environment>Lens</environment> <super>Lens.LensStructureType</super> <private>false</private> none keyType elementType linkType <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensCollectionType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensCollectionType describe sets of collections, constraining the member collections' elements and keys. Instance Variables: keyType <Type> the type of keys in dictionary-like collections (currently unused) elementType <Type> the type of members in any collection
</comment> <class> <name>CannotUpdate</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.CannotUpdate
CannotUpdate is used to indicate that it can not update long variables.
</comment> <class> <name>LensRegistry</name> <environment>Lens</environment> <super>Core.Dictionary</super> <private>false</private> objects keyArray <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensRegistry
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The class LensRegistry is a subclass of Dictionary in which the lookup is done using == rather than =. It is represented as parallel arrays of keys and values, rather than as a single collection of associations. LensRegistry is modeled on IdentityDictionary but differs in that the key array rather than the value array is stored in an instance variable. Instance Variables: keyArray <Array of: Object> of keys known in the registry
</comment> <class> <name>CannotChangePolicyWhileConnected</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.CannotChangePolicyWhileConnected
CannotChangePolicyWhileConnected is used to complain about changing policy while connected.
</comment> <class> <name>LensDataModelGenerator</name> <environment>Lens</environment> <super>UI.SimpleDialog</super> <private>false</private> none lensDataModelHolder extractedColumnList applicationNameAdaptor dialect lensPolicy selectorNameAdaptor catalogLens defaultCategory oldDataModel <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDataModelGenerator
LensDataModelGenerator is a class which serves as an assistant in making up a data model. It contains services which are generally used by some part of the database tools user interface. Some of these services include standard dialogs for prompting the tool users. Instance Variables: lensDataModel <LensDataModel | nil> The data model which is the subject of my attentions. May be nil when first initialized if the intent is to create a new data model. className <ValueHolder on: String> Holds the name of a class being prompted for. superclassName <ValueHolder on: String> Holds the name of a superclass being prompted for. category <ValueHolder on: String> Holds the name of a class category. extractedColumnList <MultiSelectionInList> Holds the list of columns to select from. applicationNameAdaptor <ValueHolder on: String> Holds the name of the application. dialect <ValueHolder on: Symbol> Holds the chosen dialect (filter). lensPolicy <ValueHolder on: Symbol> Holds the selected lens policy name. selectorNameAdaptor <ValueHolder on: String> Holds a method selector. Generally used to hold the name of the class method which answers the literal specification for the data model. catalogLens <a LensSession> holds onto a lens session on the catalog for the data model being edited. To cache the lens so it's not recreated every time. oldDataModel <s LensDataModel | nil> used for temporarily holding the old version of a data model while editing
</comment> <class> <name>ObjectInAnotherLensContainer</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.ObjectInAnotherLensContainer
ObjectInAnotherLensContainer is used to indicate that the object is already in another container
</comment> <class> <name>LensGlobalDescriptor</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none externalId flags updatedInstVarsMask lensContainer objectRegistryIndex lastCommitedVersion refObj <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensGlobalDescriptor
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of the class LensGlobalDescriptor hold information concerning database objects. Each global descriptor serves several roles. The primary roles are the object's identity and state machine. It records the primary key values (externalId) which are used to look up the row, the persistence (see Added, Persistent, and Removed), synchronization (see Clean and Dirty) and which instance variables need to be posted to the database. In conjunction with the Registry held as a class variable, the global descriptor also provides access information to facilitation navigation from an object to its LensSession (via the LensContainer) and to the object from its global descriptor. The registry also supports the finalization for no longer referenced objects. Instance Variables: externalId <Object> the object's externalId flags <SmallInteger> holds persistence and synchronization states updatedInstVarsMask <SmallInteger> a bitmap of updated inst vars lensContainer <LensBaseContainer> the container holding the object objectRegistryIndex <SmallInteger | nil> base index of object's entry in the Registry. This is maintained using serious magic (i.e. an interdepenent implementation in LensObjectRegistry and herein). lastCommitedVersion <Object> A shallow copy of the original value of the object. This is made, when savingLastCommitedVersions is true, the first time in a transaction the object is updated. Class Variables: Added <SmallInteger> bit position/mask for flags variable to indicate an Added object. Added indicates that the row for the object was inserted into the database in the current transaction. Clean <SmallInteger> bit position/mask for flags variable to indicate that the object is Clean. Clean indicates that the row for the object has not been changed in the database in the current transaction. Dirty <SmallInteger> bit position/mask for flags variable to indicate that the object is Dirty. Dirty indicates that the row for the object has been changed in the database in the current transaction. PendingRemoval <SmallInteger> bit position/mask for flags variable to indicate that the object is pending removal. This will be set if the object is removed while delayingUpdates is set to true. PersistenceState <SmallInteger> mask for persistence states (Added, Persistent, Removed) Persistent <SmallInteger> bit position/mask for flags variable to indicate that the object is Persistent. Persistent indicates that the row for the object existed in the database at the start of the transaction and has not been removed. Registry <LensObjectRegistry> Associates every Added, Persistent, or Removed object with its LensGlobalDescriptor. This registry spans all LensSession instances. Removed <SmallInteger> bit position/mask for flags variable to indicate that the row for the object has been removed from the database in the current transaction.
</comment> <class> <name>LensContainerReference</name> <environment>Lens</environment> <super>Lens.LensGraphReference</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensContainerReference
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances represent references to Lens Containers, which are stored in the referred field as LensStructureTypes. Instances are used in graphical tools to represent the container reference. When stored as literal arrays, they are stored as UIDataReference and transformed into LensContainerReference when needed. To get a full transformation, i.e. hold the actual LensType, the transformation has to be done in the context of a LensDataModel, which is accessed to find the Type named in referred.
</comment> <class> <name>LensInstanceVariable</name> <environment>Lens</environment> <super>Kernel.InstanceVariable</super> <private>false</private> none <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensInstanceVariable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>InvalidAggregateFunction</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.InvalidAggregateFunction
InvalidAggregateFunction is used to indicate that an invalid aggregate function was called.
</comment> <class> <name>LensValueSurrogate</name> <environment>Lens</environment> <super>Lens.LensExpressionSurrogate</super> <private>false</private> none <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensValueSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensValueSurrogate represent unspecified objects or contents of their attributes. LensValueSurrogate is an abstract class defining printing, comparing, and symbolic evaluation behavior common to its subclasses.
</comment> <class> <name>LensSubquerySurrogate</name> <environment>Lens</environment> <super>Lens.LensValueSurrogate</super> <private>false</private> none objectSurrogate answerBlock condition variable <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSubquerySurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensSubquerySurrogate behave like containers, and are the targets of nested queries, i.e. those occuring in the bodies of top-level select: blocks. Instance Variables: objectSurrogate <LensObjectSurrogate> represents the type of object being selected answerBlock <BlockClosure | > the answer block, if the container is projected condition <LensExpressionSurrogate> the subquery condition parse graph (used to generate the subquery's WHERE clause) variable <LensStructureVariable> a variable describing the value of the subquery
</comment> <class> <name>LensStructureVariable</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none name valueType objectType fieldType column flags inverse overlappingVariablePaths secondaryStorageName <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensStructureVariable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of the class LensObjectVariable describe instance variables of classes, especially constraints on the type of values the associated variables may hold. They are associated with instances of LensObjectStructure. Instance Variables: name <ByteString> the name of the associated instance variable valueType <LensType> the type of values that may be stored in the variable objectType <LensObjectStructure> the type of which this is a variable fieldType <Type> the type of variable values when encoded for input/output via database drivers column <DatabaseTableColumn | nil> the associated database column if the variable is mapped and is a leaf flags <SmallInteger> flags encoding various variable properties inverse <ByteString | nil> the name of the inverse variable, if non-nil overlappingVariablePaths <Array | nil> If the column mapped to this variable is mapped to any other variables then an array, one element for each variable mapped to that column. Each element will be an array where the first element will the StructureVariable for the containing instance variable for that variable. Successive elements will be indexes to reach that variable/ Class Variables: CheckAlwaysMask <SmallInteger> CheckIfModifiedMask <SmallInteger> GeneratesAccessorMask <SmallInteger> GeneratesMutatorMask <SmallInteger> HasNonoverlappedNullableVariablesMask <SmallInteger> IndexMask <SmallInteger> IsCanonicalVariableMask IsCanonicalVariableMask IsIdMask <SmallInteger> IsMappedMask <SmallInteger> IsNotNilMask <SmallInteger> masks for the flags instVar OverlapsOtherVariablesMask <SmallInteger> StoreSubvariables <Boolean> used during writing schemas to files When fieldType is an instance of LensObjectStructure, the variable describes complex values that are to be expanded into basic data values.
</comment> <class> <name>LensDataType</name> <environment>Lens</environment> <super>Lens.LensType</super> <private>false</private> none max <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDataType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensDataType describe sets of simple, unstructured data, including numbers, strings, byte arrays, and dates. Instance Variables: max <SmallInteger | nil> the maximum size of byte-like values, if non-nil
</comment> <class> <name>LensRowHolder</name> <environment>Lens</environment> <super>UI.ValueHolder</super> <private>false</private> none clientMap <imports></imports> <category>Lens-Private-Applications-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensRowHolder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This class is used by LensDataManager. It provides for the registration of DependencyTransformers and BlockValues according to what objects are being benefitted by the arrangements. Thus, when these objects are finalized, the dependents having to do with them can be removed Instance Variables clientMap <IdentityDictionary | nil> maps dependents to clients
</comment> <class> <name>EmbeddedDetailSpec</name> <environment>Lens</environment> <super>UI.SubCanvasSpec</super> <private>false</private> none sourceType contentKey fetchAction synchronize autoFetch lockPolicy nameSpace <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.EmbeddedDetailSpec
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. EmbeddedDetailSpecs contain the the necessary information for generating that portion of a Database Application or Data Form to do with its use of an embedded Data Form. It describes the layout and appearance of the subcanvas holding the embedded Data Form, and also the connections between the parent application or Data Form and the embedded child Data Form. In this last sense, it provides special advice for a LensDefiner. Instance Variables: sourceType <Symbol> says whether the source is a singular access via an aspect (#singular), or a query (#query) contentKey <Symbol | nil> the key to use when requesting the ValueModel to be used as rowSource by the sub-application fetchAction <Symbol | nil> the message to send to the containing application to cause it to fetch results to the sub-application synchronize <Boolean> says whether the client should be updated whenever the parent's selected row changes autoFetch <Boolean> says whether the containing application should, when opening the sub-application, immediately perform the fetchAction lockPolicy <Symbol | nil> says whether and when the row object may be locked automatically: #lockOnAccept, #lockOnEdit, or #current
</comment> <class> <name>DatabaseCommand</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none bindObject bindTemplate body resultTemplate isRPC isQuery decoder <imports></imports> <category>Database-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DatabaseCommand
DatabaseCommands hold a bundle of objects that collectively specify a database command. Used by protocol that is private to the ObjectLens. Instance Variables: bindObject <Object | OrderedCollection | nil> holds bind variable values bindTemplate <Object | OrderedCollection | nil> defines the structure of the bindObject if nil, bindObject is used in its place body <ByteString> the DML or DDL command string resultTemplate <Object | nil> defines the structure of the predecoded result objects to be returned isRPC <Boolean> true if the command is a remote procedure call, in which case the body is the procedure name isQuery <Boolean> true if the command is a query, hence a result is expected decoder <BlockClosure> used by the ObjectLens to decode the result rows into persistent objects
</comment> <class> <name>LinkedDetailSpec</name> <environment>Lens</environment> <super>UI.ActionButtonSpec</super> <private>false</private> none clientKey majorKey minorKey sourceType contentKey openAction fetchAction synchronize autoOpen autoFetch lockPolicy nameSpace <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LinkedDetailSpec
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LinkedDetailSpecs contain the the necessary information for generating that portion of a Database Application or Data Form to do with its use of a linked Data Form. It describes the layout and appearance of a button for triggering the linked Data Form, and also the connections between the parent application or Data Form and the linked child Data Form. In this last sense, it provides special advice for a LensDefiner. Instance Variables: clientKey <Symbol | nil> the key to use when requesting the sub-application from a UI-Builder's source majorKey <Symbol | nil> the class name for the spec producing method for the sub-application minorKey <Symbol | nil> the selector of the spec producing method for the sub-application sourceType <Symbol> says whether the source is a singular access via an aspect (#singular), or a query (#query) contentKey <Symbol | nil> the key to use when requesting the ValueModel to be used as rowSource by the sub-application openAction <Symbol | nil> the message to send to the application to cause the sub-application to open fetchAction <Symbol | nil> the message to send to the containing application to cause it to fetch to the sub-application synchronize <Boolean> says whether the client should be updated whenever the parent's selected row changes autoOpen <Boolean> says whether the containing application should, when opening, immediately open the sub-application autoFetch <Boolean> says whether the containing application should, when opening the sub-application, immediately perform the fetchAction lockPolicy <Symbol | nil> says whether and when the row object may be locked automatically: #lockOnAccept, #lockOnEdit, or #current
</comment> <class> <name>TriggeringWhenNotOpen</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.TriggeringWhenNotOpen
TriggeringWhenNotOpen is raised when attempting to trigger a proxy and the session is closed or disconnected.
</comment> <class> <name>QueryError</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryError
QueryError is used to indicate that a query error occured.
</comment> <class> <name>LensVariableSurrogate</name> <environment>Lens</environment> <super>Lens.LensValueSurrogate</super> <private>false</private> none source variable destination predecessor <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensVariableSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensVariableSurrogate represent navigations through variables during symbolic block evaluation. Variable surrogates are created and linked together to form paths in response to block evaluation of navigational paths. Variable surrogates point forward to the surrogate representing their value (destination), and backward to the object surrogate representing the object whose variable was selected (source). Variable surrogates also point back to any preceding variable surrogate (predecessor) when selections navigate along paths of 2 or more variables. When used in orderBy blocks, variable surrogates keep track of the sort direction in their isAscending flag. The method LensVariableSurrogate>doesNotUnderstand: is called during symbolic evaluation, and determines whether the method being evaluated (that is, the method that would be called if the surrogate were an actual object) is an variable accessor or some other method. In the former case, it then calls LensVariableSurrogate>navigateThrough:, which creates the new variable surrogate, links it into the path, and returns the new variable surrogate. It is this new variable surrogate that gets the next message send in the symbolic evaluation. Instance Variables: source <LensObjectSurrogate> represents the object whose variable is selected variable <LensStructureVariable> the selected variable destination <LensObjectSurrogate> represents the value of the variable predecessor <LensVariableSurrogate> the preceding variable in a path isAscending <Booelan> true if sorting is to be ascending
</comment> <class> <name>LensMethodGenerator</name> <environment>Lens</environment> <super>Kernel.ProgramNodeBuilder</super> <private>false</private> none targetClass statement temps body tracing <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensMethodGenerator
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensMethodGenerator generates methods, and is a private, internal part of the ObjectLens' implementation.
</comment> <class> <name>LensCompiler</name> <environment>Lens</environment> <super>Kernel.Compiler</super> <private>false</private> none <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensCompiler
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>LensEnumerationType</name> <environment>Lens</environment> <super>Lens.LensType</super> <private>false</private> none elementType members <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensEnumerationType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensEnumerationType describe sets with a fixed set of elements. Instance Variables: elementType <LensType> the "base type" from which all enumeration values are drawn members <Collection of: <member of LensType>> the enumeration type's values
</comment> <class> <name>LensDatabaseIndex</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none name indexedVariables <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDatabaseIndex
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensDatabaseIndex describe indexes in databases. Instance Variables: name <String> name by which index is registered in database isPrimary <Boolean> true if index describes the primary key of the table indexedVariables <Array of: LensStructureVariable> the attributes to be indexed isUnique <Boolean> true if the values in the indexed columns are unique
</comment> <class> <name>TypeViolation</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.TypeViolation
TypeViolation is used to indicate that a type violation error occured.
</comment> <class> <name>UntransactedOperation</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.UntransactedOperation
UntransactedOperation is raised when an operation is requested that should be done inside a transaction, the session isn't in a transaction, and the policy doesn't specify auto-begin.
</comment> <class> <name>CannotQueryLocalVariable</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.CannotQueryLocalVariable
CannotQueryLocalVariable is used to indicate that it can not query through a local variable.
</comment> <class> <name>LensReferenceType</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none referencedClassName <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensReferenceType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensReferenceType is used as the valueType of a LensStructureVariable when either of two situations occur. 1) The objectType of the variable (a LensStructureType) is not contained in a LensDataModel. Without the context provided by a data model, it is not interesting what the details are of the referenced class. 2) The LensDataModel doesn't yet contain the definition of the referenced class. Instance variables: referencedClassName <Symbol> The name of the referenced class. If the named class does not exist in the image, it is assumed that it will eventually. Until it does, and that class is also made part of the data model, it is not possible to map the referencing variable to a table.
</comment> <class> <name>LensBaseContainer</name> <environment>Lens</environment> <super>Lens.LensContainer</super> <private>false</private> none cache <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensBaseContainer
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensBaseContainer provide access to data in individual database tables. In addition to the messages inherited from LensContainer, LensBaseContainer provides #add:, #remove:, and related bulk updating methods. Instance Variables: cache <Dictionary key: Object value: LensGlobalDescriptor> INTERNAL for (in-memory) peristent objects contained in the container, maps their external IDs to their global descriptors
</comment> <class> <name>QueryCompiler</name> <environment>Lens</environment> <super>Kernel.Compiler</super> <private>false</private> none <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryCompiler
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I am the preferred compiler class of LensDataManager. Currently the only thing I do is defining my own nonInteractiveCompilerErrorHandler.
</comment> <class> <name>QueryOperationAccessor</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none operation session container lensContainer <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryOperationAccessor
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of QueryOperationAccessor bind (static, reentrant) query operations to (dynamic) sessions. QueryOperationAccessors therefore serve as specific operations that may be invoked, and will execute in a specific session context. When asked to execute, a query operation accessor accepts an actual argument for each of its query operation's arguments. If the query operation's command is nil, it asks the container's transporter to create a command from the query operation, which it then binds to the query operation for efficient reuse on subsequent requests. It then binds the actual arguments to the command, submits the command, and processes and returns the result in the form specified by the query operation. Instance Variables: operation <QueryOperation> the operation to perform when invoked session <LensSession> the session providing the context in which to perform the operation lensContainer <LensContainer> INTERNAL the container on which to perform the operation Class Variables: SizeBlocks <Array of: BlockClosure> an array of blocks for answering the size of containers, indexed by the number components in the container (== 1 for base containers)
</comment> <class> <name>LensBasicTransporter</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none lensContainer session type baseCursor objectSurrogates referencedObjectSurrogates answerSurrogate fetchCommand addCommand updateCommand lockCommand decoder resultTemplate <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensBasicTransporter
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This comment comprises an overview of the Object Lens' entire transport subsystem. Every container has its own transporter whose job is to dynamically translate data between object and row forms, and translate operations on individual objects or groups of objects from their Smalltalk form to commands in the DML of some specific database. The following messages comprise translation protocol: retrieval: execute: answers a collection or stream of persistent objects from the container's table specified by a given query operation queryFor: answers a command for retrieving objects from the container's table specified by a given query operation objectAtId: answers an object with a given ID collectionFor:withParent: answers an identity set of persistent objects from a given query command and parent object adding: add: adds an individual object to the container's table removing: remove: removes an individual object from the container's table removeWhere: removes the objects specified by a given selection block from the container's table updating: update:attributeNamed:to: update:withId:andMask: updateData:withId:andMask: updateObjects:withTemplate: updates individuals or groups of objects in the container's table dumping/loading: dumpOn: dumps rows for all objects in the container's table onto a given binary object stream load: inserts the given rows into the container's table LensBasicTransporter is an abstract class at the root of the transporter class hierarchy, and defines state and behavior common to any kind of database. Currently, it has only a single subclass, LensSQLTransporter, which is an abstract class that defines state and behavior common to any kind of SQL relational database. Each SQL database filter defines a concrete subclass of LensSQLTransporter. As a performance optimization, each transporter caches a database session (in its baseCursor instVar) setup to fetch the container's values, i.e. full persistent objects. Queries on the container that return projections, i.e. using an answerBlock to specify a subset of the information or computed information, use their own newly-created database session. Transporters also cache command templates for basic data manipulation operations - fetching, adding, removing, and updating individual objects. The command templates are generated lazily, and are side-effected prior to each use at runtime, except updates, which edit copies of the updateCommand. Transporters use query surrogates for symbolically evaluating query operation (select:, answer:, and orderBy:) blocks. The result of such a symbollic evaluation is a parse graph representing the semantics of the evaluated block. Each driver-specific transporter subclass is responsible for translating parse graphs into DML fragments, which are then combined to for a complete DML statement. (See the comment on class LensQuerySurrogate for an overview of how surrogates work.) Each object surrogate serves as a prototypical object residing in a single table. InstVar objectSurrogates holds an array of object surrogates. When the container is a base container, objectSurrogates contains a single object surrogate, and when the container is composite, it contains an object surrogate for each component container. InstVar referencedObjectSurrogates accumulates the surrogates representing tables that are to be referenced in the query (but not necessarily fetched, such as when they are used to define join conditions). Parse graphs are generated by evaluating query operation blocks, passing the array in objectSurrogates. See the comment on class LensQuerySurrogate for more details on parse graph generation and representation, and the comment on class LensSQLTransporter for more details on parse graph translation. When the container is projected, the instVar resultVariables contains a specification of the values to be projected and returned, which may either be attribute values or aggregate function applications. The instVar decoder holds the blockClosure to be applied to the individual rows returned from the database answer stream in order to decode them into persistent objects.. Instance Variables: lensContainer <LensContainer> the container for which the receiver provides transport services session <LensSession> the owning container's session type <LensStructureType> the container's element type baseCursor <ExternalDatabaseSession> a cached database session used for fetching persistent objects in container objectSurrogates <Array of: LensObjectSurrogate> all symbolic objects participating in queries referencedObjectSurrogates <IdentitySet of: LensObjectSurrogate> those objectSurrogates that are to be referenced in queries answerSurrogate <OrderedCollection of: (LensVariableSurrogate | LensFunctionSurrogate) | nil> describe values to be returned by projections, nil if query has no answerBlock fetchCommand <DatabaseCommand> command template for fetching individual objects given their external ID addCommand <DatabaseCommand> command template for adding new persistent objects updateCommand <DatabaseCommand> command template for updating objects lockCommand <DatabaseCommand> command template for verifying optimistic readlocks decoder <LensTranscoder> used to decode fetched data object into persistent objects resultTemplate <Object> describes the structure of data objects to be fetched
</comment> <class> <name>LensFunctionSurrogate</name> <environment>Lens</environment> <super>Lens.LensExpressionSurrogate</super> <private>false</private> none name args <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensFunctionSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>InappropriateOperation</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.InappropriateOperation
InappropriateOperation is raised when an inappropriate operation is requested.
</comment> <class> <name>LensAnswerStream</name> <environment>Lens</environment> <super>Database.ExternalDatabaseAnswerStream</super> <private>false</private> none <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensAnswerStream
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensAnswerStream is always used after executing a DatabaseCommand if that command has an answer stream. The ObjectLens never executes multiple commands in one command batch and so when the data from the answer is exhausted, it is appropriate to drive the session's state machine through to the #prepared state.
</comment> <class> <name>LensChildrenSetSurrogate</name> <environment>Lens</environment> <super>Lens.LensQuerySurrogate</super> <private>false</private> none variable path <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensChildrenSetSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensChildrenSetSurrogate symbolically represent children sets accessible from objects via navigation through children set variables. Currently, the only useful symbolic operation supported by children set surrogates is #size. Instance Variables: variable <LensStructureVariable> the parent variable pointing from a child to its parent path <LensValueSurrogate> the path leading up to the children set
</comment> <class> <name>CannotStoreTypeOfObject</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.CannotStoreTypeOfObject
CannotStoreTypeOfObject is used to indicate that a container cannot be found.
</comment> <class> <name>LensArbitraryFunctionSurrogate</name> <environment>Lens</environment> <super>Lens.LensFunctionSurrogate</super> <private>false</private> none <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensArbitraryFunctionSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>LensAspectPath</name> <environment>Lens</environment> <super>UI.UIAspectPath</super> <private>false</private> none <imports></imports> <category>Lens-Private-Applications-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensAspectPath
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensAspectPath is used to interpret aspect paths in the context of various subclasses of LensApplication, i.e. it can interpret the use of a LensDataModel tag embedded in the path for indicating a term in a joined query.
</comment> <class> <name>LensDataModel</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none application selector databaseContext validity structureTypes dataTypes tables operations lensPolicyName lensTransactionPolicyName saved structureTypeSelectors specStyleVersion basicTypes <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDataModel
Instances of LensDataModel represent mappings between Smalltalk classes and database tables. Instance Variables: application <Symbol> The name of the class on which the data model is recorded. selector <Symbol> The name of the method on which the data model is recorded. databaseContext <LensDatabaseContext> the context describing the database in which the data model maps objects validity <#(invalid compiled installed)> a flag indicating the data model's validity structureTypes <OrderedCollection of: LensStructureType> the types of classes mapped to tables in the database dataTypes <OrderedCollection of: (LensDataType | LensEncodedType | LensEnumerationType)> all datatypes used by the structure types collectionTypes <OrderedCollection of: LensCollectionType> types of children sets derived by the data model tables <OrderedCollection of: LensDatabaseTable> the tables in the database to which the data model maps objects operations <OrderedCollection of: QueryOperation> the associated query operations lensPolicyName <Symbol> names the lens policy to be used lensTransactionPolicyName <Symbol> names the lens transaction policy to be used saved <Boolean> says whether the receiver has been installed since it was last changed Class Variables: DataDefinitionErrorSignal <Signal> signal to indicate data definition errors DataDefinitionWarningSignal <Signal> signal to indicate that a problem was encountered in the reconstruction of a data model, if no handler is found, then a default action will be performed and the data model will be reconstructed. Class Instance Variables: basicTypes <IdentityDictionary of: <LensType>> The definition of all basic types which may be used without regard to database system. These may be superseded in an individual data model with a dbms-specific refinement of the type.
</comment> <class> <name>LensSpecReplicator</name> <environment>Lens</environment> <super>UI.UISpecEnumerator</super> <private>false</private> none offset fieldSpec editPolicy <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSpecReplicator
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensSpecReplicator is used for replicating template specs during automatic generation of canvases for LensApplication subclasses. Instance Variables offset <Point> the absolute offset relative to which the layouts of specs within the replicated cell are to be interpreted aspect <Symbol> the aspect symbol to be used in specs within the replicated cell
</comment> <class> <name>LensObjectSurrogate</name> <environment>Lens</environment> <super>Lens.LensValueSurrogate</super> <private>false</private> none lensContainer isOuterJoin destinations <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensObjectSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensObjectSurrogate represent objects that participate in symbolic evaluation of query blocks. They are the values of values passed to query operation blocks during symbolic evaluation, so are the starting points of all paths generated during symbolic evaluation. Each object accessor has a dictionary of paths already navigated, so that repeated navigation of the same paths will generate references to the same tables instead of introducing new tables. The LensObjectSurrogate>navigateThrough: method is called to answer a navigational path from the object to some value, and accepts a variable. If a path for the variable already exists, it is returned, else a new path is started, registered, and returned. The methods LensObjectSurrogate>answer:, select:, and select:answer: create subquery surrogates. Instance Variables: lensContainer <LensContainer> the container of objects represented by the receiver isOuterJoin <Boolean> if true, object is part of an outer join query, allowing nil to be returned instead of instances of the type destinations <IdentityDictionary key: LensStructureVariable value: LensVariableSurrogate> registers already-taken paths value <Object> a persistent object serving as the value to be tested in a selection
</comment> <class> <name>LensExceptionInfo</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none exception object <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensExceptionInfo
Instances of LensExceptionInfo describe objects that have had an exception raised while attempting to post an operation done against them. Instance Variables: exception <Exception> the exception that was raised while posting the operation. object <Object> the object that had the operation fail while being posted.
</comment> <class> <name>LensLinkedAssociation</name> <environment>Lens</environment> <super>Core.Association</super> <private>false</private> none nextLink <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensLinkedAssociation
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A LensLinkedAssociation is an Association that can be a member of a linked list. Instance Variable: nextLink <LensLinkedAssociation | nil>
</comment> <class> <name>LensDatabaseTableColumn</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDatabaseTableColumn
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensDatabaseTableColumn represent the columns of tables living in database data dictionaries. (See the comment on LensDatabaseTable for more general remarks about data dictionary entities.) LensDatabaseTableColumn does not define any instance variables so that subclasses have full control over the ordering.
</comment> <class> <name>LensOperationSurrogate</name> <environment>Lens</environment> <super>Lens.LensExpressionSurrogate</super> <private>false</private> none left operator right <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensOperationSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensOperationSurrogate represent computations to be performed within a query. Instance Variables: left <LensQuerySurrogate> the lefthand operand, always a surrogate operator <Symbol> the operator selector right <LensQuerySurrogate | Object | nil> the righthand operand (nil if the operator is unary), either a surrogate or an application-level object
</comment> <class> <name>LensEncodedType</name> <environment>Lens</environment> <super>Lens.LensType</super> <private>false</private> none fieldType encodeSelector decodeSelector <imports></imports> <category>Lens-Private-Data Model</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensEncodedType
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensEncodedType represent data values that undergo some encoding prior to being written to the database, and/or some decoding after being fetched from the database. Instance Variables: fieldType <Type> the type of values as encoded encodeSelector <Symbol | nil> the selector to be sent to values to encode them, if non-nil decodeSelector <Object> the selector to be sent to values to decode them, if non-nil
</comment> <class> <name>LensSessionIsPaused</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSessionIsPaused
LensSessionIsPaused is raised when an operation is requested that requires a connection, the session is paused, and the policy doesn't specify auto-resume.
</comment> <class> <name>LensWeakRegistry</name> <environment>Lens</environment> <super>Lens.LensRegistry</super> <private>false</private> objects accessLock <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensWeakRegistry
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I am a dictionary whose keyArray is a WeakArray. I am fully protocol-compatible with IdentityDictionary or LensRegistry. The lookup is done using == rather than =. For finalization, I assume that the value is the "executor." An executor is responsible for finalization after the key has been reclaimed. An key with special finalization requirements should implement the #finalize message, which is sent to actually perform the finalization. Otherwise, the default implementation in Object>>finalize performs no finalization. Most accessing methods contain critical regions using the accessLock, so that finalization does not occur during an access. The methods that are not protected are the Association-based protocols, which shouldn't be used on this kind of Dictionary anyway. Instance Variables: accessLock <RecursionLock> Mutex protecting acceses
</comment> <class> <name>LensWeakCollection</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> objects array <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensWeakCollection
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensWeakCollection serve as variable-length weak collections. They may be thought of as weak ordered collections with only the simplest add/remove and iteration protocols. Instance variables: array <WeakArray> weakly contains the receiver's values
</comment> <class> <name>LensSession</name> <environment>Lens</environment> <super>UI.Model</super> <private>false</private> none serialNumberGeneratorBlock dataModel connection lensPolicy containers nonBaseContainers isActive cascadedAdds removedObjects pendingOperations pendingOperationsIndex keyChanges delayingOperations savingLastCommitedVersions lensTransactionPolicy pendingLocks postponedOperations <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSession
LensSessions provide most of the public protocol to be used by applications of the ObjectLens. They are obtained by sending getSession to a LensDataModel. The 'connection management' protocol contains the messages used to control the connection with the dbms. The 'transaction management' protocol gives control over the persistence of changes to objects managed by a LensSession. Adding new objects into database tables and removing existing ones from database tables is covered by the 'collection protocol' protocol. Several relevant states can be tested for in the 'testing' protocol. For relatively specialized needs, see the 'cache management' protocol. Clients of a LensSession may add themselves as dependents. Dependents will be given various notifications about significant events in the overall life of the LensSession. There is one which is almost mandatory for the client to observe (#terminateTransaction) and the others are provided for the convenience of the client. These change notices are: #terminateTransaction A LensSession may not have dirty objects when snapshotting or quitting and using pause or disconnect require that the dirty objects be resolved. The #terminateTransaction notice gives the dependent a chance to decide whether to commit or roll back. If the transaction is still not ended, the LensSession will ask the user directly. The motivation for asking the user is that there is some chance that they'll remember that they did it. This is not expected to be used as part of a normal application flow. It's more an aid for the developer. If the LensSession is merely in transaction mode, but has no dirty objects, then the transaction is quietly rolled back. #install The LensSession has been "installed" again after returnFromSnapshot and may be resumed. The dependent may choose to send #resume or #resume: if there is any intention to continue using the LensSession. By default, the LensSession will attempt to resume when it is next asked to do something which requires connection to the dbms. See the resume method for more information on what is required in order for it to succeed. #preBegin #postBegin #preCommit #postCommit #preRollback #postRollback These notifications are sent for the obvious events. They are provided for applications which find it easier to react to these changes than to keep an internal state machine which keeps up proactively. Instance Variables: serialNumberGeneratorBlock <nil | BlockClosure> the block to be invoked if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation. The block is given an array with 4 entries (class name <Symbol>, variable <String>, qualified table name <String>, and the column name <String>) and must answer an appropriate value. dataModel <LensDataModel> the dataModel that this ObjectLens session uses to define the data being manipulated connection <ExternalDatabaseConnection> the connection providing low-level (SQL) database access for accessing objects lensPolicy <LensPolicy> the policy controlling the session's detailed transaction, connection, and exception management behavior containers <IdentityDictionary key: LensStructureType value: LensBaseContainer> maps mapped types to containers holding the types' persistent members nonBaseContainers <LensWeakCollection of: LensCompositeContainer> holds onto composite containers dynamically created by the application (used to inform the containers of session connection/disconnection) isActive <Boolean> true if the ObjectLens is in a transaction in which changes have been made cascadedAdds <IdentitySet of: LensGlobalDescriptor> when an object is added to a container, all objects that it references that are instances of a class mapped in the dataModel must be persistent and if not are automatically added. This collection is used to detect and break cycles in the reference graph. It must be empty when not adding a new persistent object. removedObjects <IdentitySet of: LensGlobalDescriptor> a collection of global descriptors for objects that have been deleted in the current transaction, used to return them to the caches on rollback pendingOperations <OrderedCollection of: Object> The list of objects that have been updated in memory but whose database rows are yet to be updated. The list here among other uses keeps the objects from being garbage collected prematurely. pendingOperationsIndex <IdentityDictionary key: Object value: Integer> an index into pendingOperations. keyChanges <IdentityDictionary key: LensGlobalDescriptor value: Object> maps LensGlobalDescriptor -> originalExternalId (it had at the start of the transaction), used for rollback. If the object itself is garbage collected before the transaction is rolled back, the LensGlobalDescriptor will deal with it. delayingOperations <Boolean> true if the ObjectLens is currently delaying until commit updates to the underlying database. savingLastCommitedVersions <Boolean> true if we should be saving the state of persistant objects the first time we update them within a transaction. lensTransactionPolicy <LensTransactionPolicy> the policy controlling transaction processing options. pendingLocks <IdentitySet of: Object>the list of objects that have optimistic readlocks placed against them. postponedOperations <OrderedCollection of: Object> the list of objects that have had an exception raised while posting their updates and the application has proceded with #postpone. Class Variables: CannotChangePolicyWhileConnectedSignal <ExternalDatabaseSignal> the signal used to complain about changing policy while connected CannotStoreTypeOfObjectSignal <ExternalDatabaseSignal> the signal used to indicate that a container cannot be found InappropriateOperationSignal <ExternalDatabaseSignal> signal that is raised when an inappropriate operation is requested LensSessionIsClosedSignal <ExternalDatabaseSignal> signal that is raised when an operation is requested and the session is closed LensSessionIsDisconnectedSignal <ExternalDatabaseSignal> signal that is raised when an operation is requested that requires a connection, the session is disconnected, and the policy doesn't specify auto-connect OpenLensSessions <LensWeakCollection of: LensSession> weakly holds currently-open sessions RowForProxyNotFoundSignal <ExternalDatabaseSignal> signal that is raised when a proxy is triggered and its row can't be found SerialNumberRequestSignal <ExternalDatabaseSignal> The proceedable signal raised if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation and the LensSession does not have a serialNumberGeneratorBlock. The signal's parameter has an array with 4 entries (class name <Symbol>, variable <Symbol>, qualified table name <String>, and the column name <String>) and must proceedWith: an appropriate value. TriggeringWhenNotOpenSignal <ExternalDatabaseSignal> signal that is raised when attempting to trigger a proxy and the session is closed or disconnected UntransactedOperationSignal <ExternalDatabaseSignal> signal that is raised when an operation is requested that should be done inside a transaction, the session isn't in a transaction, and the policy doesn't specify auto-begin Implemenatation notes: LensSessions provide runtime connections to databases for groups of containers. An ObjectLens session's containers are in one-to-one correspondence with the entites mapped by the session's data model.
</comment> <class> <name>LensDatabaseContext</name> <environment>Lens</environment> <super>Lens.LensMetadata</super> <private>false</private> none username environment catalogDataModel dataTypeMappings maxColumnSize maxNameSize reservedWords basicTypes shortSize transactionPolicies <imports></imports> <category>Lens-Private-Database Context</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDatabaseContext
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensDatabaseContext is an abstract class defining representatives of physical databases. The class side provides common services for managing basic lens types and database catalog structure. Instance Variables: username <String> identifies the user to the database environment <String> describes how to reach the database server, including network and server identification Class Instance Variables: catalogDataModel <LensDataModel> Holds the instance of LensDataModel which describes the system catalog of the context's database. dataTypeMappings <OrderedCollection> A collection of DataTypeMapping instances which translate from the database system's type names into lens types to represent them. maxColumnSize <SmallInteger> The largest number of bytes which may be stored in a single column in a table. maxNameSize <SmallInteger> The largest number of bytes which may comprise a name. reservedWords <Array> An array containing every reservered word from the SQL implementation of the database server. basicTypes <IdentityDictionary> Holds a dictionary mapping names to lens types for all basic types defined in the ObjectLens. shortSize <SmallInteger> The largest size storable in a byte field without it being constrained by the dbms and requiring some kind of special handling and other limits. transactionPolicies <IdentitySet of: Symbol> The names of the available transactionPolicies for this kind of connect.
</comment> <class> <name>LensSQLTransporter</name> <environment>Lens</environment> <super>Lens.LensBasicTransporter</super> <private>false</private> none selectFieldList whereCondition commandStream command objectSurrogateIndices joinLinks variableIndex numberOfIdVariables itemSurrogate variableBindings functions <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSQLTransporter
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensSQLTransporter specializes LensBasicTransporter for accessing SQL databases, implementing translation of parse trees into database commands whose bodies are SQL statements. During translation, the instVar command holds the database command being generated, and the instVar commandStream holds a stream that accumulates the command's body. Bind object values are assigned bind variable indices using the counter variableIndex. InstVar variableBindings holds a dictionary used to map variables representing query operation arguments to their bind variable names in the command body. A dictionary in objectSurrogateIndices keeps track of the number of occurances of each table in the command body, and is used to generate table name aliases in the FROM clause when the same table is referenced multiple times. For example, the following selection block translates into a command that references the EMP table twice, once for the employee being fetched, and once for the employee's manager: [:emp | emp department manager lastName = 'Smith'] InstVar joinLinks holds the set of variable surrogates representing links in multi-variable navigational paths. For example, the selection block above would contain a link from the employee to its department, and a link from the department to its manager. The transporter will automatically include terms in the WHERE clause that implement joins for these links. Query translation is performed by the #queryFor: method, which takes a query operation as its argument. Translation starts by creating a new command and command stream, then adding variable bindings to the command for the query's arguments. Next, the various query operation blocks are evaluated to yield parse graphs, and the parse graphs are translated, yielding command clauses, and accumulating join links and referenced objectd surrogates as a side-effect of translation. If the query involves projection (i.e. includes an answerBlock), then custom a SELECT field list, decoder, and result template are generated, else the cached selectFieldList, type's decoder, and cached resultTemplate are used. Finally, the command's body is assembled from the clauses and attached to the command. Translation of adding, removing, and updating operations uses the same machinery used for query translation, and in addition may use pre-generated and cached command templates for speed. For details of parse graph translation look at the methods in the 'clause generation' protocol. These methods in turn call methods in protocol 'parse graph processing', which walk the parse graph, generally yielding a parse graph transformed in various ways, specifically - substitution of SQL for Smalltalk operators, - translation of Boolean expressions involving #not into the appropriate SQL expression, - substitution of bind variables for literal objects, and accumulation of literals in the command's bind object - substitution of external ID fields for object references, - expansion of expressions involving packed variables into a series of expressions on the individual variables, - translation of certain selections involving #in: into subqueries - translation of removeWhere: select blocks into subqueries Instance Variables: selectFieldList <String> the field list following the SELECT keyword commandStream <WriteStream> the stream on which command bodies are build command <DatabaseCommand> the command being generated objectSurrogateIndices <IdentityDictionary key: IWObjectSurrogate value: SmallInteger> maps objectSurrogates to their indices, used to generate aliases in FROM clauses joinLinks <IdentitySet of: LensVariableSurrogate> the set of variableSurrogates in all but the last link in multi-variable navigational paths, and for which relational joins must be generated variableIndex <SmallInteger> the index of the next command bind variable to be generated numberOfIdVariables <SmallInteger> the number of id variables used to identify objects itemSurrogate <LensObjectSurrogate | nil> the surrogate for items in persistent collections being fetched by the receiver, used to join items with their collections variableBindings <IdentityDictionary key: LensCommandVariable value: String> maps variables representing query operation arguments to their names in the command body Class Variables: OperatorTable <IdentityDictionary key: Symbol value: String> maps Smalltalk selectors to SQL operators
</comment> <class> <name>LensStreamList</name> <environment>Lens</environment> <super>Core.List</super> <private>false</private> none stream chunkSize <imports></imports> <category>Lens-Private-Query Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensStreamList
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LensStreamList is a kind of List whose elements are gathered lazily from an underlying stream (actually, usually a LensQueryOperation that is behaving as a stream). Elements are indexed by the sequence in which they are added and removed. Instances of LensStreamList continue to extend the valid range that can be indexed as elements are added. LensStreamLists propagate change notices to their dependents. Since getting all the objects in the stream is presumed to be expensive, LensStreamList tries to avoid it. It fetches only as many objects as absolutely necessary. However, iteration and copying will cause the query to be executed in its entirety. LensStreamList departs from List's semantics in two respects, in order to economize on fetching: (1) when asked for the "size", LensStreamList will return the current size of the collection as opposed to the size of the stream's contents, and (2) when asked to add an object, the new element is added at the end of the current collection, not necessarily after all the objects from the stream have been retrieved. This behavior differs from List, which implements "add:' as "addLast:". Instance Variables: stream <ReadStream | QueryOperationAccessor> The stream from which we get the objects. It is assumed not to be positionable (it will work with possitionable streams but will not take advantage of them). chunkSize <Integer> The number of objects to fetch each time. This number should probably be greater than 2 to work efficiently
</comment> <class> <name>LensDataManager</name> <environment>Lens</environment> <super>Lens.LensApplicationModel</super> <private>false</private> none rows row trigger rowCount isEditing isCreating isDirty lockPolicy rowType <imports></imports> <category>Lens-Applications-Framework</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensDataManager
LensDataManager is an abstract superclass for application components that present and edit aspects of multiple row objects using either a buffered DataSetView or buffered InputFields. The row objects may be arrays of persistent objects (e.g. if the rows are elements of a joined query). This class includes necessary machinery for supporting automatically generated subclasses. Instance Variables rows <SelectionInList> The rows and the index of the currently selected row row <LensRowHolder> The value of this model is the persistent object or objects being presented trigger <ValueModel> The value model used for triggering buffers used in the models behind input fields rowCount <ValueModel> The value of this model is the number of rows isEditing <Boolean> Says whether the process of editing an existing record has begun isCreating <Boolean> Says whether the process of creating a new record has begun isDirty <Boolean> Says whether any edits have actually been buffered lockPolicy <Symbol> Says whether and when the row object may be locked automatically: #lockOnAccept, or #lockOnEdit Class Side Instance Variables rowType <Array of: UIDataReference> the LensType(s) of the row model's value
</comment> <class> <name>LensVariableReference</name> <environment>Lens</environment> <super>Lens.LensGraphReference</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensVariableReference
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it.
</comment> <class> <name>LensObjectRegistry</name> <environment>Lens</environment> <super>Lens.LensWeakRegistry</super> <private>false</private> objects <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensObjectRegistry
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The class LensObjectRegistry is used to weakly map objects to their LensGlobalDescriptor instances (global descriptors) if the object corresponds to a row (or removed row) in the database. The implementation of this class is closely coupled with the implementation of LensGlobalDescriptor so that each global descriptor contains the index of the slot where it appears in the registry. This backward-reference capability is used to rapidly find the object associated with the global descriptor. Since the LensObjectRegistry is a LensWeakRegistry, each value (global descriptor) is finalized after the associated key weak reference is zeroed by the garbage collector. It is the responsibility of the LensSession to assure that the object is not garbage collected if it contains information which is not recorded in the database row.
</comment> <class> <name>LensSessionIsDisconnected</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensSessionIsDisconnected
LensSessionIsDisconnected is raised when an operation is requested and the session is disconnected.
</comment> <class> <name>LensCollectionProxy</name> <environment>Lens</environment> <super>Lens.LensAbstractProxy</super> <private>false</private> none query parent <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensCollectionProxy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensCollectionProxy stand in for children sets, identity sets of persistent objects that are associated with a "parent" object by virtue of referencing the parent with a certain instance variable. Instance Variables: query <DatabaseCommand> INTERNAL the command for fetching the collection parent <Object> INTERNAL the parent object of the collection
</comment> <class> <name>QueryStream</name> <environment>Lens</environment> <super>Lens.LensAnswerStream</super> <private>false</private> none lensContainer peekBuffer decoder <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.QueryStream
Instances of QueryStream produce query results in stream form for the Object Lens. They implement standard non-positionable stream protocol. Instance Variables: lensContainer <LensContainer> INTERNAL the container holding the query result objects peekBuffer <Object | nil> INTERNAL holds the previously-fetched object if peeked decoder <LensTranscoder> INTERNAL decodes rows into persistent objects
</comment> <class> <name>LensPolicy</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none name transactionsAreSerializable onUntransactedRead onUntransactedChange onUnconnectedOperation revertPersistentObjectsOnDisconnect <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensPolicy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensPolicies (hereinafter "policies") declaratively specify how the ObjectLens will respond to various events and conditions. Policies may be named by data models; when a data model creates a new session, it passes the named policy (if it contains a name) to the session. An application may dynamically replace or modify a session's policy at runtime, allowing for time-varying policies. Policies specify the following: - whether or not transactions are automatically serializable; - when to begin transactions, and how to respond to reading or changing the database when not already in a transaction; and - when to resume a session that has been paused, and how to respond to attempts to access the database when paused. Instance Variables: name <Symbol> name under which policies may be registered and later retrieved transactionsAreSerializable <Boolean> determines whether object reads and changes are serializable true => - always lock on read while inside a transaction; -revert all persistent obects to proxies on transaction begin, commit, rollback, and reconnection; - lock (and thereby refresh) persistent objects prior to updating them (even when their update posting policy is deferred); false => - don't automatically lock on read while inside a transaction; - revert only dirty objects and their children sets only on rollback; - don't automatically lock persistent objects prior to updating them onUntransactedRead <#complain | #readWithoutLocking | #beginTransaction> controls ObjectLens response to attempting to perform a reading operation (specifically fetching from a container, triggering a proxy, or asking an object to lock itself) when the session isn't in a transaction: - complain means raise a signal - readWithoutLocking means do read but don't set a lock - beginTransaction means begin a new transaction onUntransactedChange <#complain | #singlyTransact | #beginTransaction> controls ObjectLens response to attempting to perform a change operation (specifically inserting an object into or removing it from a container, or updating instance variables) when the session isn't in a transaction: - complain means raise a signal - singlyTransact means wrap the change operation in its own begin-commit transaction - beginTransaction means begin a new transaction automatically onUnconnectedOperation <#complain | #resume> controls ObjectLens response to attempting to perform a read or change operation when the session is paused: - complain means raise a signal - resume means resume, then reapply the policy to the resulting state as if the connection had been in place. revertPersistentObjectsOnDisconnect <Boolean> controls what happens to a session's materialized persistent objects when the session is disconnected: false => they become temporary objects, hence may be accessed in the normal way; and true => they are reverted to proxies, hence complain when accessed Class Variables: PolicyRegistry <Dictionary key: Symbol value: LensPolicy> maps names to registered policies Standard Policies: The ObjectLens provides a set of standard policies that are expected to suffice for a wide variety of application scenarios. Application developers may easily develop and use custom policies, as well. Standard policies are as follows: - AutoStart: transactions start automatically on the first operation requiring transaction, specifically adds, removes, updates, and locking. Objects may be read outside of a transaction, but may become stale unless explicitly locked; transactions may be explicitly started with begin. - SerializableAutoStart: like AutoStart, but objects are protected against staleness by being automatically locked, and all updates are done atomically. - Serializable: like SerializableAutoStart, but transactions must be begun explicitly, and objects read outside transactions aren't locked, but are reverted on transaction begin. - Mixed: transactions are explicitly begun. Objects read within transactions are locked, and those read outside are not locked. Changes made outside transactions take effect immediately, in effect are implicitly wrapped in their own transaction. - BrowseUpdate: like Mixed, but attempts to change objects when not in a transaction raise exceptions. The default policy for data models is Mixed.
</comment> <class> <name>InconsistentMethod</name> <environment>Lens</environment> <super>Lens.LensResumableException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.InconsistentMethod
InconsistentMethod is used to indicate that inconsistent access methods are used.
</comment> <class> <name>LensTransactionPolicy</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none name delayUpdatesUntilCommit underlyingIsolationLevel presentedIsolationLevel verifyAtPostPolicy <imports></imports> <category>Lens-Private-Object Manager</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensTransactionPolicy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of LensTransactionPolicies (hereinafter "policies") declaratively specify what kind of transaction semantics the ObjectLens will use. Policies may be named by data models; when a data model creates a new session, it passes the named policy (if it contains a name) to the session. An application may dynamically replace or modify a session's policy at runtime, allowing for time-varying policies. Policies specify the following: - what isolation level this policy affords the user; - what underlying isolation level this policy relies on; -whether or not to delay updates until transaction commit time; and - how should the Lens verify against update or read conflicts. Instance Variables: name <Symbol> name under which transaction policies may be registered and later retrieved presentedIsolationLevel <Symbol> what isolation level this policy affords the user underlyingIsolationLevel <Symbol> what underlying isolation level this policy relies on delayUpdatesUntilCommit <Boolean> determines whether the posting of updates should be postponed. verifyAtPostPolicy < #never | #asSpecifiedInDataModel > how should the Lens verify against update or read conflicts. Class Variables: PolicyRegistry <IdentityDictionary key: Symbol value: LensPolicy> maps names to registered policies
</comment> <class> <name>DefinitionError</name> <environment>Lens</environment> <super>Lens.LensException</super> <private>false</private> none <imports></imports> <category>Lens-Interface</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.DefinitionError
DefinitionError is used to indicate that a type definition error occured.
</comment> <class> <name>LensAggregateSurrogate</name> <environment>Lens</environment> <super>Lens.LensOperationSurrogate</super> <private>false</private> none <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <comment> Lens.LensAggregateSurrogate
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instances of IWFunctionSurrogate represent computations of "aggregate" functions in the database, such as Average, Sum, or Max.
</comment> <name>BooleanType</name> <environment>Lens.LensQuerySurrogate</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>FloatType</name> <environment>Lens.LensQuerySurrogate</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>DateType</name> <environment>Lens.LensQuerySurrogate</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>StringType</name> <environment>Lens.LensQuerySurrogate</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IntegerType</name> <environment>Lens.LensQuerySurrogate</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>TypeViolationSignal</name> <environment>Lens.LensType</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>DefinitionErrorSignal</name> <environment>Lens.LensType</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>VariableUndefinedSignal</name> <environment>Lens.LensType</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>PolicyRegistry</name> <environment>Lens.LensPolicy</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>OperatorTable</name> <environment>Lens.LensSQLTransporter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>ErrorWhilePostingSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CannotStoreTypeOfObjectSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CannotChangePolicyWhileConnectedSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>RowForObjectNotFoundSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>LensSessionIsDisconnectedSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>InappropriateOperationSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>OpenLensSessions</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>SerialNumberRequestSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>UnhandledCircularReferenceSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>LensSessionIsPausedSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>UntransactedOperationSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>OverlappingVariablesValueConflictSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>DoNotProceedSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>OptimisticConflictDetectedSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>TriggeringWhenNotOpenSignal</name> <environment>Lens.LensSession</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>SelectAllBlocks</name> <environment>Lens.QueryOperation</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>QueryErrorSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>InvalidPredicateSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>ObjectNotUniquelyIdentifiedSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>ObjectInAnotherLensContainerSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>InvalidAggregateFunctionSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CannotUpdateSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>ObjectNotPersistentSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CannotQueryLocalVariableSignal</name> <environment>Lens.LensContainer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>SizeBlocks</name> <environment>Lens.QueryOperationAccessor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IsCanonicalVariableMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>GeneratesMutatorMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IsClassDescriptorMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IsNotNilMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>InconsistentMethodSignal</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>GeneratesAccessorMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IsMappedMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>HasNonoverlappedNullableVariablesMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CheckIfModifiedMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CheckAlwaysMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IndexMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>OverlapsOtherVariablesMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>IsIdMask</name> <environment>Lens.LensStructureVariable</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>CachedScope</name> <environment>Lens.LensCompiler</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>PolicyRegistry</name> <environment>Lens.LensTransactionPolicy</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>DataDefinitionErrorSignal</name> <environment>Lens.LensDataModel</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>DataDefinitionWarningSignal</name> <environment>Lens.LensDataModel</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Dirty</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>PendingRemoval</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>PersistenceState</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Removed</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Added</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Persistent</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Registry</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <name>Clean</name> <environment>Lens.LensGlobalDescriptor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Lens-Runtime</package> </attributes> <methods> Lens.LensAbsentee <category>private-ObjectLens</category>
externalId "Answer the externalId for anObject, or nil if temporary." | gd | ^(gd := self globalDescriptor) == nil ifTrue: [nil] ifFalse: [gd externalId]
globalDescriptor "Answer the receiver's global descriptor if it has one." ^LensGlobalDescriptor at: self ifAbsent: [nil]
hasUnpostedUpdates "Answer whether object has unposted updates." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectHasUnpostedUpdates]
isAdded "Answer if receiver is added." | gd | ^(gd := self globalDescriptor) ~= nil and: [gd objectIsAdded]
isDirtyObject "Answer whether object is persistent and the row has been updated in the current transaction. This does not reflect pending updates which have yet to be posted to the database." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectIsDirty] "THIS METHOD USED TO BE CALLED isDirty. CHANGED SINCE THIS isDirty IS NOT SENT ANYWHERE, AND isDirty IS IMPLEMENTED INCONSISTENTLY WITHIN THE Lens (i.e. LensDataManager isDirty means the UI is not up to date. The only send of isDirty is in LensDataManager and is used to ask if the UI needs updating)."
isPersistent "Answer if receiver is persistent." | gd | ^(gd := self globalDescriptor) ~= nil and: [gd objectIsPersistent]
isRemoved "Answer if receiver is removed." | gd | ^(gd := self globalDescriptor) ~= nil and: [gd objectIsRemoved]
isTransient "Answer true if receiver does not correspond to a specific row in a table." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectIsPersistent not]
lensContainer "Answer the container containing receiver, or nil if none can be found." | gd | ^(gd := self globalDescriptor) notNil ifTrue: [ gd lensContainer ] ifFalse: [ nil ]
lensSession "Answer the LensSession containing receiver, or nil if none can be found." | lc | ^(lc := self lensContainer) == nil ifTrue: [nil] ifFalse: [lc lensSession]
</methods> <methods> Lens.LensAbsentee <category>system primitives</category>
allOwners "Answer an Array of all objects that reference the receiver prior to the invocation of this method." ^self allOwnersWeakly: false
allOwnersWeakly: placeInWeakContainer "Answer a collection of all objects that reference the receiver prior to the invocation of this primitive. This collection will be a WeakArray if the argument is true and an Array otherwise. Fails if we cannot allocate a collection large enough to contain all such objects or if the argument is not a boolean." <primitive: 403> self primitiveFailed
become: otherObject "Swap the instance pointers of the receiver and the argument, otherObject. All variables in the entire system that used to point to the receiver now point to the argument, and vice-versa. Fail if either object is a SmallInteger. Answer with the argument which is now the same instance pointer that formerly denoted the receiver. Essential. See documentation in Object metaclass." <primitive: 72> self primitiveFailed
firstOwner "Answer some object which points at self. This primitive can be used with 'ownerAfter: ' to enumerate all the objects which point at self. For example see SystemDictionary>quickPointersTo:do:." <primitive: 197> ^nil
instVarAt: index "Answer with a fixed variable in an object. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Essential. See documentation in Object metaclass." <primitive: 73> "Access beyond fixed variables." ^self basicAt: index - self class instSize
instVarAt: anInteger put: anObject "Store a value into a fixed variable in the receiver. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Answer with the value stored as the result. (Using this message violates the principle that each object has sovereign control over the storing of values into its instance variables.) Essential. See documentation in Object metaclass. " <primitive: 74> "Access beyond fixed fields" ^self basicAt: anInteger - self class instSize put: anObject
nextInstance "Answer with the next instance after the receiver in the enumeration of all instances of this class. Fail if all instances have been enumerated. Essential. See documentation in Object metaclass." <primitive: 78> ^nil
nextObject "Answer with the next object following the receiver in the enumeration of all non-immediate objects. Fail if there is no such object or if the receiver is an immediate object. See Object class someObject." <primitive: 531> ^0
</methods> <methods> Lens.LensAbsentee <category>message handling</category>
perform: aSymbol "Send the receiver the unary message indicated by the argument. The argument is the selector of the message. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not zero." <primitive: 511> ^self perform: aSymbol withArguments: (Array new: 0)
perform: aSymbol with: anObject "Send the receiver the keyword or binary message indicated by the arguments. The first argument is the selector of the message. The other argument is the argument of the message to be sent. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not one." <primitive: 512> ^self perform: aSymbol withArguments: (Array with: anObject)
perform: aSymbol with: firstObject with: secondObject "Send the receiver the keyword message indicated by the arguments. The first argument is the selector of the message. The other arguments are the arguments of the message to be sent. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not two." <primitive: 513> ^self perform: aSymbol withArguments: (Array with: firstObject with: secondObject)
perform: aSymbol with: firstObject with: secondObject with: thirdObject "Send the receiver the keyword message indicated by the arguments. The first argument is the selector of the message. The other arguments are the arguments of the message to be sent. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not three." <primitive: 514> ^self perform: aSymbol withArguments: (Array with: firstObject with: secondObject with: thirdObject)
perform: selector withArguments: anArray "Send the receiver the message indicated by the arguments. The argument selector is the selector of the message. The arguments of the message are the elements of anArray. Invoke messageNotUnderstood: if the selector is not understood by the receiver. Fail the primitive if anArray is not an Array with the same number of elements as the number of arguments expected by the selector." <primitive: 510> ^self primitiveFailed
performMethod: method "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The method must be expecting no arguments." ^self performMethod: method arguments: #()
performMethod: method arguments: args "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other argument is the list of arguments of the method. The number of arguments expected by the method must match the size of the Array." ^method valueWithReceiver: self arguments: args
performMethod: method with: arg1 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other argument is the argument of the method. The method must be expecting one argument." ^self performMethod: method arguments: (Array with: arg1)
performMethod: method with: arg1 with: arg2 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other arguments are the arguments of the method. The method must be expecting two arguments." ^self performMethod: method arguments: (Array with: arg1 with: arg2)
performMethod: method with: arg1 with: arg2 with: arg3 "Evaluate the first argument, a CompiledMethod, with the receiver as receiver. The other arguments are the arguments of the method. The method must be expecting three arguments." ^self performMethod: method arguments: (Array with: arg1 with: arg2 with: arg3)
</methods> <methods> Lens.LensAbsentee <category>private</category>
effectiveClass "Answer the class of the receiver." ^self class
IsQS "Answer whether receiver is a QS." ^false
myDependents "Answer the receiver's dependents or nil." ^Object dependentsFields at: self ifAbsent: [nil]
myDependents: dependentsOrNil "Set the receiver's dependents to aDependentsCollection" dependentsOrNil == nil ifTrue: [Object dependentsFields removeKey: self ifAbsent: []] ifFalse: [Object dependentsFields at: self put: dependentsOrNil]
nilFields "Store nil into all pointer fields of the receiver." self class isPointers ifFalse: [^self]. 1 to: self basicSize do: [:index | self basicAt: index put: nil]. 1 to: self class instSize do: [:index | self instVarAt: index put: nil].
</methods> <methods> Lens.LensAbsentee <category>printing</category>
basicPrintOn: aStream "Append to the argument aStream a sequence of characters that describes the receiver. This is overriden only by ClassDescription." | title | title := self class name. aStream nextPut: $a. (title at: 1) isVowel ifTrue: [aStream nextPut: $n]. aStream nextPut: $ . aStream print: self class
basicPrintString "Answer a String whose characters are a description of the receiver." | aStream | aStream := WriteStream on: (String new: 16). self basicPrintOn: aStream. ^aStream contents
printOn: aStream "Append to the argument aStream a sequence of characters that identifies the receiver." | title | title := self class name. aStream nextPutAll: ((title at: 1) isVowel ifTrue: [(#an << #lensRuntime >> 'an ')] ifFalse: [(#a << #lensRuntime >> 'a ')]) asString. aStream print: self class
printString "Answer a string describing the receiver." | aStream | aStream := WriteStream on: (String new: 16). self printOn: aStream. ^aStream contents
</methods> <methods> Lens.LensAbsentee <category>comparing</category>
= anObject "Answer whether the receiver and the argument represent the same object. If = is redefined in any subclass, consider also redefining the message hash." ^self == anObject
== anObject "Answer true if the receiver and the argument are the same object (have the same object pointer) and false otherwise. Do not redefine the message == in any other class! Essential. No Lookup. See documentation in Object metaclass." <primitive: 110> self primitiveFailed
hash "Answer with a SmallInteger unique to the receiver. Fail if the receiver is a SmallInteger. Essential. See documentation in Object metaclass." <primitive: 75> self primitiveFailed
identityHash "Answer a SmallInteger whose value reflects the identity, not the contents, of the receiver. Essential. See documentation in Object metaclass." <primitive: 75> self primitiveFailed
~= anObject "Answer whether the receiver and the argument represent the same object. If = is redefined in any subclass, consider also redefining the message hash." ^self ~~ anObject
~~ anObject "Answer true if the receiver and the argument are not the same object (have the same object pointer) and false otherwise." ^(self == anObject) not
</methods> <methods> Lens.LensAbsentee <category>testing</category>
isAnything "Answer whether receiver is a value that matches anything." ^self class == Object
isImmediate "Answer true if this object has immediate representation." ^false
isLensType "Answer whether the receiver behaves as a type." ^false
isNil "Coerce nil to true and everything else to false. UndefinedObject overrides with ^true" ^false
isNilExternalId "Answer whether receiver is considered nil when used as an external ID." ^false
isNothing "Answer whether receiver is a value that represents no specific object." ^self == nil or: [self class == Object or: [self class == BlockClosure]]
isProxy ^false
notNil "Coerce nil to false and everything else to true. UndefinedObject overrides with ^false" ^true
</methods> <methods> Lens.LensAbsentee <category>prototypes</category>
class "Answer the object which is the receiver's class. Essential. See documentation in Object metaclass." <primitive: 111> self primitiveFailed
isKindOf: aClass "Answer a Boolean as to whether the class, aClass, is a superclass or class of the receiver." ^self class includesBehavior: aClass
</methods> <methods> Lens.LensAbsentee <category>accessing</category>
basicSize "Answer the number of indexable fields in the receiver. This value is the same as the largest legal subscript. Do not override in any subclass." <primitive: 62> "The number of indexable fields of fixed-length objects is 0" ^0
</methods> <methods> Lens.LensAbsentee <category>error handling</category>
doesNotUnderstand: aMessage "The default behavior is to create a Notifier containing the appropriate message and to allow the user to open a Debugger. Subclasses can override this message in order to modify this behavior." Object messageNotUnderstoodSignal raiseRequestWith: aMessage errorString: ((#messageNotUnderstood << #lens >> 'Message not understood: <1s>') expandMacrosWith: aMessage selector). ^self perform: aMessage selector withArguments: aMessage arguments "3 zork."
error: aString "Raise a non-proceedable signal that indicates an error with the argument as the message. This additional message is the one a subclass should override in order to change the handling of errors. Remove any trailing spaces from aString, since we know we don't want other strings appended to this one." | lastNonSpace | lastNonSpace := aString findLast: [:ch | ch ~= Character space]. ^self errorSignal raiseErrorString: (aString copyFrom: 1 to: lastNonSpace) "nil error: 'error message'."
errorSignal "Answer the Signal used for miscellaneous errors (self error:)." ^Object errorSignal
halt "This is a simple message to use for inserting breakpoints during debugging. The debugger is opened by raising a signal. This gives a chance to restore invariants related to multiple processes." Object haltSignal raiseRequestWith: thisContext errorString: (#HaltEncountered << #lens >> 'Halt encountered.') "nil halt."
</methods> <methods> Lens.LensAbsentee class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^(self isBits or: [self == Object]) ifTrue: [LensDataType] ifFalse: [self isVariable ifFalse: [LensStructureType] ifTrue: [LensType definitionErrorSignal raiseWith: (Array with: self) errorPattern: (#errCreatingTypeForVariable << #lens >> 'Can''t create type for <1p>, which is a variable non-collection')]]
</methods> <methods> Lens.LensQuerySurrogate <category>testing</category>
IsAggregateSurrogate ^false
isArbitraryFunctionSurrogate "Answer whether receiver is an arbitrary function surrogate." ^false
IsBoolean "Answer whether receiver's type is Boolean." ^type memberClass == Boolean
IsCommandVariableSurrogate "Answer whether receiver is a command variable surrogate." ^false
IsContainerSurrogate "Answer whether receiver is a container surrogate." ^false
IsExpressionSurrogate "Answer whether receiver is an expression surrogate." ^false
IsObjectSurrogate "Answer whether receiver is an object surrogate." ^false
IsOperationSurrogate "Answer whether receiver is a operation surrogate." ^false
IsQS "Answer whether receiver is a query surrogate." ^true
IsRealFunctionSurrogate ^false
IsVariableSurrogate "Answer whether receiver is a variable surrogate." ^false
respondsToArithmetic "Answer whether the object responds to the numeric (#+, #-, #*, #/) protocol as defined in the class ArithmeticValue" LensContainer queryErrorWith: (Array with: self printString) errorPattern: (#errSelectionBlockComparison << #lens >> 'Query error: Selection block comparison has path <1p> on righthand size.<n>Move the path to the lefthand side.')
</methods> <methods> Lens.LensQuerySurrogate <category>private</category>
compare: operator with: valueOrSurrogate "Answer an operationSurrogate that symbolically represents the application of the comparison operator to the receiver and valueOrSurrogate." | operation | operation := self operate: operator with: valueOrSurrogate. operation Type: BooleanType. ^operation
operate: operator with: valueOrSurrogate "Answer an operationSurrogate that symbolically represents the application of the computation operator to the receiver and valueOrSurrogate." "Check type compatibility" valueOrSurrogate == nil ifFalse: [ | valueClass | valueClass := valueOrSurrogate effectiveClass. valueClass == ValueHolder ifTrue: [valueClass := valueOrSurrogate value class]. (type memberClass commonSuperclass: valueClass) == Object ifTrue: [type memberClass == Boolean ifTrue: [ LensType typeViolationSignal raiseWith: (Array with: valueOrSurrogate) errorPattern: (#notBoolean << #lens >> '<1p> isn''t boolean-valued')] ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: self with: valueOrSurrogate) errorPattern: (#incompatibleTypes << #lens >> '<1p> and <2p> have incompatible types')]]]. ^LensOperationSurrogate new left: self operator: operator right: (self Surrogatize: valueOrSurrogate)
perform: aSymbol with: anObject "Send the receiver the keyword or binary message indicated by the arguments. The first argument is the selector of the message. The other argument is the argument of the message to be sent. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not one." <primitive: 512> ^self perform: aSymbol withArguments: (Array with: anObject)
Surrogatize: valueOrSurrogate "Make sure we have a valid surrogate, which can be either a surrogate or a valueHolder, immediate values are put inside valueHolders" ^valueOrSurrogate isImmediate ifTrue: [ValueHolder with: valueOrSurrogate] ifFalse: [valueOrSurrogate]
</methods> <methods> Lens.LensQuerySurrogate <category>user interface</category>
inspect "Create and schedule an Inspector in which the user can examine the receiver's variables. This method should not be overwritten." Inspector openOn: self
</methods> <methods> Lens.LensQuerySurrogate <category>accessing</category>
effectiveClass "Answer the class of objects represented by the receiver." ^type memberClass
Type "Answer the type of objects represented by the receiver." ^type
Type: newType "Initialize the type of objects represented by the receiver." type := newType
</methods> <methods> Lens.LensQuerySurrogate <category>system operations</category>
perform: aSymbol "Send the receiver the unary message indicated by the argument. The argument is the selector of the message. Invoke messageNotUnderstood: if the number of arguments expected by the selector is not zero." <primitive: 511> ^self perform: aSymbol withArguments: (Array new: 0)
</methods> <methods> Lens.LensQuerySurrogate class <category>class initialization</category>
initialize "LensQuerySurrogate initialize" "The size for strings of unknown size is set to 256, hoping that it's big enough" IntegerType := Integer type. FloatType := Float type. BooleanType := Boolean type. DateType := Timestamp type. StringType := String type maxColumnConstraint: 256.
</methods> <methods> Lens.LensExpressionSurrogate <category>mathematical functions</category>
abs ^LensFunctionSurrogate name: #abs args: (Array with: self) type: self Type
ceil ^LensFunctionSurrogate name: #ceil args: (Array with: self) type: self Type
cos ^LensFunctionSurrogate name: #cos args: (Array with: self) type: FloatType
cosh ^LensFunctionSurrogate name: #cosh args: (Array with: self) type: FloatType
exp ^LensFunctionSurrogate name: #exp args: (Array with: self) type: self Type
floor ^LensFunctionSurrogate name: #floor args: (Array with: self) type: self Type
ln ^LensFunctionSurrogate name: #ln args: (Array with: self) type: self Type
log: base ^LensFunctionSurrogate name: #log: args: (Array with: self with: (self Surrogatize: base)) type: self Type
mod: by ^LensFunctionSurrogate name: #mod: args: (Array with: self with: (self Surrogatize: by)) type: self Type
power: power ^LensFunctionSurrogate name: #power: args: (Array with: self with: (self Surrogatize: power)) type: self Type
round ^LensFunctionSurrogate name: #round args: (Array with: self) type: IntegerType
round: decimalPlaces ^LensFunctionSurrogate name: #round: args: (Array with: self with: (self Surrogatize: decimalPlaces)) type: self Type
sign ^LensFunctionSurrogate name: #sign args: (Array with: self) type: IntegerType
sin ^LensFunctionSurrogate name: #sin args: (Array with: self) type: FloatType
sinh ^LensFunctionSurrogate name: #sinh args: (Array with: self) type: FloatType
sqrt ^LensFunctionSurrogate name: #sqrt args: (Array with: self) type: self Type
tan ^LensFunctionSurrogate name: #tan args: (Array with: self) type: FloatType
tanh ^LensFunctionSurrogate name: #tanh args: (Array with: self) type: FloatType
trunc: decimalPlaces ^LensFunctionSurrogate name: #trunc: args: (Array with: self with: (self Surrogatize: decimalPlaces)) type: self Type
</methods> <methods> Lens.LensExpressionSurrogate <category>arbitrary functions</category>
charFunction: named ^LensArbitraryFunctionSurrogate name: named args: (Array with: self) type: StringType
charFunction: named with: arg1 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1)) type: StringType
charFunction: named with: arg1 with: arg2 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2)) type: StringType
charFunction: named with: arg1 with: arg2 with: arg3 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2) with: (self Surrogatize: arg3)) type: StringType
charFunction: named with: arg1 with: arg2 with: arg3 with: arg4 | args | args := Array new: 5. args at: 1 put: self. args at: 2 put: (self Surrogatize: arg1). args at: 3 put: (self Surrogatize: arg2). args at: 4 put: (self Surrogatize: arg3). args at: 5 put: (self Surrogatize: arg4). ^LensArbitraryFunctionSurrogate name: named args: args type: StringType
dateFunction: named ^LensArbitraryFunctionSurrogate name: named args: (Array with: self) type: DateType
dateFunction: named with: arg1 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1)) type: DateType
dateFunction: named with: arg1 with: arg2 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2)) type: DateType
dateFunction: named with: arg1 with: arg2 with: arg3 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2) with: (self Surrogatize: arg3)) type: DateType
dateFunction: named with: arg1 with: arg2 with: arg3 with: arg4 | args | args := Array new: 5. args at: 1 put: self. args at: 2 put: (self Surrogatize: arg1). args at: 3 put: (self Surrogatize: arg2). args at: 4 put: (self Surrogatize: arg3). args at: 5 put: (self Surrogatize: arg4). ^LensArbitraryFunctionSurrogate name: named args: args type: DateType
floatFunction: named ^LensArbitraryFunctionSurrogate name: named args: (Array with: self) type: FloatType
floatFunction: named with: arg1 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1)) type: FloatType
floatFunction: named with: arg1 with: arg2 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2)) type: FloatType
floatFunction: named with: arg1 with: arg2 with: arg3 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2) with: (self Surrogatize: arg3)) type: FloatType
floatFunction: named with: arg1 with: arg2 with: arg3 with: arg4 | args | args := Array new: 5. args at: 1 put: self. args at: 2 put: (self Surrogatize: arg1). args at: 3 put: (self Surrogatize: arg2). args at: 4 put: (self Surrogatize: arg3). args at: 5 put: (self Surrogatize: arg4). ^LensArbitraryFunctionSurrogate name: named args: args type: FloatType
integerFunction: named ^LensArbitraryFunctionSurrogate name: named args: (Array with: self) type: IntegerType
integerFunction: named with: arg1 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1)) type: IntegerType
integerFunction: named with: arg1 with: arg2 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2)) type: IntegerType
integerFunction: named with: arg1 with: arg2 with: arg3 ^LensArbitraryFunctionSurrogate name: named args: (Array with: self with: (self Surrogatize: arg1) with: (self Surrogatize: arg2) with: (self Surrogatize: arg3)) type: IntegerType
integerFunction: named with: arg1 with: arg2 with: arg3 with: arg4 | args | args := Array new: 5. args at: 1 put: self. args at: 2 put: (self Surrogatize: arg1). args at: 3 put: (self Surrogatize: arg2). args at: 4 put: (self Surrogatize: arg3). args at: 5 put: (self Surrogatize: arg4). ^LensArbitraryFunctionSurrogate name: named args: args type: IntegerType
</methods> <methods> Lens.LensExpressionSurrogate <category>character functions</category>
ascii ^LensFunctionSurrogate name: #ascii args: (Array with: self) type: StringType.
concat: other ^LensFunctionSurrogate name: #concat: args: (Array with: self with: (self Surrogatize: other)) type: self Type
length ^LensFunctionSurrogate name: #length args: (Array with: self) type: IntegerType
lower ^LensFunctionSurrogate name: #lower args: (Array with: self) type: self Type
soundex ^LensFunctionSurrogate name: #soundex args: (Array with: self) type: self Type
substringAt: starting length: length ^LensFunctionSurrogate name: #substringAt:length: args: (Array with: self with: (self Surrogatize: starting) with: (self Surrogatize: length)) type: self Type
upper ^LensFunctionSurrogate name: #upper args: (Array with: self) type: self Type
</methods> <methods> Lens.LensExpressionSurrogate <category>comparing</category>
, valueOrSurrogate ^LensOperationSurrogate new left: self operator: #, right: valueOrSurrogate
< aValueOrSurrogate ^self compare: #< with: aValueOrSurrogate
<= aValueOrSurrogate ^self compare: #<= with: aValueOrSurrogate
= aValueOrSurrogate ^self compare: #= with: aValueOrSurrogate
> aValueOrSurrogate ^self compare: #> with: aValueOrSurrogate
>= aValueOrSurrogate ^self compare: #>= with: aValueOrSurrogate
and: block | aValueOrSurrogate | aValueOrSurrogate := block value. ^aValueOrSurrogate == true ifTrue: [self] ifFalse: [aValueOrSurrogate == false ifTrue: [false] ifFalse: [self operate: #& with: aValueOrSurrogate]]
between: min and: max ^(self >= min) & (self <= max)
in: collection "Answer a surrogate for inquiring if receiver is an element of collection." collection do: [:value | type checkIncludes: value]. ^self compare: #in: with: collection
isLike: aValueOrSurrogate ^self compare: #isLike: with: aValueOrSurrogate
isNil ^self compare: #isNil with: nil
notNil ^self compare: #notNil with: nil
or: block | aValueOrSurrogate | aValueOrSurrogate := block value. ^aValueOrSurrogate == true ifTrue: [self] ifFalse: [aValueOrSurrogate == false ifTrue: [false] ifFalse: [self operate: #| with: aValueOrSurrogate]]
~= aValueOrSurrogate ^(self = aValueOrSurrogate) not
</methods> <methods> Lens.LensExpressionSurrogate <category>logical operations</category>
& aValueOrSurrogate ^aValueOrSurrogate == true ifTrue: [self] ifFalse: [aValueOrSurrogate == false ifTrue: [false] ifFalse: [self operate: #& with: aValueOrSurrogate]]
not ^self operate: #not with: nil
| aValueOrSurrogate ^aValueOrSurrogate == true ifTrue: [true] ifFalse: [aValueOrSurrogate == false ifTrue: [self] ifFalse: [self operate: #| with: aValueOrSurrogate]]
</methods> <methods> Lens.LensExpressionSurrogate <category>orderBy</category>
ascending "Mark for ascending ordering." isAscending := true
descending "Mark for descending ordering." isAscending := false
IsAscending "Answer whether sorting on receiver should be ascending." ^isAscending isNil ifTrue: [true] ifFalse: [isAscending]
</methods> <methods> Lens.LensExpressionSurrogate <category>date functions</category>
toDate ^LensFunctionSurrogate name: #toDate args: (Array with: self) type: DateType
toDate: format ^LensFunctionSurrogate name: #toDate: args: (Array with: self with: (self Surrogatize: format)) type: DateType
</methods> <methods> Lens.LensExpressionSurrogate <category>arithmetic</category>
* aValueOrSurrogate ^self operate: #* with: aValueOrSurrogate
+ aValueOrSurrogate ^self operate: #+ with: aValueOrSurrogate
- aValueOrSurrogate ^self operate: #- with: aValueOrSurrogate
/ aValueOrSurrogate ^self operate: #/ with: aValueOrSurrogate
</methods> <methods> Lens.LensExpressionSurrogate <category>testing</category>
IsExpressionSurrogate "Answer whether receiver is an expression surrogate." ^true
</methods> <methods> Lens.LensExpressionSurrogate <category>conversion functions</category>
toChar ^LensFunctionSurrogate name: #toChar args: (Array with: self) type: StringType
toChar: format ^LensFunctionSurrogate name: #toChar: args: (Array with: self with: (self Surrogatize: format)) type: StringType
</methods> <methods> Lens.LensExpressionSurrogate <category>aggregate operations</category>
Average "Answer the average of the expressions's values." ^LensAggregateSurrogate apply: #Average to: self of: type
Count "Answer the number of non-null values." ^LensAggregateSurrogate apply: #Count to: self of: IntegerType
Max "Answer the maximum of the values." ^LensAggregateSurrogate apply: #Max to: self of: type
Min "Answer the minimum of the values." ^LensAggregateSurrogate apply: #Min to: self of: type
StandardDeviation "Answer the standard deviation of the values." ^LensAggregateSurrogate apply: #StandardDeviation to: self of: FloatType
Sum "Answer the summation of the values." ^LensAggregateSurrogate apply: #Sum to: self of: type
Variance "Answer the variance of the values." ^LensAggregateSurrogate apply: #Variance to: self of: FloatType
</methods> <methods> Lens.LensCommandVariable <category>initialize-release</category>
name: aName type: aType "Initialize the receiver's state." name := aName. type := aType.
</methods> <methods> Lens.LensCommandVariable <category>accessing</category>
Attribute ^variable
Destination "Answer the object surrogate representing the receiver's value." ^nil
name "Answer the receiver's name." ^name
name: newName "Set the receiver's name to newName." name := newName
variable: aVariable variable := aVariable
</methods> <methods> Lens.LensCommandVariable <category>symbolic evaluation</category>
AccumulateAttributesIn: attributeSet "Accumulate all accessed attributes into attributeSet."
</methods> <methods> Lens.LensCommandVariable <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printTypeOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensCommandVariable <category>private</category>
printTypeOn: stream stream nextPutAll: name
</methods> <methods> Lens.LensCommandVariable <category>testing</category>
IsCommandVariableSurrogate "Answer whether receiver is a command variable surrogate." ^true
</methods> <methods> Lens.LensLinkedDictionary <category>private</category>
atBucket: bucket unprotectedPut: aLensLinkedAssociation "Assume that aLensLinkedAssociation is not in the receiver and add it without checking to make sure." | first | (first := hashTable at: bucket) == nil ifTrue: [ bucketTally := bucketTally + 1 ]. aLensLinkedAssociation nextLink: first. hashTable at: bucket put: aLensLinkedAssociation. tally := tally + 1
changeCapacityTo: newCapacity "Change the size of the receiver to newCapacity. The receiver will be regrown if necessary to fit its contents." | newTable newTableSize newBucketTally | newTable := Array new: (self class goodSizeFrom: newCapacity). newTableSize := newTable size. newBucketTally := 0. 1 to: hashTable size do: [ :bucket | | next | next := hashTable at: bucket. [next == nil] whileFalse: [ | probe newBucket newEntry first | probe := next. next := probe nextLink. newBucket := self hashBucketFor: probe key hash boundedBy: newTableSize. newEntry := probe copy. (first := newTable at: newBucket) == nil ifTrue: [ newBucketTally := newBucketTally + 1 ]. newEntry nextLink: first. newTable at: newBucket put: newEntry ] ]. hashTable := newTable. bucketTally := newBucketTally.
findEntryOrNil: key "Look for the key in the receiver. If it is found, answer the the association containing the key, otherwise answer nil." | ht probe | ht := hashTable. probe := ht at: (self hashBucketFor: key hash boundedBy: ht size). [probe == nil] whileFalse: [ (probe key lensEqual: key) ifTrue: [ ^probe ]. probe := probe nextLink ]. ^nil
fullCheck "If there is insufficient capacity in the receiver to do efficient lookups, then grow." "Require 25% free slots." | cap | (cap := hashTable size) - bucketTally <= (cap // 4) ifTrue: [self grow]
growSize "Answer an amount by which the receiver should grow to make room for more elements." ^self capacity max: 101
hashBucketFor: aHashValue boundedBy: length "Find the place where we should start the search. Optimize for relatively small dictionaries." "Objects whose hashes are based on their identityHash are restricted by current implementations to the range 0 to some small number like 16383. For collections whose sizes are much larger than this number, using the hash as-is would tend to cause collisions at the low end, leading to performance bottlenecks. To compensate, we use an algorithm to spread small hash values more evenly across large collections. Large hash values, however, are used as-is, under the assumption that they are more likely to have been adequately spread, and also to avoid LargeInteger performance loss." ^(length > SmallCollectionLimit and: [aHashValue <= ObjectMemory maximumIdentityHashValue]) ifTrue: [aHashValue * (length // SmallCollectionLimit + 1) \\ length + 1] ifFalse: [aHashValue \\ length + 1]
trim "Adjust the receiver's capacity to fit its contents without wasting space (but not so much as to be inefficient on lookup)." "Leave about 33% empty slots." self changeCapacityTo: bucketTally + (bucketTally // 2)
unprotectedAdd: anAssociation "Include anAssociation as one of the receiver's elements." | key bucket probe | key := anAssociation key. bucket := self hashBucketFor: key hash boundedBy: hashTable size. probe := hashTable at: bucket. [probe == nil] whileFalse: [ (probe key lensEqual: key) ifTrue: [ probe value: anAssociation value. ^self ]. probe := probe nextLink ]. self atBucket: bucket unprotectedPut: (LensLinkedAssociation key: key value: anAssociation value)
unprotectedAt: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject." | bucket probe | bucket := self hashBucketFor: key hash boundedBy: hashTable size. probe := hashTable at: bucket. [probe == nil] whileFalse: [ (probe key lensEqual: key) ifTrue: [ probe value: anObject. ^anObject ]. probe := probe nextLink ]. self atBucket: bucket unprotectedPut: (LensLinkedAssociation key: key value: anObject). ^anObject
unprotectedRemoveKey: key ifAbsent: aBlock "Remove key from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value associated with key." | bucket head probe prior | bucket := self hashBucketFor: key hash boundedBy: hashTable size. (head := hashTable at: bucket) == nil ifTrue: [ ^aBlock value ]. probe := head. [probe key lensEqual: key] whileFalse: [ prior := probe. (probe := prior nextLink) == nil ifTrue: [ ^aBlock value ] ]. probe == head ifTrue: [ | next | (next := probe nextLink) == nil ifTrue: [ bucketTally := bucketTally - 1 ]. hashTable at: bucket put: next ] ifFalse: [ prior nextLink: probe nextLink ]. tally := tally - 1. ^probe value
</methods> <methods> Lens.LensLinkedDictionary <category>private-shouldNotImplement</category>
atNewIndex: index put: anObject ^self shouldNotImplement
find: anObject ifAbsent: aBlock ^self shouldNotImplement
findElementOrNil: anObject ^self shouldNotImplement
findKey: key ifAbsent: aBlock ^self shouldNotImplement
findKey: key ifAbsentRaise: aSignal ^self shouldNotImplement
fixCollisionsFrom: index ^self shouldNotImplement
initialIndexFor: aHashValue boundedBy: length ^self shouldNotImplement
noCheckAdd: anAssociation ^self shouldNotImplement
rehash ^self shouldNotImplement
swap: oneElement with: otherElement ^self shouldNotImplement
</methods> <methods> Lens.LensLinkedDictionary <category>accessing</category>
associationAt: key ifAbsent: aBlock "Answer the association at key. If key is not found, answer the result of evaluating aBlock." | entry | (entry := self findEntryOrNil: key) == nil ifTrue: [ ^aBlock value ]. ^entry
at: key ifAbsent: aBlock "Answer the value at key. If key is not found, answer the result of evaluating aBlock." | entry | entry := self findEntryOrNil: key. ^entry == nil ifTrue: [ aBlock value ] ifFalse: [ entry value ]
at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." key == nil ifTrue: [ ^self subscriptBoundsError: key ]. self unprotectedAt: key put: anObject. self fullCheck. ^anObject
bindingFor: varName ^self shouldNotImplement
capacity "Answer how much space the receiver has in the hash table." ^hashTable size
</methods> <methods> Lens.LensLinkedDictionary <category>dictionary removing</category>
removeKey: key ifAbsent: aBlock "Remove key from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value associated with key." ^self unprotectedRemoveKey: key ifAbsent: aBlock
</methods> <methods> Lens.LensLinkedDictionary <category>dictionary enumerating</category>
associationsDo: aBlock "Evaluate aBlock for each of the receiver's key/value associations." | ht | tally = 0 ifTrue: [ ^self ]. ht := hashTable. 1 to: ht size do: [ :bucket | | probe | probe := ht at: bucket. [probe == nil] whileFalse: [ aBlock value: probe. probe := probe nextLink ] ]
bindingsDo: aBlock ^self shouldNotImplement
</methods> <methods> Lens.LensLinkedDictionary <category>enumerating</category>
do: aBlock "Evaluate aBlock with each of the receiver's elements as the argument." | ht | tally = 0 ifTrue: [ ^self ]. ht := hashTable. 1 to: ht size do: [ :bucket | | probe | probe := ht at: bucket. [probe == nil] whileFalse: [ aBlock value: probe value. probe := probe nextLink ] ]
keysAndValuesDo: aBlock "Evaluate aBlock with each of the receiver's key/value pairs as the arguments." | ht | tally = 0 ifTrue: [ ^self ]. ht := hashTable. 1 to: ht size do: [ :bucket | | probe | probe := ht at: bucket. [probe == nil] whileFalse: [ aBlock value: probe key value: probe value. probe := probe nextLink ] ]
</methods> <methods> Lens.LensLinkedDictionary <category>dictionary testing</category>
includesKey: key "Answer whether the receiver has a key equal to the argument, key." ^(self findEntryOrNil: key) notNil
</methods> <methods> Lens.LensLinkedDictionary <category>initialize-release</category>
initialCapacity: anInteger tally := 0. bucketTally := 0. hashTable := Array new: anInteger
</methods> <methods> Lens.LensLinkedDictionary <category>adding</category>
add: anAssociation "Include anAssociation as one of the receiver's elements. Answer anAssociation." anAssociation key == nil ifTrue: [ ^self subscriptBoundsError: nil ]. self unprotectedAdd: anAssociation. self fullCheck. ^anAssociation
</methods> <methods> Lens.LensLinkedDictionary <category>copying</category>
postCopy " Finish doing whatever is required, beyond a shallowCopy, to implement 'copy'. Answer the receiver. " hashTable := hashTable copy.
</methods> <methods> Lens.LensLinkedDictionary class <category>instance creation</category>
new "Create an instance of receiver." ^self new: 53
new: anInteger "Create an instance of receiver." anInteger >= 0 ifFalse: [ self improperCreationSizeSignal raiseWith: anInteger ]. ^self basicNew initialCapacity: (self goodSizeFrom: anInteger)
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>adding</category>
add: anAssociation "Include anAssociation as one of the receiver's elements. Answer anAssociation." anAssociation key == nil ifTrue: [ ^self subscriptBoundsError: nil ]. accessLock critical: [ self unprotectedAdd: anAssociation ]. self fullCheck. ^anAssociation
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>accessing</category>
at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." key == nil ifTrue: [ ^self subscriptBoundsError: key ]. accessLock critical: [ self unprotectedAt: key put: anObject ]. self fullCheck. ^anObject
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>private</category>
changeCapacityTo: newCapacity "Change the size of the receiver to newCapacity. The receiver will be regrown if necessary to fit its contents." accessLock critical: [ super changeCapacityTo: newCapacity ]
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>copying</category>
copy " Answer another instance just like the receiver. " ^accessLock critical: [super copy]
postCopy super postCopy. accessLock := Semaphore forMutualExclusion
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>dictionary removing</category>
removeKey: key ifAbsent: aBlock "Remove key from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value associated with key." ^accessLock critical: [ self unprotectedRemoveKey: key ifAbsent: aBlock ]
</methods> <methods> Lens.LensProtectedLinkedDictionary <category>initialize-release</category>
initialCapacity: anInteger super initialCapacity: anInteger. accessLock := Semaphore forMutualExclusion
</methods> <methods> Lens.LensResumableException class <category>testing</category>
mayResume ^true
</methods> <methods> Lens.LensTranscoder <category>evaluating</category>
applyTo: record in: objectLens "Evaluate the externalIdClosure on the record. If the record is nil, don't evaluate the block, answering nil." ^record == nil ifTrue: [nil] ifFalse: [block value: record value: objectLens ]
applyTo: record lensContainer: aContainer "Evaluate the decoder on the record. If the record is nil, don't evaluate the block, answering nil." ^record == nil ifTrue: [nil] ifFalse: [block value: record value: aContainer]
applyTo: blankRecord with: record lensContainer: aContainer "Evaluate the encoder / decoder on the record. If the blankRecord is nil, don't evaluate the block, answering nil." ^blankRecord == nil ifTrue: [nil] ifFalse: [block value: blankRecord value: record value: aContainer]
decodeFrom: record lensContainer: aContainer "Decode the record." ^block value: nil value: record value: aContainer
</methods> <methods> Lens.LensTranscoder <category>printing</category>
storeOn: aStream "This avoids an infinite loop that the inherited storeOn: was getting into. It is occasionally useful when trying to see pseudo-source-code for the receiver. It doesn't produce a reversable notation that could be used to recreate the receiver." | homeMethod | homeMethod := block method homeMethod. aStream nextPutAll: ((homeMethod mclass decompilerClass new decompileBlock: block method in: homeMethod mclass) formattedCode)
</methods> <methods> Lens.LensTranscoder <category>initialize</category>
with: aBlock block := aBlock
</methods> <methods> Lens.LensTranscoder class <category>instance creation</category>
dereferenceWithType: valueType ^self with: [:ignored :value :container | container lensSession objectOf: valueType withId: value]
forDecoder: decoder andClass: class ^self with: [:ignored :record :cont | decoder decodeFrom: record lensContainer: (cont lensSession containerOf: class) ]
forDecoders: decoders andClasses: containerClasses ^self with: [:ignored :record :cont | | thisSession class | thisSession := cont lensSession. 1 to: decoders size do: [ :i | class := containerClasses at: i. record at: i put: ((decoders at: i) decodeFrom: (record at: i) lensContainer: (class isNil ifTrue: [nil] ifFalse: [thisSession containerOf: class])) ]. record]
nullTransform ^self with: [:ignored :record :container | record]
sendMessage: selector ^self with: [:ignored :record :container | record notNil ifTrue: [record perform: selector]]
with: aBlock ^self new with: aBlock
</methods> <methods> Lens.LensColumnSizeConstraint <category>comparing</category>
= aConstraint ^self class == aConstraint hash and: [length = aConstraint length and: [encodingName = aConstraint encodingName]]
hash ^length hash + encodingName hash
</methods> <methods> Lens.LensColumnSizeConstraint <category>converting</category>
asInteger ^length
fromLiteralArrayEncoding: anArray length := anArray at: 2. encodingName := anArray at: 3
literalArrayEncoding "Return a literal suitable for reconstituting the receiver." ^Array with: self class fullyQualifiedReference with: length literalArrayEncoding with: encodingName literalArrayEncoding
</methods> <methods> Lens.LensColumnSizeConstraint <category>accessing</category>
encodingName ^encodingName
encodingName: newEncoding encodingName := newEncoding
isZero ^length == nil or: [length = 0]
length ^length
length: newLen length := newLen
</methods> <methods> Lens.LensColumnSizeConstraint <category>printing</category>
printOn: aStream aStream print: length; nextPutAll: ' "'; nextPutAll: encodingName; nextPut: $"
</methods> <methods> Lens.LensColumnSizeConstraint class <category>instance creation</category>
decodeFromLiteralArray: anArray ^self new fromLiteralArrayEncoding: anArray
</methods> <methods> Lens.ComposedBlock <category>accessing</category>
add: b blocks add: b
beAnd isAnd := true
beOr isAnd := false
numArgs "Since the blocks should match in the number of arguments, return the first one's" ^blocks first numArgs
</methods> <methods> Lens.ComposedBlock <category>evaluating</category>
valueWithArguments: anArray "This message is the only one sent by the ObjectLens mechanism to the block given in the WHERE clause. The expected result is a Lens*Surrogate. Since each one of the composing blocks returns an Lens*Surrogate we can compose the result of evaluating each one of them with previous results by using the operators '&' and '|'" | res | res := nil. blocks do: [:aBlock | | blockValue arr | aBlock numArgs ~~ anArray size ifTrue: [arr := anArray copyFrom: 1 to: aBlock numArgs] ifFalse: [arr := anArray]. blockValue := aBlock valueWithArguments: arr. res == nil ifTrue: [res := blockValue] ifFalse: [isAnd ifTrue: [res := res & blockValue] ifFalse: [res := res | blockValue]]]. ^res
</methods> <methods> Lens.ComposedBlock <category>initialize release</category>
initialize "The default is to use the '&' operator between the blocks" blocks := OrderedCollection new. isAnd := true
</methods> <methods> Lens.ComposedBlock class <category>instance creation</category>
and ^self new beAnd
new ^super new initialize
or ^self new beOr
</methods> <methods> Lens.LensMetadata <category>to/from specification</category>
fromLiteralArrayEncoding: anArray 2 to: anArray size by: 2 do: [:i | self perform: (anArray at: i) with: (anArray at: i + 1)]
literalArrayEncoding "Answer a literalArray encoding of the receiver. The aspects to encode are determined by the asking the receiver #encodedAspects, and consists of a sequenceable collection of selectors or get/put selector pairs. Values are encoded using the block closure provided by asking the receiver #valueEncoder." | aspects encoder values names getSelector putSelector size array index | aspects := self class allEncodedAspects. encoder := self class valueEncoder. values := OrderedCollection new. names := OrderedCollection new. aspects do: [:aspect | | value | aspect isSymbol ifFalse: [ getSelector := aspect at: 1. putSelector := aspect at: 2] ifTrue: [ getSelector := aspect. putSelector := (aspect , ':') asSymbol]. (value := self perform: getSelector) == nil ifFalse: [ names add: putSelector. values add: (encoder value: value)]]. size := names size. array := Array new: size * 2 + 1. array at: 1 put: self class fullyQualifiedReference. index := 2. 1 to: size do: [:i | array at: index put: (names at: i). array at: index + 1 put: (values at: i). index := index + 2]. ^array
</methods> <methods> Lens.LensMetadata <category>accessing</category>
name "Answer the receiver's name." ^self subclassResponsibility
</methods> <methods> Lens.LensMetadata <category>private</category>
printNameOn: stream | nm | stream nextPutAll: (((nm := self name) == nil or: [nm isEmpty]) ifFalse: [nm] ifTrue: [(#unnamed << #lensRuntime >> 'unnamed')]) asString
</methods> <methods> Lens.LensMetadata class <category>private</category>
accumulateAspects: aspects "accumulate instance variable aspects in 'aspects'. Do this in depth-first, left-to-right order. This will give the ordering of instance variable aspects expected by the compiler and other parts of the system." superclass == LensMetadata ifFalse: [ superclass accumulateAspects: aspects]. aspects addAll: self encodedAspects.
allEncodedAspects "Answer a sequenceable collection of the receiver's aspects to be encoded." | aspects | aspects := OrderedCollection new. self accumulateAspects: aspects. ^aspects
decodeFromLiteralArray: anArray ^self new fromLiteralArrayEncoding: anArray
encodedAspects "Default encoded aspects to all instvars." ^self allInstVarNames collect: [:n | n asSymbol]
valueEncoder "Default the encoder to the literal array encoding of the value passed." ^[:value | value literalArrayEncoding]
</methods> <methods> Lens.LensTableKey <category>initialize-release</category>
columns: theColumns "Initialize the ordered collection of columns which comprise this key." columns := theColumns
keyType: aSymbol "Initialize the type of this key to #primary or #unique." keyType := aSymbol
table: aLensTable "Initialize the table this key is defined for." table := aLensTable
</methods> <methods> Lens.LensTableKey <category>accessing</category>
columns "Answer the columns which comprise this key." ^columns
keyType "Answer #primary or #unique to describe this key." ^keyType
table "Answer the table this key is defined for." ^table
</methods> <methods> Lens.LensTableKey class <category>instance creation</category>
table: aLensTable columns: theColumns keyType: aSymbol "Answer a new key for aLensTable, composed of theColumns, and having the uniqueness constraint aSymbol (#primary or #unique)." ^self new table: aLensTable; columns: theColumns; keyType: aSymbol
</methods> <methods> Lens.DatabaseTypeMapping <category>accessing</category>
columnType "Answer the database column's datatype." ^columnType
columnType: dataType "Set the database column's datatype." columnType := dataType
fieldType "Answer the type of attributes as passed through the database connector." ^fieldType
fieldType: type "Set the type of attributes as passed through the database connector." fieldType := type
isLongType "Answer whether the field type is considered long." ^isLongType
isLongType: flag "Set whether the field type is considered long." isLongType := flag
makeLong "Mark that the column type is considered long." isLongType := true.
maxSize "Answer the max size of data." ^maxSize
maxSize: size "Set the max size of data." maxSize := size
</methods> <methods> Lens.DatabaseTypeMapping <category>printing</category>
printOn: stream super printOn: stream. stream nextPutAll: ' ('; print: fieldType; nextPutAll: '->'; print: columnType; nextPut: $)
</methods> <methods> Lens.DatabaseTypeMapping <category>initialize-release</category>
initialize isLongType := false
</methods> <methods> Lens.DatabaseTypeMapping class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensScope <category>initialize-release</category>
instanceVariables: vars startingAt: startIndex "Record instance variables in a local variable dictionary. We know there cannot be any name conflicts, since this is checked when the class is defined." | index | index := startIndex. variables == nil ifTrue: [self initVariables]. vars do: [:var | variables at: var name put: (LensInstanceVariable new scope: nesting index: index). index := index + 1]. ^index
</methods> <methods> Lens.LensContainer <category>querying</category>
answer: answerBlock "Answer an operation accessor returning values specified by answerBlock." ^self operationAccessor answer: answerBlock
distinct "Answer a query accessor whose contents have distinct instance states." ^self operationAccessor distinct
groupBy: block "Answer a query accessor that groups objects by the attributes specified in block." ^self operationAccessor groupBy: block
locking "Answer a query accessor that locks all elements when fetched." ^self operationAccessor locking
match: template "Answer the set of objects in the receiver that match template." ^self select: [:object | object isLike: template]
orderBy: orderByBlock "Answer a query accessor that orders its results by orderByBlock." ^self operationAccessor orderBy: orderByBlock
readStream "Answer a readStream on the receiver." ^self operationAccessor readStream
select: selectBlock answer: answerBlock "Answer a collection of values selected by selectBlock, whose shape is specified by answerBlock." ^(self answer: answerBlock) select: selectBlock
selectWhere: selectBlock "Answer a query accessor whose results are selected by selectBlock." ^self operationAccessor selectWhere: selectBlock
size "Answer the number of elements in the receiver." ^self operationAccessor size
unique "Answer a query accessor whose result must be unique." ^self operationAccessor unique
</methods> <methods> Lens.LensContainer <category>collection protocol</category>
, aContainer "Answer a composite container on receiver and aContainer." ^(LensCompositeContainer new lensContainer: self) , aContainer
at: eid "Answer the element whose externalId is eid." self lensSession checkRead. ^transporter objectAtId: eid
at: aKey ifAbsent: absentBlock "Answer the unique object in the receiver with key aKey. If no such object is found, evaluate absentBlock." ^Object notFoundSignal handle: [:ex | absentBlock value] do: [self at: aKey]
collect: aBlock "Evaluate aBlock with each of the values of the receiver as the argument. Collect the resulting values into a collection that is like the receiver. Answer the new collection." | stream collectedSet | stream := self readStream. collectedSet := OrderedCollection new. [stream atEnd] whileFalse: [ collectedSet add: (aBlock value: stream next)]. ^collectedSet
copyEmpty: aSize "Answer a copy of the receiver that contains no elements." self shouldNotImplement
detect: selectBlock ifNone: noneBlock "Answer an object in the receiver satisfying selectBlock. If no such object is found, evaluate noneBlock." ^self operationAccessor detect: selectBlock ifNone: noneBlock
do: aBlock "Evaluate aBlock with each of the values of the receiver as the argument. Collect the resulting values into a collection that is like the receiver. Answer the new collection." | stream | stream := self readStream. [stream atEnd] whileFalse: [ aBlock value: stream next].
isEmpty "Answer whether receiver is empty." ^self size == 0
keys "Answer a set containing the receiver's keys." | idVars keys | idVars := type idVariables. keys := Set new. (self answer: [:x | | y | y := idVars first getValueOf: x. 2 to: idVars size do: [:i | y := y , ((idVars at: i) getValueOf: x)]. y]) readStream addContentsTo: keys. ^keys
select: selectBlock "Answer the receiver's contents selected by selectBlock." ^self operationAccessor select: selectBlock
values "Answer the collection of all elements in receiver." ^self operationAccessor values
</methods> <methods> Lens.LensContainer <category>private</category>
addComponentsTo: anOrderedCollection anOrderedCollection add: self
decoderFrom: decoders andContainers: containers "Answer a decoder built from the decoders and container collections." ^decoders size == 1 ifTrue: [ | decoder container | decoder := decoders first. container := containers first. (container isNil or: [container == self and: [decoder == container type decoder]]) ifTrue: [ decoder ] ifFalse: [ | class | class := container type memberClass. LensTranscoder forDecoder: decoder andClass: class ] ] ifFalse: [ | containerClasses | containerClasses := Array new: containers size. 1 to: containers size do: [ :i | | cont | (cont := containers at: i) notNil ifTrue: [ containerClasses at: i put: cont type memberClass ] ]. LensTranscoder forDecoders: decoders andClasses: containerClasses]
operationAccessor "Answer a new operation accessor on the receiver." ^QueryOperationAccessor new operation: QueryOperation new session: self lensSession lensContainer: self
transporter "Answer the receiver's transporter." transporter == nil ifTrue: [ | myLens | (myLens := self lensSession) checkConnected. transporter := myLens dataModel databaseContext class transporterClass new lensContainer: self. "if the receiver isn't a base container, then register it as a non-base container" (myLens containers includes: self) ifFalse: [ myLens nonBaseContainers add: self ] ]. ^transporter
type: aType lensSession: aLensSession "Setup receiver to access members of type in aLensSession." lensSession := aLensSession. type := aType. self transporter.
</methods> <methods> Lens.LensContainer <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." stream print: self class
</methods> <methods> Lens.LensContainer <category>tracing</category>
traceFrom: aTracer aTracer raiseInvalidTraceSignalOn: self
</methods> <methods> Lens.LensContainer <category>accessing</category>
components "Answer the containers that are the receiver's components." ^Array with: self
lensSession "Answer the receiver's lens session." ^lensSession
type "Answer the type of the receiver's elements." ^type
</methods> <methods> Lens.LensContainer <category>private-activation</category>
disconnect "Release the receiver's resources." transporter notNil ifTrue: [ transporter disconnect. transporter := nil ]
</methods> <methods> Lens.LensContainer <category>testing</category>
isComposite "Answer whether receiver is composite." ^false
</methods> <methods> Lens.LensContainer class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensStructureType
</methods> <methods> Lens.LensContainer class <category>signal access</category>
cannotQueryLocalVariableSignal "Answer the signal raised when attempting to query through a local variable." ^CannotQueryLocalVariable
cannotUpdateSignal "Answer the signal raised when attempting to perform an illegal update." ^CannotUpdate
invalidAggregateFunctionSignal "Answer the signal indicating invoking an undefined aggregate function." ^InvalidAggregateFunction
invalidPredicateSignal "Answer the signal indicating invoking a predicate in a selection block that directly references instance variables." ^InvalidPredicate
objectInAnotherLensContainerSignal "Answer the signal indicating that an object is persistent in another container." ^ObjectInAnotherLensContainer
objectNotPersistentSignal "Answer the signal indicating that an object isn't persistent." ^ObjectNotPersistent
objectNotUniquelyIdentifiedSignal "Answer the signal indicating a second row/object has been discovered with the same identity as another row. The only way to maintain integrity is to rollback the transaction and check the table to ensure that it is enforcing uniqueness of the primary key." ^ObjectNotUniquelyIdentified
queryErrorSignal "Answer the signal indicating the occurance of a query error." ^QueryError
</methods> <methods> Lens.LensContainer class <category>class initialization</category>
initialize "LensContainer initialize" self initializeExceptionClasses
initializeExceptionClasses "Initialize related exception classes." CannotQueryLocalVariable notifierString: (#cannotQueryLocalVariable << #lens >> 'Cannot query through a local variable'); nameClass: self message: #cannotQueryLocalVariableSignal. InvalidAggregateFunction notifierString: (#invalidAggregateFunction << #lens >> 'Invalid aggregate function'); nameClass: self message: #invalidAggregateFunctionSignal. InvalidPredicate notifierString: (#invalidPredicate << #lens >> 'Predicate directly references instance variable'); nameClass: self message: #invalidPredicateSignal. ObjectInAnotherLensContainer notifierString: (#objectInAnotherLensContainer << #lens >> 'Object already in another container.'); nameClass: self message: #objectInAnotherLensContainerSignal. CannotUpdate notifierString: (#cannotUpdate << #lens >> 'Cannot update long variables.'); nameClass: self message: #cannotUpdateSignal. ObjectNotPersistent notifierString: (#objectNotPersistent << #lens >> 'Object not persistent.'); nameClass: self message: #objectNotPersistentSignal. ObjectNotUniquelyIdentified notifierString: (#objectNotUniquelyIdetified << #lens >> 'The second object with same identity has been detected. Your table must not be enforcing the uniqueness of the primary key. Rollback the current transaction to maintain integrity and ensure that every table has a unique index for the primary key.'); nameClass: self message: #objectNotUniquelyIdentifiedSignal. QueryError notifierString: (#queryError << #lens >> 'Query error'); nameClass: self message: #queryErrorSignal.
</methods> <methods> Lens.LensContainer class <category>error handling</category>
queryErrorWith: parameters errorPattern: template "Raise a query exception." | message | message := ((#queryErrorTemplate << #lens >> 'Query error: <1s>') expandMacrosWith: (template expandMacrosWithArguments: parameters)). self queryErrorSignal raiseWith: (Array with: message) , parameters errorString: message
</methods> <methods> Lens.LensCompositeContainer <category>accessing</category>
components "Answer the receiver's component containers." ^components
name "Answer the receiver's name." | stream | stream := WriteStream on: (String new: 256). components do: [:c | stream nextPutAll: c name; nextPut: $,]. stream skip: -1. ^stream contents
</methods> <methods> Lens.LensCompositeContainer <category>testing</category>
isComposite "Answer whether receiver is composite." ^true
</methods> <methods> Lens.LensCompositeContainer <category>private</category>
addComponentsTo: anOrderedCollection anOrderedCollection addAll: components
lensContainer: aContainer "Make aContainer the receiver's primary container." aContainer addComponentsTo: (components := OrderedCollection new: 16). lensSession := aContainer lensSession. type := aContainer type.
printTypeOn: stream (components isNil or: [components isEmpty]) ifFalse: [components do: [:c | c type notNil ifTrue: [c type printNameOn: stream] ifFalse: [stream nextPutAll: 'nil']. stream nextPut: $,]. stream skip: -1]
</methods> <methods> Lens.LensCompositeContainer <category>collection protocol</category>
, container "Add container's components to the receiver's components." container addComponentsTo: components
</methods> <methods> Lens.LensCompositeContainer <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. (components isNil or: [components isEmpty]) ifFalse: [stream nextPutAll: (#Types << #lensRuntime >> ' (types=') asString. self printTypeOn: stream. stream nextPutAll: ')']
</methods> <methods> Lens.QueryOperation <category>mixing</category>
mixin: aQueryOperation "The given query operation is mixed in. The semantics are not well defined yet, but the mixin should agree in some fields (like the containers and answer block). The selectionBlocks are conjoined and the orderBy and groupBy blocks of the argument supersede those of the original query" | b | self selectOnly: aQueryOperation privateSelectBlock. b := aQueryOperation orderByBlock. b notNil ifTrue: [self orderBy: b]. b := aQueryOperation groupByBlock. b notNil ifTrue: [self groupBy: b]
selectOnly: aBlockOrNil aBlockOrNil notNil ifTrue: [selectBlock isNil ifTrue: [self selectWhere: aBlockOrNil] ifFalse: [self selectWhere: ((ComposedBlock and) add: selectBlock; add: aBlockOrNil)]]
</methods> <methods> Lens.QueryOperation <category>querying</category>
answer: anAnswerBlock "Set the receiver's answer block to anAnswerBlock, specifying the answer values." answerBlock == anAnswerBlock ifFalse: [ self invalidateCommand. answerBlock := anAnswerBlock]
distinct "Specify that values to be returned are to be distinct." self isDistinct: true
groupBy: aBlock "Specify the groupBy block, which specifies the attributes by which values are to be grouped." groupByBlock == aBlock ifFalse: [ self invalidateCommand. groupByBlock := aBlock]
locking "Specify query to be locking." self isLocking: true
orderBy: aBlock "Order the values according to aBlock." orderByBlock == aBlock ifFalse: [ self invalidateCommand. orderByBlock := aBlock]
selectWhere: aBlock "Set the receiver's selectBlock, which specifies which values to return." selectBlock == aBlock ifFalse: [ self invalidateCommand. selectBlock := aBlock]
unique "Assert that result must be unique." self isUnique: true
useSqlAccessInterface "Ask receiver to access information via the SQL Access Interface. This means that all returned values are raw, i.e. aren't decoded nor encached, and that any execution arguments passed to the receiver aren't encoded." interface := #sqlAccess
</methods> <methods> Lens.QueryOperation <category>private</category>
argumentBindings "Answer the dictionary of argument bindings." ^argumentBindings
argumentBindings: newBindings "Set the dictionary of argument bindings." argumentBindings := newBindings
arrayContainerNames: arr | res | res := Array new: arr size. 1 to: arr size do: [:i | res at: i put: (LensContainerReference on: ((arr at: i) at: 2) named: ((arr at: i) at: 1))]. self containerNames: res
containerNames: names "Attach a name or array of names specifying the base container(s) used by accessors created from the receiver." containerNames := names
executeWithArguments: actualArgs session: session lensContainer: lensContainer "Execute the operation using the given actual arguments." | numargs stream result | numargs := arguments size. (argumentBindings isNil and: [numargs > 0]) ifTrue: [ self initBindingsWith: lensContainer type ]. (command == nil or: [command body == nil]) ifTrue: [ command := lensContainer transporter queryFor: self. resultType isNil ifTrue: [ resultType := lensContainer transporter resultType ] ]. actualArgs size = numargs ifFalse: [ self error: (#errNumberOfArguments << #lens >> 'Executing operation with wrong number of arguments') ]. "bind the args, encoding them if using the ObjectLens interface" numargs > 0 ifTrue: [ | bindObject | bindObject := command bindObject. interface == #objectLens ifTrue: [ 1 to: numargs do: [:i | bindObject at: i put: ((arguments at: i) encode: (actualArgs at: i) in: session) ] ] ifFalse: [ 1 to: numargs do: [:i | bindObject at: i put: (actualArgs at: i) ] ] ]. "If given use the alternateSQL" alternateSQL notNil ifTrue: [ command body: alternateSQL ]. "get a data stream if using the sql access interface on an RPC" stream := (command isRPC and: [interface == #sqlAccess]) ifTrue: [ stream := (session connection doCommand: command) answerAfterCommand. resultType == nil ifTrue: [ resultType := self class rowTypeWithColumns: stream columnDescriptions ]. stream ] ifFalse: [ lensContainer transporter execute: self ]. "get and return the results in the stream" ^returnsFirstValue ifTrue: [ stream atEnd ifTrue: [ emptyResultBlock == nil ifTrue: [ LensSession rowForObjectNotFoundSignal raise ] ifFalse: [ emptyResultBlock value ] ] ifFalse: [ result := stream next. (stream atEnd not and: [isUnique]) ifTrue: [ LensContainer objectNotUniquelyIdentifiedSignal raise ]. result ] ] ifFalse: [ isStreaming ifTrue: [ stream ] ifFalse: [ isUnique ifFalse: [ stream upToEnd ] ifTrue: [ result := stream upToEnd. result size > 1 ifTrue: [ LensContainer objectNotUniquelyIdentifiedSignal raise ]. result ] ] ]
initBindingsWith: type "Initialize the receiver's bindings dictionary." argumentBindings := OrderedCollection new. arguments notNil ifTrue: [ arguments do: [ :var | | lcv | var valueType isNil ifTrue: [LensSession complain: ((#argumentNoType << #lens >> 'Argument <1p> has no value type.') expandMacrosWith: var name )]. var objectType: type. "set object type for data model access" var setFieldType. lcv := LensCommandVariable new name: var name type: var valueType. lcv variable: var. argumentBindings add: var accessorSelector -> lcv ]]
invalidateCommand "Invalidate the current command to force it to be regenerated prior to next execution." command == nil ifFalse: [ command initialize]
markExtracted "Mark receiver as having been extracted." wasExtracted := true
postFlag ^postFlag
postFlag: aBoolean postFlag := aBoolean
printNameOn: stream stream nextPutAll: ((name isNil or: [name isEmpty]) ifFalse: [name] ifTrue: [(#unnamed << #lensRuntime >> 'unnamed')]) asString
privateEmptyResultBlock: aBlock emptyResultBlock := aBlock
privateIsStreaming: flag isStreaming := flag
privateReturnsFirstValue: flag returnsFirstValue := flag
privateSelectBlock "Answer the select block, even if nil." ^selectBlock
privateSelectBlock: aBlock "Set the select block, even if nil." selectBlock := aBlock. self invalidateCommand
</methods> <methods> Lens.QueryOperation <category>accessing</category>
alternateSQL ^alternateSQL
alternateSQL: aString alternateSQL := aString
answerBlock "Answer the receiver's answerBlock." ^answerBlock
arguments "Answer the receiver's arguments, an array of attributes that describe the receiver's formal arguments." ^arguments
arguments: newArgs "Set the receiver's arguments, an array of attributes that describe the receiver's parameters." arguments := newArgs
command "Answer the command bound to the receiver." command isNil ifTrue: [ command := DatabaseCommand new]. ^command
command: newCommand "Attach a command to the receiver." command := newCommand
containerClassNames "Returns the class names from the containers stored in containerNames. ContainerNames can be a collection of either Symbols or references or a single symbol. The references are found in operations defined using the query editor" containerNames isSymbol ifTrue: [^Array with: containerNames] ifFalse: [^containerNames collect: [:co | co isSymbol ifTrue: [co] ifFalse: [co referredName]]]
description "Answer the receiver's description." ^description isNil ifTrue: [''] ifFalse: [description]
description: newDescription "Set the receiver's description." description := newDescription
groupByBlock "Answer the receiver's groupByBlock." ^groupByBlock
interface "Answer the interface through which the receiver accesses information." ^interface
isDistinct: flag "Specify whether values to be returned are to be distinct." isDistinct == flag ifFalse: [ (flag and: [isLocking]) ifTrue: [ LensContainer queryErrorSignal raiseErrorString: (#errQueryLockingAndDistinct << #lens >> 'Query error: query can''t be both locking and distinct')]. self invalidateCommand. isDistinct := flag]
isLocking: flag "Specify whether query is to be locking." isLocking == flag ifFalse: [ (flag and: [isDistinct]) ifTrue: [ LensContainer queryErrorSignal raiseErrorString: (#errQueryLockingAndDistinct << #lens >> 'Query error: query can''t be both locking and distinct')]. self invalidateCommand. isLocking := flag]
isUnique: flag "Specify whether operation is to return unique values." isUnique == flag ifFalse: [ self invalidateCommand. isUnique := flag]
mode ^mode
mode: aMode mode := aMode
name "Answer the receiver's name." ^name
name: newName "Set the receiver's name." name := newName
orderByBlock "Answer the receiver's orderByBlock." ^orderByBlock
resultType "Answer the type of results of the last query, where the type is as follows: single object -> the object's structure type single attribute -> the attribute's value type a set of attributes -> an array of hte value types a composite record containing multiple objects -> an array of their structure types ." ^resultType
resultType: aType "Set the receiver's result type." resultType := aType
selectBlock "Answer the receiver's selectBlock, defaulting to one that accepts all objects." ^selectBlock == nil ifTrue: [ | components | components := (containerNames isNil or: [containerNames isSymbol]) ifTrue: [1] ifFalse: [containerNames size]. SelectAllBlocks at: components] ifFalse: [ selectBlock]
useStreaming useStreaming isNil ifTrue: [useStreaming := false]. ^useStreaming
useStreaming: flag useStreaming := flag
</methods> <methods> Lens.QueryOperation <category>source accessing</category>
answerBlockSource ^answerBlockSource
answerBlockSource: aString answerBlockSource := aString
containerNames ^containerNames
groupByBlockSource ^groupByBlockSource
groupByBlockSource: aString groupByBlockSource := aString
orderByBlockSource ^orderByBlockSource
orderByBlockSource: aString orderByBlockSource := aString
selectBlockSource ^selectBlockSource
selectBlockSource: aString selectBlockSource := aString
</methods> <methods> Lens.QueryOperation <category>testing</category>
isDistinct "Answer whether the receiver's elements have distinct states." ^isDistinct
isLocking "Answer whether selections on receiver lock elements when queried." ^isLocking
isStreaming "Answer whether receiver answers a readStream when queried." ^isStreaming
isUnique "Answer whether selections on receiver should yield unique values." ^isUnique
wasExtracted "Answer whether receiver was extracted." ^wasExtracted
</methods> <methods> Lens.QueryOperation <category>initialize-release</category>
initialize isDistinct := false. isStreaming := false. isLocking := false. isUnique := false. interface := #objectLens. returnsFirstValue := false. wasExtracted := false. postFlag := true
</methods> <methods> Lens.QueryOperation <category>accessor creation</category>
accessorIn: session "Answer an operation accessor on the receiver in the session." | cont contClassNames | (containerNames isNil or: [containerNames isEmpty]) ifTrue: [cont := nil] ifFalse: [contClassNames := self containerClassNames. cont := session containerNamed: contClassNames first. 2 to: contClassNames size do: [:i | cont := cont , (session containerNamed: (contClassNames at: i))]]. ^QueryOperationAccessor new operation: self session: session lensContainer: cont
</methods> <methods> Lens.QueryOperation <category>printing</category>
printOn: stream super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.QueryOperation class <category>class initialization</category>
initialize "QueryOperation initialize" "initialize array of blocks to be used by various size composites to get contents" SelectAllBlocks := Array with: [:x1 | true] with: [:x1 :x2 | true] with: [:x1 :x2 :x3 | true] with: [:x1 :x2 :x3 :x4 | true] .
</methods> <methods> Lens.QueryOperation class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.QueryOperation class <category>result type access</category>
rowTypeWithColumns: columnDescriptions "Answer a structure type of rows with the given column descriptions." | variables | variables := OrderedCollection new. columnDescriptions do: [:colDesc | | type valueClass | valueClass := colDesc type. type := valueClass typeClass new memberClass: valueClass. (valueClass includesBehavior: String) ifTrue: [ type := type copy maxColumnConstraint: colDesc maxColumnConstraint]. variables add: ( LensStructureVariable new name: colDesc name asLowercase; setValueType: type)]. ^(LensStructureType new memberClass: Array) variables: variables.
</methods> <methods> Lens.LensQuery <category>executing</category>
answer "Executes the query and returns the results as a stream. Returns nil if no session has been provided." session isNil ifTrue: [^nil]. ^(self accessorIn: session) readStream
values "Executes the query and returns the results as a collection. Returns nil if no session has been provided" session isNil ifTrue: [^nil]. ^(self accessorIn: session) values
</methods> <methods> Lens.LensQuery <category>accessing</category>
alternateSQL: aString "use aString instead of the generated SQL. The given SQL statement MUST match EXACTLY in the columns selected and their order with the generated SQL. To access the generated SQL enable the tracing of database commands. All SQL commands executed will appear in the System transcript" alternateSQL := aString
session: aLensSession "Set the the session where the query will be evaluated to be aLensSession." session := aLensSession
</methods> <methods> Lens.LensDatabaseTable <category>accessing</category>
columns "Answer the receiver's columns." self privateColumns == nil ifTrue: [ | cont lens ldm | (lens := self lensSession) notNil ifTrue: [ cont := lens containerOf: (ldm := lens dataModel) databaseContext class tableColumnClass. self columns: (cont select: [:col | col table = self]). "nil out widths of all fixed-size columns" self privateColumns do: [ :column | (ldm fieldTypeForColumn: column) isVariableSize ifFalse: [ column maxColumnConstraint: nil ]]]]. ^self privateColumns
columns: newColumns "Set the receiver's columns to newColumns." self subclassResponsibility
name "Answer the receiver's name." ^self subclassResponsibility
name: newName "Set the receiver's name to newName." self subclassResponsibility
owner "Answer the receiver's owner." ^self subclassResponsibility
owner: newOwner "Set the receiver's name to newOwner." self subclassResponsibility
qualifiedName "Answer the fully-qualified name of the table according to database conventions." | strm | strm := (String new: 128) writeStream. self qualifiedNameOn: strm. ^strm contents
qualifiedNameOn: aStream "Put the fully-qualified name of the table according to database conventions on aStream." self printNameOn: aStream
tableType "Answer the receiver's tableType." ^self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTable <category>DDL generation</category>
alterColumnCommand: column operation: operation "Answer a command to add or modify a column in a table. If the modification is to the type then do not emit the nullness part" | stream | stream := WriteStream on: String new. stream nextPutAll: 'alter table ' , self qualifiedName. operation == #add ifTrue: [stream nextPutAll: ' add ('. column putDefinitionOn: stream] ifFalse: [stream nextPutAll: ' modify ('. operation == #alterType ifTrue: [column putBasicDefinitionOn: stream] ifFalse: [column putDefinitionOn: stream]]. stream nextPut: $). ^stream contents
removeFrom: container "Remove table represented by receiver." container lensSession connection doCommandString: 'drop ' , self tableType , ' ' , self qualifiedName
rename: newName "Set the receiver's name to newName, renaming the associated database table." | lensSession | self name = newName ifFalse: [ (self name notNil and: [(lensSession := self lensSession) notNil]) ifTrue: [ lensSession connection doCommandString: (self renameCommand: newName) ]. self name: newName]
renameCommand: newName "Answer a command for renaming the receiver newName." ^'rename ' , self qualifiedName , ' to ' , newName
</methods> <methods> Lens.LensDatabaseTable <category>relationships</category>
containsColumnRel "This method implements the relationship 'containsColumn'" ^self columns asSet
relatedBy: token "The Falcon relationships dispatcher for this class" (#(#containsColumnRel #relatedRel #relatedRRel) includes: token) ifTrue: [^self perform: token] ifFalse: [^super relatedBy: token]
relatedRel "This method implements the Falcon relationship 'relatedRel'" "We return an empty set, meaning none related with this relationship" ^IdentitySet new
relatedRRel "This method implements the relationship 'relatedRRel'" "This is an inverse relationship, my column are 'related' to me, then I am 'relatedR' to them" ^self columns asSet
stringKey: hints "The string to be used when I'm presented in a graph." ^self qualifiedName
</methods> <methods> Lens.LensDatabaseTable <category>to/from specification</category>
addUniqueColumn: aColumn "aColumn should be added to the set of columns for this table if and only if there isn't a column of its name already present. Answer the column which is present in the table." "Assume: this shouldn't query the system catalog for a list of columns. (i.e. don't send self columns)" ^self columns detect: [ :each | each name = aColumn name ] ifNone: [ self columns add: aColumn ]
</methods> <methods> Lens.LensDatabaseTable <category>printing</category>
displayString ^self qualifiedName
printNameOn: aStream self owner == nil ifFalse: [ aStream nextPutAll: self owner; nextPut: $. ]. aStream nextPutAll: self name
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensDatabaseTable <category>converting</category>
internalName ^self class contextClass internalNameFor: self name
</methods> <methods> Lens.LensDatabaseTable <category>private-accessing</category>
privateColumns "Answer the contents of the instance variable which holds the receiver's columns." ^self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTable <category>key detection</category>
getPrimaryKeyIn: aLensSession "Answer the primary key for this table by looking it up in the database catalogs. Answer an instance of LensTableKey or nil." ^self subclassResponsibility
inferReferencesIn: aLensSession "We use tables also as non-persistent objects, therefore, aLensSession is passed to this method and the table's own lens is not used (if it even had one). This method returns a collection with arrays representing references from the table to other tables" ^self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTable <category>initialize-release</category>
initialize self columns: OrderedCollection new.
</methods> <methods> Lens.LensDatabaseTable <category>testing</category>
isReferredToBy: tableNameArray "Answer whether tableNameArray contains a viable reference to this table. The tableNameArray is composed of name elements ordered from the RIGHT to left in a qualification order (i.e. the simple name comes first and then any qualification)." | temp1 temp2 | ^(self name = (tableNameArray at: 1)) and: [ tableNameArray size < 2 or: [ (temp1 := self owner) isNil or: [ temp1 isEmpty or: [ (temp2 := tableNameArray at: 2) isNil or: [ temp1 = temp2 ] ] ] ] ]
</methods> <methods> Lens.LensDatabaseTable class <category>accessing</category>
contextClass "Answer the name of the class which provides database context." self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTable class <category>private</category>
encodedAspects ^#(#name)
</methods> <methods> Lens.LensDatabaseTable class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensApplicationModel <category>events</category>
confirmationOfCommit "The current transaction has been committed; take appropriate action." ^self
confirmationOfLogin "The user has just logged in to the database; take appropriate action." ^self
confirmationOfLogout "The user has logged out of the database; take appropriate action." self session: nil
confirmationOfRollback "The current transaction has been rolled back; take appropriate action." ^self
localRequestForWindowClose "An application wants to close the window in which the receiver is running. Return a Boolean indicating approval or disapproval." ^true
noticeOfCommit "The current transaction is about to be committed; take appropriate action. This definition can be overridden on subclasses, e.g. to send a 'self accept' message to cause unaccepted changes to be accepted prior to commit." ^self
noticeOfLogin "The user is about to log in to the database; take appropriate action." ^self
noticeOfLogout "The user is about to log out of the database; take appropriate action." ^self
noticeOfRollback "The current transaction is about to be rolled back; take appropriate action." ^self
noticeOfWindowClose: aWindow "This message is sent to an application by its window when the window closes. It is used to generate the corresponding internal events sent down the parent/child hierarchy, and to coordinate session and window management." self downcastEvent: #noticeOfWindowClose: with: aWindow skip: [:child :key :win | child = self] stop: [:child :key :win | | bldr | (bldr := child builder) notNil and: [(bldr window == win) not]] request: false topDown: false. self parent isNil ifTrue: [self hasSession ifTrue: [self forceLogout]] ifFalse: [self parent windowOwner removeDependent: aWindow. self removeDependent: self parent windowOwner builder window. self parent: nil]. self builder: nil. super noticeOfWindowClose: aWindow
requestForCommit "An application wants to commit the current transaction; return a Boolean indicating approval or disapproval." ^true
requestForLogout "An application wants to log out of the current session; return a Boolean indicating approval or disapproval." ^true
requestForRollback "An application wants to roll back the current transaction; return a Boolean indicating approval or disapproval." ^true
</methods> <methods> Lens.LensApplicationModel <category>private</category>
addChild: anApplication "Add a new child to the receiver's children." self children add: anApplication
alertBrokenChild: aChild "An incompletely realized child is being held by the receiver. Ask whether it should be removed." (Dialog confirm: (#removeBrokenData << #lens >> 'Remove broken linked Data Form?') initialAnswer: true for: self builder window) ifTrue: [self removeChild: aChild]
allChildrenInto: aCollection self children do: [:child | aCollection add: child. child allChildrenInto: aCollection]
attachToChild: anApplication "Ask the receiver to hook up to anApplication as its parent." anApplication messageNotUnderstoodSignal handle: [:ex | ex parameter selector == #parent: ifTrue: [ex return] ifFalse: [ex reject]] do: [anApplication parent: self]. ^anApplication
attachToParent: anApplication "Ask the receiver to hook up to anApplication as its child." parent messageNotUnderstoodSignal handle: [:ex | ex parameter selector == #addChild ifTrue: [ex return] ifFalse: [ex reject]] do: [parent addChild: self]
authenticate "Authenticate the user. Use the default username and password from UISettings if available. Loop until the connection is established or the user gives up." | first username pwd exc | self hasSession ifFalse: [^nil]. first := true. username := (UISettings preferenceFor: #dbUserUsername) asValue. (username value isNil or: [username value isEmpty]) ifTrue: [username value: self existingSession dataModel databaseContext username copy]. pwd := (UISettings preferenceFor: #dbUserPassword) asValue. pwd value isNil ifTrue: [pwd value: String new]. self existingSession username: username value. [first ifFalse: [self existingSession connection class connectionExceptionSignal handle: [:ex | exc := ex. (ex signal inheritsFrom: ExternalDatabaseConnection externalDatabaseErrorSignal) ifTrue: [ex return] ifFalse: [ex reject]] do: ["Connect to the dbms." self existingSession connect: pwd value. ^self]]. first ifTrue: [first := false] ifFalse: [exc signal == self existingSession connection class authenticationFailureSignal ifTrue: [Dialog warn: (#badNameOrPassword << #lens >> 'Unable to connect: bad user name or password')] ifFalse: [Dialog warn: (#unableToConnectToServer << #lens >> 'Unable to connect to database server')]]. (self openLoginDialogOnUsername: username andPassword: pwd) ifFalse: [^nil]. self existingSession username: username value] repeat
autoOpenChildren "Sent by the postOpenWith: method on this class. This method is extended in automatically generated subclasses whose children want to be opened automatically." self children do: [:child | | bldr | ((bldr := child builder) notNil and: [bldr window == self builder window]) ifTrue: [child autoOpenChildren]]
confirmDiscardChanges | window | builder notNil ifTrue: [window := builder window]. ^Dialog confirm: (#discardChanges << #lens >> 'Some database rows are still being changed. Do you wish to discard those changes?') for: window
confirmDiscardUntransactedChanges | window | builder notNil ifTrue: [window := builder window]. ^Dialog confirm: (#discardUntransactedChanges << #lens >> 'There are untransacted changes. Do you wish to discard those changes?') for: window
enable: aBoolean group: ids "Enable or disable a collection of widgets whose names are given in ids." ids do: [:id | | comp | comp := builder componentAt: id. comp notNil ifTrue: [aBoolean ifTrue: [comp enable] ifFalse: [comp disable]]]
ensureTransaction "Make sure that there is a transaction open." | se | ((se := self existingSession) notNil and: [se isInTransaction not]) ifTrue: [se begin]
forceCommit "We have an active transaction, we are going to commit it, and nobody gets a choice in the matter." | failed | failed := false. Cursor database showWhile: [self handleLens: [:ex | failed := true. ex return] do: [self ensureTransaction. self patriarch downcastEvent: #noticeOfCommit. self existingSession commit]]. failed ifFalse: [self patriarch downcastEvent: #confirmationOfCommit]
forceLogout "We are going to log out of the current session, and nobody gets a choice in the matter." | failed | failed := false. Cursor database showWhile: [self handleLens: [:ex | failed := true] do: [self existingSession isInTransaction ifTrue: [self forceRollback] ifFalse: [self downcastEvent: #clearRows]. self patriarch downcastEvent: #noticeOfLogout. self existingSession disconnect]]. failed ifFalse: [self patriarch downcastEvent: #confirmationOfLogout]
forceRollback "We have an active transaction, we are going to roll it back, and nobody gets a choice in the matter." | failed | failed := false. Cursor database showWhile: [self handleLens: [:ex | failed := true. ex return] do: [self patriarch downcastEvent: #noticeOfRollback. self existingSession rollback]]. failed ifFalse: [self patriarch downcastEvent: #confirmationOfRollback]
getExistingSession "Find any existing session. Propagate it to the local inst var. Do not create a new session if there isn't one." ^self parent isNil ifTrue: [session] ifFalse: [parent existingSession]
menuFromQuery: aQueryOperation "aQueryOperation should return a collection of two member arrays, with the first member's display string is to be used as label and the second the associated value. This method returns a block that computes the menu if the session has changed from the last time the menu was computed. The block will not ask directly for the session so no login is caused by the evaluation of the menu. The queryOperation has to be invalidated before using it to avoid caching information from the old session" | m lastSession | m := lastSession := nil. ^ [self patriarch hasSession ifTrue: [(m isNil or: [lastSession ~~ self session]) ifTrue: [| res | lastSession := self session. aQueryOperation resultType: nil. aQueryOperation invalidateCommand. res := (aQueryOperation session: lastSession) values. m := Menu new. res do: [:pair | m addItemLabel: (pair at: 1) displayString value: (pair at: 2)]]] ifFalse: [m isNil ifTrue: [m := Menu new]]. m]
notifyUserOfLensException: anException "Raise a warning dialog announcing anException." | win | builder notNil ifTrue: [win := builder window]. Dialog warn: ((#operationTerminated << #lens >> 'Operation Terminated: <1s>') expandMacrosWith: anException errorString) for: win
openChild: aChild with: aSymbol "Sent by automatically generated methods for opening a linked DataForm." | win | aChild builder isNil ifTrue: [self attachToChild: aChild. [aChild openInterface: aSymbol] ifCurtailed: [self alertBrokenChild: aChild]. ^self]. ((win := aChild builder window) isNil or: [aChild builder window key isNil]) ifTrue: [self alertBrokenChild: aChild. ^self]. (win := aChild builder window) notNil ifTrue: [win isCollapsed ifTrue: [win expand] ifFalse: [win raise]]
performEvent: aKey with: aParameter "Used by the event downcast utility. If aParameter is nil, use perform:, if an Array use perform:withArgument:, otherwise use perform:with:." aParameter isNil ifTrue: [^self perform: aKey]. (aParameter isKindOf: Array) ifTrue: [^self perform: aKey withArguments: aParameter]. ^self perform: aKey with: aParameter
raiseIfChanging "Give subclasses the opportunity to raise/expand a collapsed window when inquiring what to do about untransacted changes." ^self
removeChild: anApplication "Remove anApplication from the receiver's set of children." self children remove: anApplication ifAbsent: []
removeFromParent: anApplication "Unhook the receiver from anApplication as its child." parent messageNotUnderstoodSignal handle: [:ex | ex parameter selector == #removeChild: ifTrue: [ex return] ifFalse: [ex reject]] do: [parent removeChild: self]
requestForWindowClose "This message is sent by the application's window's controller when a command to close the window is received, to see if the application is in a state such that it can be closed. It is used to generate the corresponding internal events sent down the parent/child hierarchy. First check the keyboard processor for validation at the widget level, then check with the application by distributing the appropriate event." | window | (builder isNil or: [(window := builder window) isNil]) ifTrue: [^true]. window keyboardProcessor requestForWindowClose ifFalse: [^false]. ^(self downcastRequest: #localRequestForWindowClose) or: [self patriarch downcastEvent: #raiseIfChanging. self confirmDiscardUntransactedChanges]
synchronize: aChild "For a LensDataManager subclass, this method would be supplied by UIDefiner. The generated implementation references the 'row' value holder and causes aChild to receive value change notification from the receiver's row holder. Other subclasses must inherit this noop implementation." ^self
terminateSessionForInstall "We are returning from snapshot or from snapshot and quit. We already know that there is a session, because we are responding to an update from it. Log out, which will clear the display and drop our references to any persistent objects." self downcastEvent: #noticeOfLogout. self forceLogout. self downcastEvent: #confirmationOfLogout
terminateTransactionForSnapshot "The event from LensSession does not reveal whether we will be coming right back or not, so just get the current transaction squared away. We already know that our session is in a transaction." | window | builder notNil ifTrue: [window := builder window]. (Dialog choose: ((#hasTransactionCommitOrRollback << #lens >> '<1p> has an active transaction. Commit the transaction or roll it back?') expandMacrosWith: self class) labels: (Array with: (#Commit << #lens >> 'Commit') with: (#Rollback << #lens >> 'Rollback')) values: #(commit rollback) default: #commit for: window) == #commit ifTrue: [self databaseCommit] ifFalse: [self forceRollback]
</methods> <methods> Lens.LensApplicationModel <category>accessing</category>
allChildren "Return the Set of all children under the receiver." | result | result := Set withAll: self children. self children do: [:child | child allChildrenInto: result]. ^result
children "Return the direct children of the receiver." children isNil ifTrue: [children := Set new]. ^children
dataModel "Return the LensDataModel to be used by the receiver." ^self class dataModel
existingSession "Find any existing session. Propagate it to the local inst var. Do not create a new session if there isn't one already." session isNil ifTrue: [session := self getExistingSession]. ^session
hasSession "Returns true iff the session is not nil, i.e. if we have already logged in" ^self existingSession notNil
parent "Return the parent of the receiver." ^parent
parent: anApplication "Establish the parent of the receiver." self removeFromParent: parent. parent := anApplication. parent notNil ifTrue: [self attachToParent: parent]
patriarch "Return the topmost parent in the parent/child hierarchy containing the receiver." ^self parent isNil ifTrue: [self] ifFalse: [self parent patriarch]
session "Return the session to be used for this component. Create one if necessary." session isNil ifTrue: [session := self newSession]. ^session
session: aSession "Set the session for the receiver." session removeDependent: self. session := aSession. session notNil ifTrue: [session addDependent: self].
windowOwner "Determine the parent that is topmost within the window shared by the receiver." ^self parent isNil ifTrue: [self] ifFalse: [self parent builder window == self builder window ifTrue: [self parent windowOwner] ifFalse: [self]]
</methods> <methods> Lens.LensApplicationModel <category>actions</category>
clearRows "Clear both internal state and display." self subclassResponsibility
databaseCommit "Commit the current transaction, if any, pending approval from self and all children or dispensation from the user." (self hasSession and: [self existingSession isInTransaction and: [(self patriarch downcastRequest: #requestForCommit) or: [self patriarch downcastEvent: #raiseIfChanging. self confirmDiscardChanges]]]) ifTrue: [self forceCommit]
databaseLogin "Ask the user for the parameters for logging in the database and create a session with those parameters." self hasSession ifTrue: [^self]. self patriarch downcastEvent: #noticeOfLogin. Cursor database showWhile: [self handleLens: [:ex | self patriarch session: nil. ex return] do: [self patriarch session: self dataModel getSession. [self authenticate isNil ifTrue: [self patriarch session: nil. ^self]] ifCurtailed: [self patriarch session: nil]]]. self hasSession ifTrue: [self patriarch downcastEvent: #confirmationOfLogin]
databaseLogout "Shut down the current session, pending approval from self and all children, or dispensation from the user." self hasSession ifFalse: [^self]. ((self patriarch downcastRequest: #requestForLogout) or: [self patriarch downcastEvent: #raiseIfChanging. self confirmDiscardUntransactedChanges]) ifFalse: [^self]. self forceLogout
databaseRollback "Roll back the current transaction, pending approval of self and all children or dispensation from the user. Make the application believe that a rollback has happened even if there was no transaction, so that appropriate actions will be taken." (self hasSession and: [self existingSession isInTransaction and: [(self patriarch downcastRequest: #requestForRollback) or: [self confirmDiscardUntransactedChanges]]]) ifTrue: [self forceRollback]
</methods> <methods> Lens.LensApplicationModel <category>initialize-release</category>
newSession "Either find an existing session in the application, or if necessary acquire a new session by logging into the database." ^self parent isNil ifTrue: [self databaseLogin. session] ifFalse: [parent session]
</methods> <methods> Lens.LensApplicationModel <category>interface opening</category>
openLoginDialogOnUsername: userHolder andPassword: pwdHolder "Open the login dialog and retrieve the required information from the user. This method can be redefined on subclasses when it is necessary for the login dialog to be drastically different." | dialog | dialog := SimpleDialog new. dialog builder aspectAt: #username put: userHolder. dialog builder aspectAt: #pwd put: pwdHolder. ^dialog openFrom: (UISpecification from: self class loginSpec)
postOpenWith: aBuilder "Set up the proper dependency relationships between the receiver's window, the receiver and its parent, establish the necessary window event responses and then open any children that are linked Data Forms." self builder window application: self; bePartner; windowEventBlock: [:receiver :event :sender | event key == #expand ifTrue: [(self allChildren includes: sender application) not] ifFalse: [(self parent notNil and: [self parent windowOwner == sender application]) ifTrue: [event key == #close ifTrue: [receiver reportWindowEvent: #close with: nil. self removeDependent: receiver. receiver controller closeAndUnschedule. true] ifFalse: [false]] ifFalse: [true]]]. self parent notNil ifTrue: [self parent windowOwner addDependent: self builder window. self addDependent: parent windowOwner builder window]. self autoOpenChildren
</methods> <methods> Lens.LensApplicationModel <category>utilities</category>
downcastEvent: aKey "Cause self and all children to reverse-depth-first recursively perform aKey." self downcastEvent: aKey with: nil skip: nil stop: nil request: false topDown: false
downcastEvent: aKey with: aParameter "Cause self and all children to reverse-depth-first recursively perform aKey with aParameter. Use perform:withArguments: if aParameter is an Array, otherwise perform:with:." self downcastEvent: aKey with: aParameter skip: nil stop: nil request: false topDown: false
downcastEvent: aKey with: aParameter skip: skipBlock stop: stopBlock request: requestBoolean topDown: topDownBoolean "Cause self and all children to recursively perform aKey with aParameter. If aParameter is nil, use perform:, if an Array, use perform:withArguments:, otherwise use perform:with:. Skip any recursions for which skipBlock evaluates to true when evaluated with self and aKey and aParameter. Cease recursion wherever stopBlock evaluates to true when evaluated with self and aKey and aParameter. If requestBoolean is true, return false as soon as any recursion evaluates to false, and otherwise return true. If topDownBoolean is false, perform the events on re-ascent rather than on descent." | result | (stopBlock notNil and: [stopBlock value: self value: aKey value: aParameter]) ifTrue: [^(requestBoolean notNil and: [requestBoolean]) ifTrue: [true] ifFalse: [self]]. topDownBoolean ifTrue: [(skipBlock isNil or: [skipBlock value: self value: aKey value: aParameter]) ifTrue: [result := self performEvent: aKey with: aParameter. result == false ifTrue: [^result]] ifFalse: [result := (requestBoolean notNil and: [requestBoolean]) ifTrue: [true] ifFalse: [self]]]. self children copy do: [:child | (child downcastEvent: aKey with: aParameter skip: skipBlock stop: stopBlock request: requestBoolean topDown: topDownBoolean) == false ifTrue: [^false]]. topDownBoolean ifFalse: [(skipBlock isNil or: [(skipBlock value: self value: aKey value: aParameter) not]) ifTrue: [result := self performEvent: aKey with: aParameter. (requestBoolean notNil and: [requestBoolean]) ifTrue: [^result]] ifFalse: [(requestBoolean notNil and: [requestBoolean]) ifTrue: [^true]]]. ^result
downcastRequest: aKey "Cause self and all children to reverse-depth-first recursively perform aKey. Immediately return false upon the first recursion to evaluate to false, otherwise return true." ^self downcastEvent: aKey with: nil skip: nil stop: nil request: true topDown: false
downcastRequest: aKey with: aParameter "Cause self and all children to reverse-depth-first recursively perform aKey with aParameter. Immediately return false upon the first recursion to evaluate to false, otherwise return true. Use perform: if aParameter is null, perform:withArguments: if aParameter is an Array, and otherwise use perform:with:." ^self downcastEvent: aKey with: aParameter skip: nil stop: nil request: true topDown: false
handleLens: handleBlock do: doBlock "Evaluate doBlock, which is expected to take no arguments but which will engage in commerce with the ObjectLens. If anything untoward results, let no unsightly notifiers disgrace the screen, warn the user, and evaluate handleBlock (which as usual takes the exception as its argument). Give any enclosing externalDatabaseErrorSignal handler a chance to strut its stuff as well, however only the outermost invocation will raise a dialog to the user." Signal noHandlerSignal handle: [:ex | ((ex parameter signal inheritsFrom: ExternalDatabaseConnection externalDatabaseErrorSignal) or: [ex parameter signal inheritsFrom: LensDataModel dataDefinitionErrorSignal]) ifTrue: [ex return] ifFalse: [ex reject]] do: [(SignalCollection with: LensSession doNotProceedSignal with: ExternalDatabaseConnection externalDatabaseErrorSignal with: LensDataModel dataDefinitionErrorSignal) handle: [:ex | self notifyUserOfLensException: ex. handleBlock value: ex. ex reject] do: [doBlock value]]
</methods> <methods> Lens.LensApplicationModel <category>binding</category>
clientFor: aKey "Return an object that is to be the runtime client for (i.e. that will provide dynamic resources for) the child Data Form corresponding to aKey. Notify the client of the parent child relationship. Sent by UIBuilder in order to acquire the client as a resource." ^self attachToChild: (self perform: aKey)
retrieveAspect: anAspectSymbol "Retrieve a binding named anAspectSymbol. Return nil if no such binding currently exists. Used for aspect-driven (as opposed to query-driven) sourcing of details." ^self builder bindings at: anAspectSymbol ifAbsent: []
</methods> <methods> Lens.LensApplicationModel <category>updating</category>
update: anAspect with: aParameter from: anObject (anAspect == #terminateTransaction and: [anObject == self existingSession]) ifTrue: [^self terminateTransactionForSnapshot]. (anAspect == #install and: [anObject == self existingSession]) ifTrue: [^self terminateSessionForInstall]. ^super update: anAspect with: aParameter from: anObject
</methods> <methods> Lens.LensApplicationModel class <category>data model accessing</category>
dataModel "Return a LensDataModel according to the receiver's dataModelDesignator, which is an Array of size 2 whose first element is a class name and whose second element is a selector." | dsg ldm cl | dsg := self dataModelDesignator. dsg notNil ifTrue: [cl := (dsg at: 1) asQualifiedReference valueOrDo: [nil]. cl notNil ifTrue: [ldm := cl messageNotUnderstoodSignal handle: [:ex | ex parameter selector == #dataModelAt: ifTrue: [ex returnWith: (self dataModelAt: dsg)] ifFalse: [ex reject]] from: cl do: [cl dataModelAt: dsg]]]. ldm isNil ifTrue: [| str args | str := dsg notNil ifTrue: [#dataModelNotOpened1 << #lens >> 'Data Model could not be opened : <1s> class > <2s>.'] ifFalse: [#dataModelNotOpened2 << #lens >> 'Data Model could not be opened.']. args := dsg notNil ifTrue: [dsg] ifFalse: [#('' '')]. Dialog warn: (str expandMacrosWith: (args at: 1) asString with:(args at: 2) asString). LensDataModel dataDefinitionErrorSignal raise]. ^ldm
dataModelAt: aDesignator "Return a LensDataModel according to the given designator. Return the cached one or create a new one if it's not yet cached or is obsolete. Each data model is cached along with its resource method, so that the condition of an invalid cache can be easily detected." | sel clName cl cache ldm | ((sel := aDesignator at: 2) isNil or: [sel isEmpty]) ifTrue: [^nil]. ((clName := aDesignator at: 1) isNil or: [clName asString isEmpty]) ifTrue: [^nil]. cl := clName asQualifiedReference valueOrDo: [nil]. cl isNil ifTrue: [^nil]. lensDataModels isNil ifTrue: [lensDataModels := Dictionary new] ifFalse: [(cache := lensDataModels at: aDesignator ifAbsent: [nil]) notNil ifTrue: [(cl class includesSelector: sel) ifTrue: [(cl class compiledMethodAt: sel) == (cache at: 1) ifTrue: [ldm := cache at: 2]] ifFalse: [lensDataModels removeKey: aDesignator ifAbsent: []]]]. ldm isNil ifTrue: [ldm := LensDataModel readFromClass: cl methodName: sel. ldm isNil ifTrue: [lensDataModels removeKey: aDesignator ifAbsent: []] ifFalse: [ldm compile. lensDataModels at: aDesignator put: (Array with: (cl class compiledMethodAt: sel) with: ldm)]]. ^ldm
dataModelDesignator "Answers a two-cell array with the class name and the method name that will provide a data model." ^self subclassResponsibility
</methods> <methods> Lens.LensApplicationModel class <category>private</category>
elementLabel: hints ^Label with: (self stringKey: hints)
excludedBindings "Return a list of those models (including actions) already inherited by subclasses of this class, which should not be generated for them by UIDefiner." ^#(#databaseCommit #databaseRollback #databaseLogin #databaseLogout)
relatedBy: token "The LensApplicationModel subclasses may contain embedded or linked data forms in their canvases. These are regarded as references to the embedded or linked data forms. To get them we go through all the canvases of the class and explore the specs with the help of a spec enumerator, then get the embedded or linked data forms or subcanvases that define a client and return an IdentitySet with the referenced classes" | fullSpec enum | token == #referencesRel ifTrue: [| selectors res | res := IdentitySet new. selectors := self class whichSelectorsReferTo: #SpecCollection. selectors do: [:sel | | classNames | fullSpec := self interfaceSpecFor: sel. enum := AspectEnumerator new. enum doSpec: fullSpec. classNames := Set new. classNames addAll: enum clients. enum details do: [:spc | classNames add: spc majorKey]. classNames do: [:clNm | clNm notNil ifTrue: [| cl | cl := self environment at: clNm asSymbol ifAbsent: [nil]. cl notNil ifTrue: [res add: cl]]]]. ^res] ifFalse: [^super relatedBy: token]
</methods> <methods> Lens.LensApplicationModel class <category>interface opening</category>
openInSession: aSession "Open the application on the given session" | inst | inst := self new. inst session: aSession. self openOn: inst
openInSession: aSession withSpec: aSymbol "Create a running instance of the application in the given session, and open its user interface using the designated specification." | inst | inst := self new. inst session: aSession. self openOn: inst withSpec: aSymbol
</methods> <methods> Lens.LensMainApplication <category>accessing</category>
lockPolicy "The lock policy says whether locks will be set for updates at the point where editing begins or at the point where changes are accepted. The lock policy of an application is the lock policy of its class, since there should be no parent to refer to." ^self class lockPolicy
</methods> <methods> Lens.LensMainApplication <category>actions</category>
clearRows "Nothing need be done to clear either internal state or display." ^self
</methods> <methods> Lens.LensMainApplication <category>private</category>
allowPartialCommit "This method can be redefined on subclasses in order to permit databaseCommit while some children have editing that is not yet accepted. This option make sense only when combined with a 'Lock on Accept' Update Locking policy." ^self class allowPartialCommit
</methods> <methods> Lens.LensMainApplication <category>events</category>
localRequestForWindowClose "Permit the closure if there is no active transaction." ^self hasSession not or: [self existingSession isActive not]
requestForLogout "Permit logging out if there is no active transaction." ^self hasSession not or: [self existingSession isActive not]
</methods> <methods> Lens.LensMainApplication <category>resources</category>
menuBar "Session and transaction controls are on the menu bar rather than on action buttons." | mb subM | mb := self class menuBar. (subM := mb atNameKey: #databaseMenu) notNil ifTrue: [| menuItem | subM := subM submenu. (menuItem := subM atNameKey: #databaseLogin) notNil ifTrue: [menuItem enabled: [self hasSession not]]. (menuItem := subM atNameKey: #databaseCommit) notNil ifTrue: [menuItem enabled: [self hasSession and: [self existingSession isInTransaction]]]. (menuItem := subM atNameKey: #databaseRollback) notNil ifTrue: [menuItem enabled: [self hasSession and: [self existingSession isInTransaction]]]. (menuItem := subM atNameKey: #databaseLogout) notNil ifTrue: [menuItem enabled: [self hasSession]]]. ^mb
</methods> <methods> Lens.LensMainApplication class <category>private</category>
allowPartialCommit "This method can be redefined to globally enable, or overridden on a subclass to enable for some set of classes, the ability to have databaseCommits happen even though some children have editing that is not yet accepted. This option make sense only when combined with a 'Lock on Accept' Update Locking policy." ^false
writeEssentialsFor: anApplicationSpec using: definer into: codeStream "Generate essential class-side accessing methods for an application, also the default windowSpec method." definer writeDBApplicationClassSideAccessors: anApplicationSpec on: codeStream. definer writeMainApplicationWindowSpecMethod: anApplicationSpec on: codeStream
</methods> <methods> Lens.LensMainApplication class <category>data model accessing</category>
dataModelDesignator "By default it takes the dataModelSpec for the receiver. If a different one is desired then this method should be redefined in the subclass" ^Array with: self fullName asSymbol with: #dataModelSpec
</methods> <methods> Lens.QueryCompilerErrorHandler <category>private</category>
nonInteractiveError: message | s | s := class printString. selector notNil ifTrue: [s := s , ' ' , selector printString]. Dialog warn: s , ' - ' , message
</methods> <methods> Lens.QueryCompilerErrorHandler <category>error handling</category>
error: type with: message in: node from: codeStream "Possible values of type: #error, message = error message #warning, message = error message #readBeforeWritten, message = var name #neverRead, message = var name, node = assignment #neverUsed, message = var name #redeclared, message = var name #redeclaredBlockArg, message = var name #undeclared, message = var Association #undeclaredStore, message = var Association, node = assignment #noEffect, message = nil, node = statement #notOptimized, message = argument index, node = message send" self nonInteractiveError: message, ' - ', type
newSelectorWarning: newSelector at: sourcePosition self nonInteractiveError: ((#isUnknown << #lens >> '<1s> is unknown') expandMacrosWith: newSelector). ^self abort
noEffect: node from: codeStream self nonInteractiveError: ((#x1sNoEffect << #lensRuntime >> '<1s> - noEffect') expandMacrosWith: node printString)
undeclared: binding in: node from: codeStream self nonInteractiveError: ((#isUndeclared << #lens >> '<1s> is undeclared') expandMacrosWith: binding key). ^self abort
</methods> <methods> Lens.LensTemporaryMain <category>accessing</category>
child "Return the receiver's sole child." ^self children detect: [:ch | true] ifNone: []
dataModel "In the case of a temporary launcher, it is the child that has the goods." ^self child class dataModel
lockPolicy "In the case of a temporary launcher, it is the child that has the goods." ^self child class lockPolicy
session "Check to see if the child already has a session. If not, create one." (session := self child existingSession) notNil ifFalse: [session := self newSession]. ^session
</methods> <methods> Lens.LensTemporaryMain <category>actions</category>
databaseLogout "Close up shop if the child is gone." super databaseLogout. (self hasSession not and: [self child isNil]) ifTrue: [self closeRequest]
</methods> <methods> Lens.LensAbstractProxy <category>accessing</category>
class "Answer the class of the object represented by the receiver. If the lensContainer is nil then the session has been disconnected or the object removed from the database and receiver is not representing any object any more" ^lensContainer isNil ifTrue: [super class] ifFalse: [lensContainer type memberClass]
instVarAt: anIndex "Answer with a fixed variable in an object. The numbering of the variables corresponds to the named instance variables. Fail if the index is not an Integer or is not the index of a fixed variable. Delegates to object it represents." ^self yourself instVarAt: anIndex
lensContainer ^lensContainer
lensContainer: aLensContainer lensContainer := aLensContainer
lensSession ^lensContainer isNil ifTrue: [ nil ] ifFalse: [ lensContainer lensSession ]
</methods> <methods> Lens.LensAbstractProxy <category>testing</category>
isProxy "Answer whether receiver is a proxy." ^true
isSymbol "Coerce Symbols to true and everything else to false." ^false
</methods> <methods> Lens.LensAbstractProxy <category>private-ObjectLens</category>
isPersistent "Answer if receiver is persistent." ^true
</methods> <methods> Lens.LensProxy <category>testing</category>
hasBeenTriggered "Answer whether an attempt has been made to find the row the receiver represents. Ordinarily the receiver turns into an instance of the represented class. hasBeenTriggered == true implies that the row didn't exist when the attempt was made." ^hasBeenTriggered
</methods> <methods> Lens.LensProxy <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('; nextPutAll: externalId printString; nextPut: $)
</methods> <methods> Lens.LensProxy <category>accessing</category>
externalId "Answer the receiver's externalId." ^externalId
</methods> <methods> Lens.LensProxy <category>initialize-release</category>
externalId: anExternalId lensContainer: aLensContainer "Initialize the receiver's state." externalId := anExternalId. lensContainer := aLensContainer. hasBeenTriggered := false.
</methods> <methods> Lens.LensProxy <category>error handling</category>
doesNotUnderstand: aMessage "Trap the message, load and become the referenced object, then retry sending the message." hasBeenTriggered := true. lensContainer isNil ifTrue: [ LensSession triggeringWhenNotOpenSignal raiseErrorString: (#proxyNotAssociatedWithSession << #lens >> 'Attempting to use a proxy which is not associated with any LensSession.' )]. LensSession sessionIsPausedSignal handle: [ :ex | | str | "Expand the message without recording the parameters in the Exception." str := (#accessAttemptWhileSessionPaused << #lens >> 'Attempting to access a persistent <1p> with external ID=<2p><n>via a LensSession that has been paused.') expandMacrosWith: lensContainer type with: externalId. LensSession triggeringWhenNotOpenSignal raiseErrorString: str ] do: [ | object | object := lensContainer at: externalId. ^object perform: aMessage selector withArguments: aMessage arguments ]
</methods> <methods> Lens.LensProxy class <category>instance creation</category>
externalId: externalId lensContainer: aLensContainer "Answer new proxy for the object to be fetched via aLensContainer, having externalId." ^self new externalId: externalId lensContainer: aLensContainer
</methods> <methods> Lens.UIDataReference <category>private</category>
asContainerReference ^LensContainerReference on: referred named: name
fromLiteralArrayEncoding: anArray self name: (anArray at: 3). self referred: (anArray at: 5). 6 to: anArray size by: 2 do: [:i | self perform: (anArray at: i) with: (anArray at: i + 1)]
literalArrayEncoding | a | a := Array new: 5. a at: 1 put: self class fullyQualifiedReference. a at: 2 put: #name:. a at: 3 put: self name. a at: 4 put: #referred:. a at: 5 put: self referredName. ^a
reset ^self
</methods> <methods> Lens.UIDataReference <category>accessing</category>
name ^name isNil ifTrue: [referred name] ifFalse: [name]
name: strOrSymbol strOrSymbol notNil ifTrue: [name := strOrSymbol asSymbol] ifFalse: [name := nil]
referred ^referred
referred: ref referred := ref
referredName referred isSymbol ifTrue: [^referred] ifFalse: [^referred name]
</methods> <methods> Lens.UIDataReference <category>printing</category>
displayString ^referred displayString
printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $)
</methods> <methods> Lens.UIDataReference class <category>private</category>
decodeFromLiteralArray: anArray ^self new fromLiteralArrayEncoding: anArray
</methods> <methods> Lens.UIDataReference class <category>instance creation</category>
on: type named: str | n | n := self new. n referred: type. n name: str. ^n
</methods> <methods> Lens.LensGraphReference <category>accessing</category>
addToCascade: aSymbol cascade addLast: aSymbol asSymbol
application ^application
application: app application := app
cascade ^cascade
cascade: aCollection cascade := aCollection. self addToCascade: self name
cascadeString | s | s := WriteStream on: (String new: 40). self cascade do: [:c | s nextPutAll: c asString; space]. ^s contents
children "may be nil" ^children
children: aCollection "To allow others to set the children" children := aCollection
expressionString cascade isNil ifTrue: [^self name] ifFalse: [^self cascadeString]
getChildren ^self relatedBy: #containsColumnRel
position: anIndex position := anIndex
setCascade: aCollection cascade := aCollection
</methods> <methods> Lens.LensGraphReference <category>private</category>
checkChildren: v | chld | (chld := self children) notNil ifTrue: [chld := chld asSortedCollection: [:a :b | a sortKey < b sortKey]. chld do: [:c | c getChildren size == 0 ifTrue: [v ifTrue: [c application selected: c cascade] ifFalse: [c application deselected: c cascade]]. c changed: #value]]
reset children := nil.
</methods> <methods> Lens.LensGraphReference <category>relationships</category>
sortKey "Returns a 3 digit string appropriately padded with 0's. This will work fine for up to 999 children" position notNil ifTrue: [| str | str := WriteStream on: (String new: 3). position < 100 ifTrue: [str nextPut: $0. position < 10 ifTrue: [str nextPut: $0]]. str nextPutAll: position printString. ^str contents] ifFalse: [^super sortKey]
stringKey: hints ^self name
</methods> <methods> Lens.LensType <category>accessing</category>
computeFieldType "Answer a field type for an attribute whose value type is the receiver." ^self
decoder "Answer a block for decoding." ^LensTranscoder nullTransform
decodeSelector "Answer the receiver's decodeSelector." ^nil
encodeSelector "Answer the receiver's encodeSelector." ^nil
maxColumnConstraint ^nil
memberClass "Answer the receiver's memberClass." ^memberClass
memberClass: newMemberClass "Set the receiver's memberClass to newMemberClass." memberClass := newMemberClass
name "Answer the receiver's name, that of its memberClass." ^name notNil ifTrue: [name] ifFalse: [self memberClass name]
name: aName "Set the receiver's name." name := aName
privateName ^name
</methods> <methods> Lens.LensType <category>copying</category>
cloneStructure ^self
</methods> <methods> Lens.LensType <category>template generation</category>
queryTemplate "Answer an object to be used as a database query template." ^self memberClass queryTemplate
recordTemplate "Answer an object to be used as a database record template." ^self memberClass recordTemplate
recordTemplateForUpdate: forUpdate withUpdateMask: updatedInstVarsMask "Answer an object to be used as a database record template." ^self recordTemplate
</methods> <methods> Lens.LensType <category>private</category>
referenceEncoding "Encode a reference to a type as its name if it is named, else as its literal array." ^self isNamed ifTrue: [name] ifFalse: [self literalArrayEncoding]
resolveReferencesIn: aDataModel "Get the data model's type instance which matches the receiver." ^aDataModel getTypeFor: self
</methods> <methods> Lens.LensType <category>testing</category>
includes: anObject "Answer whether anObject is a member of the receiver." LensType typeViolationSignal handle: [:ex |^false] do: [self checkIncludes: anObject]. ^true
isLensCollectionType "Answer whether receiver is a collection type." ^false
isLensDataType "Answer whether receiver is a datatype, i.e. its members are to be treated as manifest values." ^true
isLensEncodedType "Answer whether receiver is encoded." ^false
isLensEnumerationType "Answer whether receiver is an enumeration type, i.e. its members are in a fixed collection." ^false
isLensStructureType "Answer whether receiver is a structure." ^false
isLensType "Answer whether the receiver behaves as a type." ^true
isMapped "Answer whether receiver is mapped to a database." ^false
isNamed "Answer whether receiver has its own name." ^name notNil
isOrdered "Answer whether the receiver's members are ordered." ^self memberClass canUnderstand: #<
isRowVersion "Answer whether receiver represents a RowVersion field." ^name == #RowVersion
isSerialNumber "Answer whether receiver represents serial numbers." ^name == #SerialNumber
isVariableSize "Answer whether the receiver is a variable-size type." ^self memberClass isVariableSize
references: aLensType "Answer whether the receiver references aLensType." ^false
</methods> <methods> Lens.LensType <category>type checking</category>
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." self checkIncludes: object
shallowIncludes: object "Complain if object isn't a member of the receiver, checking for shallow." ^object isKindOf: self memberClass
</methods> <methods> Lens.LensType <category>printing</category>
print: aspect named: aspectName on: stream "Emit on stream a printed representation of the given aspect and its value." stream nextPutAll: aspectName. (aspect isLensType not or: [aspect isNamed not and: [aspect isLensStructureType]]) ifTrue: [ aspect printOn: stream] ifFalse: [ stream nextPut: $(. aspect printOn: stream. stream nextPut: $)].
</methods> <methods> Lens.LensType <category>initialize-release</category>
initialize
memberClass: aClass dataModel: aDataModel "Create a new type with the given member class in the context of aDataModel." memberClass := aClass
</methods> <methods> Lens.LensType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent." ^self species == type species and: [ self memberClass == type memberClass and: [ self name == type name]]
</methods> <methods> Lens.LensType <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. memberClass := memberClass asQualifiedReference valueOrDo: [memberClass].
</methods> <methods> Lens.LensType <category>error handling</category>
signalTypeViolation: object "Signal that object isn't a member of receiver." LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>')
</methods> <methods> Lens.LensType class <category>private</category>
encodedAspects ^#(#(#privateName #name:) #memberClass)
valueEncoder ^[:value | (value isKindOf: LensType) ifTrue: [value referenceEncoding] ifFalse: [value isBehavior ifTrue: [value fullyQualifiedReference] ifFalse: [value literalArrayEncoding]]]
</methods> <methods> Lens.LensType class <category>instance creation</category>
memberClass: memberClass dataModel: aDataModel "Create a new type with the given member class in the context of aDataModel." ^self new memberClass: memberClass
newFor: object in: schema "Answer a new type associated with the given object, in the schema, as follows: - object is a class -> answer a dataType, structureType, or objectCollectionType - object is a collection -> answer an enumerationType." | obj | obj := object. obj isBehavior ifTrue: [ ^obj typeClass new memberClass: obj dataModel: schema] ifFalse: [ (obj isKindOf: Collection) ifTrue: [ ^LensEnumerationType new members: obj] ifFalse: [ self definitionErrorSignal raiseWith: obj errorPattern: (#errCreatingType << #lens >> 'Can''t create type for <1p>')]]
</methods> <methods> Lens.LensType class <category>signal access</category>
definitionErrorSignal "Answer the signal indicating an error in a type definition." ^DefinitionError
typeViolationSignal "Answer the signal indicating a type membership violation." ^TypeViolation
variableUndefinedSignal "Answer the signal indicating attempted reference to an undefined variable." ^VariableUndefined
</methods> <methods> Lens.LensType class <category>class initialization</category>
initialize "LensType initialize" self initializeExceptionClasses
initializeExceptionClasses "Initialize related exception classes." DefinitionError notifierString: (#typeDefinitionSignal << #lens >> 'Type definition error'); nameClass: self message: #definitionErrorSignal. TypeViolation notifierString: (#typeViolation << #lens >> 'type violation error'); nameClass: self message: #typeViolationSignal. VariableUndefined notifierString: (#variableUndefined << #lens >> 'Variable is undefined.'); nameClass: self message: #variableUndefinedSignal.
</methods> <methods> Lens.LensStructureType <category>private</category>
decoder "Answer receiver's decoder, generating decoder and encoder if decoder is nil." decoder == nil ifTrue: [ self generateTranscoders]. ^decoder
decoder: newDecoder "Set the receiver's decoder." decoder := newDecoder
encode: object inSession: session "Answer an encoding of object." ^encoder == nil ifTrue: [ object] ifFalse: [ encoder applyTo: object class basicNew with: object lensContainer: session]
encoder "Answer receiver's encoder, generating decoder and encoder if decoder is nil." "NOTE: types must have decoders, while they might or might not have encoders, so we use decoder as a flag to control generation of transcoders." decoder == nil ifTrue: [ self generateTranscoders]. ^encoder
encoder: newEncoder "Set the receiver's encoder." encoder := newEncoder
flushTranscoders "Flush encoder and decoder to force regeneration." encoder := decoder := nil. self variables do: [ :var | var flushTranscoders ]. externalIdClosure := nil
generateTranscoders "Generate encoder and decoder if not already user-defined." | gen transporterClass bogus | transporterClass := self dataModel databaseContext class transporterClass. gen := LensMethodGenerator newFor: memberClass. encoder := transporterClass encoderForType: self using: gen. "create a place-holder decoder for children-set queries, then swap with actual decoder" decoder := ValueHolder new. decoder value: (bogus := transporterClass decoderForType: self using: gen). decoder := bogus. self isMapped ifTrue: [ externalIdClosure := transporterClass externalIdClosureFor: self using: gen].
printTypeOn: stream stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
setVariables: newVariables "Set the receiver's variables to newVariables." variables := newVariables
variables: newVariables "Set the receiver's variables to newVariables." 1 to: newVariables size do: [ :i | (newVariables at: i) objectType: self; instVarIndex: i ]. self setVariables: newVariables
</methods> <methods> Lens.LensStructureType <category>data model generation</category>
accumulateIn: set "Add self and all reachable variables in set." | vars | 1 to: (vars := self variables) size do: [ :index | (vars at: index) accumulateIn: set ]
addIndex: index "Add an index to the receiver." indexes isNil ifTrue: [ indexes := OrderedCollection new]. indexes add: index
addIndexNamed: indexName isPrimary: isPrimary isUnique: isUnique indexVariablesNamed: varNames "Add an index to the receiver whose name is indexName, with the given primaryness and uniqueness. The index applies to the columns mapped to the variables whose names are varNames." self addIndex: (LensDatabaseIndex new name: indexName; isPrimary: isPrimary; isUnique: isUnique; indexedVariables: (varNames collect: [:varName | self variableNamed: varName]))
addPrimaryIndexNamed: indexName "Add a primary index to the receiver whose name is indexName." | indexVars | indexVars := OrderedCollection new. self idVariable forLeavesDo: [ :var | indexVars add: var ]. self addIndex: (LensDatabaseIndex new name: indexName; isPrimary: true; isUnique: true; indexedVariables: indexVars)
computeFieldType "Answer a field type for a variable whose value type is the receiver." ^self isMapped ifTrue: [ self getIdVariable setFieldType computeFieldType ] ifFalse: [ self cloneStructure ]
findOverlappingVariables "Find and process multiple variables that are mapped to the same column." | columnDict | columnDict := IdentityDictionary new. self mappedVariablesDo: [:var | var forLeavesDo: [:subVar | | canonicalVariable | (canonicalVariable := columnDict at: subVar column ifAbsent: [nil]) notNil ifTrue: [subVar overlapsOtherVariables: true. subVar isCanonicalVariable: false. canonicalVariable overlapsOtherVariables ifFalse: [canonicalVariable overlapsOtherVariables: true. canonicalVariable overlappingVariablePaths: OrderedCollection new]. subVar overlappingVariablePaths: canonicalVariable overlappingVariablePaths] ifFalse: [subVar overlapsOtherVariables: false. subVar overlappingVariablePaths: nil. subVar isCanonicalVariable: true. columnDict at: subVar column put: subVar]]]. self mappedVariablesDo: [:var | var checkForContainedOverlaps]. self mappedVariablesDo: [:var | var checkForContainedNonoverlappingNullables]. self mappedVariablesDo: [:var | var addOverlappingVariablePaths: nil]
inheritVariables "Inherit variable copies from supertypes in hierarchy." | instVarNames obType superVars newVars | superVars := supertype memberClass == Object ifTrue: [#()] ifFalse: [ supertype variables ]. newVars := OrderedCollection new. instVarNames := (supertype isNil or: [supertype memberClass == Object]) ifTrue: [memberClass allInstVarNames] ifFalse: [memberClass instVarNames]. obType := self dataModel notNil ifTrue: [self dataModel typeOf: Object] ifFalse: [Object type]. "add copies of supertypes' variables to newVars collection if no local variable exists" superVars do: [ :superVar | newVars add: (self variableNamed: superVar name ifNone: [superVar copy isId: false; isMapped: false; column: nil; objectType: self])]. instVarNames do: [:n | newVars add: (self variableNamed: n ifNone: [ LensStructureVariable name: n valueType: obType objectType: self ]) ]. "set variables to array of the new variables and set their indices" 1 to: newVars size do: [:i | (newVars at: i) instVarIndex: i]. self setVariables: newVars asList. "propagate change to subtypes" self subtypesDo: [ :subtype | subtype setupInheritance ]
isReadyToSetFieldType: set "We can go ahead and set the fieldType as long as the structure is not mapped or each of the variables which make up the key are ready." self isMapped ifFalse: [ ^true ]. self idVariables do: [ :var | (var isReadyToSetFieldType: set) ifFalse: [^false] ]. ^true
newTableNamed: tableName "Map receiver to a new table with the given name, answering the new table." ^self dataModel databaseContext class tableClass new name: tableName.
setFieldType (self isMapped and: [self idVariable isNil]) ifTrue: [ self setIdVariable ]
setIdVariable "Set the idVariable." | idVar idVars | idVars := self idVariables. idVars size == 0 ifTrue: [ self error: (#errTypeNoIDVariables << #lens >> 'type has no id variables') ]. idVars size == 1 ifTrue: [ idVar := idVars first. idVar setFieldType] ifFalse: [ | fieldType | fieldType := LensStructureType memberClass: Array variables: idVars asArray. fieldType dataModel: self dataModel. idVar := LensStructureVariable new isMapped: true; objectType: self; isId: true; fieldAndValueType: fieldType ]. self idVariable: idVar. ^idVar
setSupertype "Set the supertype by searching the class hierarchy." | ldm class | (ldm := self dataModel) notNil ifTrue: [ class := memberClass superclass. [(supertype := ldm typeOf: class) isNil] whileTrue: [ class := class superclass ]].
setupInheritance "Set the supertype by searching the class hierarchy, and share attributes." self setSupertype. self inheritVariables.
</methods> <methods> Lens.LensStructureType <category>accessing</category>
allRecordVariables "Answer a collection of variables mapped to the database, including variables for surrogateIds as appropriate." | recVars | recVars := OrderedCollection new. self recordVariablesDo: [ :var | recVars add: var ]. ^recVars
columns "Answer the receiver's columns." | vars result | vars := self allRecordVariables. result := IdentitySet new: vars size * 3 // 2. vars do: [:var | result add: var column]. "Remove duplicates." ^result asOrderedCollection
dataModel "Answer the data model to which the receiver is bound." ^dataModel
dataModel: newDataModel "Set the data model to which the receiver is bound." dataModel := newDataModel
defersPostingUpdates "Answer if updates to the receiver's members should be defered." ^defersPostingUpdates
defersPostingUpdates: flag "Set if updates to the receiver's members should be defered." defersPostingUpdates := flag
externalIdClosure: newClosure "Set the closure for computing the externalId of an object." externalIdClosure := newClosure
getIdVariable "Answer idVariable, constructing it if nil" self idVariable == nil ifTrue: [ self setIdVariable ]. ^self idVariable
idGeneratorType "Answer the type of generator for externalIds used by receiver's members." ^idGeneratorType
idGeneratorType: newType "Set the type of generator for externalIds used by receiver's members, one of #(userDefinedId sequenceId)." idGeneratorType := newType
idVariable "Answer the receiver's idVariable, which describes the property (or properties) of the receiver's members by which they are identified in the database." ^idVariable
idVariable: variable "Set the receiver's idVariable." idVariable := variable
idVariables "Answer the receiver's id variables." ^self variables select: [ :var | var isId ]
indexes "Answer the collection of indexes on receiver, answering an empty array if nil." ^indexes isNil ifTrue: [#()] ifFalse: [indexes]
indexes: newIndexes "Set the receiver's indexes collection." indexes := newIndexes
name "Answer the receiver's name, that of its memberClass." ^name notNil ifTrue: [name] ifFalse: [memberClass notNil ifTrue: [memberClass isSymbol ifTrue: [memberClass] ifFalse: [memberClass name]] ifFalse: [(#unnamed1 << #lensRuntime >> '<unnamed>') asString]]
referencingMappedVariables "Answer all mapped variables that reference type." | refVars | refVars := OrderedCollection new. self dataModel structureTypes do: [ :t | t variables do: [ :var | (var isMapped and: [var valueType references: self]) ifTrue: [ refVars add: var ]]]. ^refVars
referencingVariables "Answer all variables that reference type." | refVars | refVars := OrderedCollection new. self dataModel structureTypes do: [ :t | t variables do: [ :var | (var valueType references: self) ifTrue: [ refVars add: var ]]]. ^refVars
serialNumberVariable "Answer a serial numbered variable, if any." ^self variables detect: [ :var | var valueType isSerialNumber ] ifNone: [ nil ]
subtypes "Answer a collection of the receiver's immediate subtypes." ^self dataModel structureTypes select: [:type | type supertype == self]
supertype "Answer the receiver's supertype, if any." ^supertype
table "Answer the table to which the receiver maps the objectType." ^table
table: newTable "Set the table to which the receiver maps the objectType." table := newTable
tableName "Answer the receiver's tableName." ^self table qualifiedName
tableName: newTableName "Set the receiver's tableName to newTableName." self table name: newTableName.
tableNameOn: aStream "Write the receiver's tableName on aStream." ^self table qualifiedNameOn: aStream
usesDataType: aType ^((self variables detect: [ :var | | valueType | valueType := var valueType. valueType == aType or: [ valueType isLensStructureType and: [ valueType isMapped not and: [ valueType usesDataType: aType ]]]] ifNone: [ nil ]) == nil) not
variableMappedTo: column "Answer the variable mapped to the column." | idVar | self recordVariablesDo: [ :var | (var column = column) ifTrue: [ ^var ] ]. ^(self isMapped and: [ (idVar := self idVariable) column = column]) ifTrue: [ idVar ] ifFalse: [ nil ]
variableNamed: varName "Answer the variable with the given name, complaining not found." ^self variableNamed: varName ifNone: [ self class variableUndefinedSignal raiseWith: (Array with: self with: varName) ]
variableNamed: variableName ifNone: block "Answer the variable named variableName. If none, evaluate block." | varName | varName := variableName asString. ^self variables detect: [ :var | var name = varName ] ifNone: block
variables "Answer the receiver's variables." ^variables
</methods> <methods> Lens.LensStructureType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent, meaning that both have the same number of attributes, and that the attributes are equivalent without regard to order." | vars | self == type ifTrue: [^true]. (super isEquivalentTo: type) ifFalse: [^false]. (vars := self variables) size == type variables size ifFalse: [^false]. vars do: [ :var | | otherVar | otherVar := type variableNamed: var name ifNone: [^false]. (var valueType isEquivalentTo: otherVar valueType) ifFalse: [^false]]. ^true
</methods> <methods> Lens.LensStructureType <category>relationships</category>
containsTypeRel ^self variables asSet
mappedRel "This method implements the Falcon relationship 'mappedRel'" self isMapped ifTrue: [^IdentitySet with: table] ifFalse: [^IdentitySet new]
metaMappedRel "Not needed any more" ^IdentitySet new
relatedBy: token "The Falcon relationships dispatcher for this class" (#(#mappedRel #relatedRel #metaMappedRel containsTypeRel) includes: token) ifTrue: [^self perform: token] ifFalse: [^super relatedBy: token]
relatedRel "This method implements the Falcon relationship 'relatedRel'" ^self variables asSet
stringKey: hints "The string to be used when I'm presented in a Falcon graph" "If our name is nil we use the name of the member class" ^(name isNil ifTrue: [memberClass printString] ifFalse: [name])
</methods> <methods> Lens.LensStructureType <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. table := table decodeAsLiteralArray. self variables: (List withAll: (self variables collect: [:t | t decodeAsLiteralArray])). indexes := indexes asOrderedCollection collect: [:index | index decodeAsLiteralArray]. indexes do: [:index | index indexedVariables: (index indexedVariables collect: [ :varName | self variableNamed: varName])].
privateIdVariable "Answer the value of idVariable suitable for encoding in a literal spec." | idVar | (idVar:= self idVariable) isNil ifTrue: [ ^nil ]. ^(idVar valueType isLensStructureType and: [idVar valueType isMapped not]) ifTrue: [ idVar valueType variables collect: [ :each | each name ] ] ifFalse: [ Array with: idVar name ]
referenceEncoding "Encode a reference to a type as its name if it is registered, else as its literal array." ^(self dataModel notNil and: [self dataModel structureTypes includes: self]) ifTrue: [ self name ] ifFalse: [ self literalArrayEncoding ]
resolveReferencesIn: aDataModel "Work through the structure type and fix up duplicate references within the data model" | vars | self dataModel: aDataModel. 1 to: (vars := self variables) size do: [ :index | (vars at: index) resolveReferencesIn: aDataModel ]. "It's safe now to reconstruct the idVariable." self setIdVariableFromNameArray: self idVariable.
resolveStandalone "Use a generic data model to let the type reference resolution mechanism work." "By not adding the receiver as a structure type in the data model, references to it from itself will be resolved as LensReferenceType instances rather than by a reference to itself." | gdm | gdm := LensDataModel new. gdm databaseContext: LensDatabaseContext new. self resolveReferencesIn: gdm. self dataModel: nil
setIdVariableFromNameArray: nmArr "Set the idVariable according to the name(s) given in nmArr" | idVar | nmArr size > 0 ifTrue: [ | idVars fieldType | idVars := nmArr collect: [ :each | self variableNamed: each ]. idVars size == 1 ifTrue: [ idVar := idVars at: 1 ] ifFalse: [ "The idVariable is complex." fieldType := LensStructureType memberClass: Array variables: idVars asArray. fieldType dataModel: self dataModel. idVar := LensStructureVariable new isMapped: true; objectType: self; isId: true; fieldAndValueType: fieldType ]. self idVariable: idVar ] ifFalse: [ self idVariable: nil ]
</methods> <methods> Lens.LensStructureType <category>method generation</category>
flushAccessMethods "Flush generated access methods." self variables do: [ :var | var flushAccessMethods ].
generateAccessMethods "Add access methods for variables." self variables do: [ :var | var generateAccessMethods ].
regenerateAccessMethods "Regenerate access methods for variables." self variables do: [ :var | var regenerateAccessMethods ].
</methods> <methods> Lens.LensStructureType <category>initialize-release</category>
initialize variables := List new. defersPostingUpdates := true.
memberClass: class dataModel: aDataModel "Initialize receiver to constrain class, adding variables corresponding to class's instVars, and attaching the receiver to aDataModel." memberClass := class. self setVariables: List new. self dataModel: aDataModel. "register type so subtypes can find" (aDataModel structureTypes includes: self) ifFalse: [ aDataModel structureTypes add: self ]. defersPostingUpdates := true. idGeneratorType := #userDefinedId. self setupInheritance
memberClass: class variables: vars memberClass := class. variables := vars
</methods> <methods> Lens.LensStructureType <category>testing</category>
isLensDataType "Answer whether receiver is a datatype, i.e. its members are to be treated as manifest values." ^false
isLensStructureType "Answer whether receiver is a structure type." | vars | ^(vars := self variables) notNil and: [vars isEmpty not]
isMapped "Answer whether receiver is mapped to a database table." ^table notNil
isRelation "Answer whether receiver represents a relation." self isUserKeyed ifFalse: [^false]. self idVariable forLeavesDo: [ :var | var valueType isMapped ifFalse: [^false]]. ^true
isRoot "Answer whether receiver is at top of its local type hierarchy." ^supertype isLensDataType
isSequenceKeyed "Answer whether receiver's ids are sequence ids." ^idGeneratorType == #sequenceId
isUserKeyed "Answer whether receiver's ids are user-defined." ^idGeneratorType == #userDefinedId
matchesClass "return whether the receiver's variables are are of the same number, order and name as those of the memberClass" | instVars vars var | vars := self variables. instVars := self memberClass allInstVarNames. (instVars size = vars size) ifFalse: [^false]. 1 to: instVars size do: [:index | var := vars at: index. (var name = (instVars at: index) ) ifFalse: [^false]. ]. ^true.
references: aType "Answer whether the receiver references aType." ^self == aType
</methods> <methods> Lens.LensStructureType <category>type checking</category>
checkIncludes: object "Complain if object isn't a member of the receiver. Checks for class membership, and shallow membership of its attributes if the receiver is typed." | i vars | object == nil ifFalse: [ memberClass checkShallowIncludes: object. i := (vars := self variables) size. LensType typeViolationSignal handle: [:ex | ex signal raiseWith: ( Array with: (vars at: i) name with: self with: ex errorString) errorPattern: (#errTypeViolationOnVariable << #lens >> 'Type violation on variable:<nt><1p><n>of:<nt><2p><nn><3p>')] do: [ [i > 0] whileTrue: [ (vars at: i) checkShallowIncludes: (object instVarAt: i). i := i - 1]]]
checkShallowIncludes: object "Complain if object isn't a member of the receiver. Checks for class membership, and shallow membership of its attributes if the receiver is typed." object == nil ifFalse: [ memberClass checkShallowIncludes: object ]
</methods> <methods> Lens.LensStructureType <category>iteration</category>
allSubtypesDo: block "Evaluate block in the context of all types in the hierarchy in preorder, including the receiver." block value: self. self subtypesDo: block
clearMappings "Clears the mappings in myself and all my variables" table := nil. self mappedVariablesDo: [:v | v beUnmappedOfType: v valueType. v resetFieldType]
mappedVariablesDo: block "Evaluate block for each mapped variable." | vars | 1 to: (vars := self variables) size do: [ :index | | var | var := vars at: index. var isMapped ifTrue: [ block value: var ] ]
recordVariablesDo: block "Evaluate block for each of objectType's stored variables." self variables do: [ :var | var forLeavesDo: [ :var2 | var2 isMapped ifTrue: [ block value: var2 ]]]
subtypesDo: block "Evaluate block in the context of all types in the hierarchy in preorder, excluding the receiver." self subtypes do: [:subtype | subtype allSubtypesDo: block]
variablesDo: block "Evaluate block for each variable." self variables do: [ :var | var forLeavesDo: block ]
</methods> <methods> Lens.LensStructureType <category>template generation</category>
queryTemplate "Answer a new template for querying members of the receiver." | template | template := memberClass queryTemplate. self variables do: [ :var | template instVarAt: var instVarIndex put: Object new]. ^template
recordTemplate "Answer an object to be used as a database record template." ^self recordTemplateForUpdate: false withUpdateMask: nil.
recordTemplateForUpdate: forUpdate withUpdateMask: updatedInstVarsMask "Answer an object to be used as a database record template." | vars recordTemplate | vars := self variables. memberClass isVariableSize ifTrue: [ recordTemplate := memberClass new: vars size. 1 to: vars size do: [ :i | recordTemplate at: i put: ((vars at: i) fieldTemplateForUpdate: forUpdate withUpdateMask: updatedInstVarsMask)] ] ifFalse: [ | size | size := vars size. size == memberClass instSize ifFalse: [ self dataModel dataDefinitionErrorWith: (Array with: self dataModel displayString with: self name asString) errorPattern: (#errDataDefinitionDifferentVariables << #lens >> '<1p> data definition error:<n>Entity <2p> and its class have a different number of variables and instVars')]. recordTemplate := memberClass basicNew. vars do: [ :var | recordTemplate instVarAt: var instVarIndex put: (var fieldTemplateForUpdate: forUpdate withUpdateMask: updatedInstVarsMask)]]. ^recordTemplate
</methods> <methods> Lens.LensStructureType <category>printing</category>
displayString | strm | strm := (String new: 128) writeStream. strm nextPutAll: self name. ^strm contents
printOn: stream "Answer a string naming the receiver." super printOn: stream. self printTypeOn: stream
storeOn: aStream self printOn: aStream
</methods> <methods> Lens.LensStructureType <category>runtime support</category>
copyPacked: object "Answer a copy of object in which only packed objects are copied." | copy | copy := object shallowCopy. self variables do: [ :var | var isPacked ifTrue: [ var setValueOf: object to: (var valueType copyPacked: (var getValueOf: object))]]. ^copy
externalIdOf: object in: objectLens "Answer object's externalId in the objectLens." ^externalIdClosure applyTo: object in: objectLens
</methods> <methods> Lens.LensStructureType <category>copying</category>
cloneStructure "Make a (shallow) copy of myself and then clone the structure of my variables. Take care of reusing the cloned variables for the id by building the id again from an array with the names of the id variables" | clone | clone := self copy. clone variables: (self variables collect: [:var | var cloneStructure objectType: clone]). self setIdVariableFromNameArray: self privateIdVariable. ^clone
</methods> <methods> Lens.LensStructureType class <category>private</category>
encodedAspects ^#(#(#variables #setVariables:) #table #defersPostingUpdates #(#privateIdVariable #idVariable:) #idGeneratorType #indexes)
</methods> <methods> Lens.LensStructureType class <category>instance creation</category>
memberClass: class variables: vars ^self new memberClass: class variables: vars
new ^super new initialize
</methods> <methods> Lens.LensStructureType class <category>accessing</category>
generatedIdColumnName "Answer the name of system-generated id columns." ^(#systemGeneratedID << #lensRuntime >> 'systemGeneratedID') asString
</methods> <methods> Lens.LensCollectionType <category>accessing</category>
elementType "Answer the receiver's elementType." ^elementType
elementType: newType "Set the receiver's elementType." elementType := newType
key: newKeyType value: newValueType "Set the type of elements and keys in the receiver's (collection) members." keyType := newKeyType. elementType := newValueType.
keyType "Answer the type of keys in the receiver's (collection) members." ^keyType
keyType: newKeyType "Set the receiver's keyType to newKeyType." keyType := newKeyType
linkType "Answer the type of links used to attach the receiver's elements." ^linkType
linkType: newType "Set the receiver's linkType." linkType := newType
maxColumnConstraint "Answer the maximum number of elements that may be contained in the receiver's members." ^SmallInteger maxVal
of: newType "Set the type of elements stored in the receiver's (collection) members." elementType := newType
</methods> <methods> Lens.LensCollectionType <category>type checking</category>
checkIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifTrue: [^self]. memberClass checkShallowIncludes: object. keyType == nil ifTrue: [ object do: [:element | elementType checkIncludes: element]] ifFalse: [ object associationsDo: [:association | elementType checkIncludes: association value. keyType checkIncludes: association key]]
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." | elemType | object == nil ifTrue: [^self]. memberClass checkShallowIncludes: object. elemType := elementType. keyType == nil ifTrue: [ object do: [:element | elemType checkShallowIncludes: element]] ifFalse: [ | kType | kType := keyType. object associationsDo: [:association | elemType checkShallowIncludes: association value. kType checkShallowIncludes: association key]]
shallowIncludes: object "Complain if object isn't a member of the receiver, shallowing shallowly." object == nil ifTrue: [^self]. object isKindOf: self memberClass. keyType == nil ifTrue: [ object do: [:element | elementType shallowIncludes: element]] ifFalse: [ object associationsDo: [:association | elementType shallowIncludes: association value. keyType shallowIncludes: association key]]
</methods> <methods> Lens.LensCollectionType <category>private</category>
printTypeOn: stream stream nextPutAll: ' ('. name notNil ifTrue: [self printNameOn: stream] ifFalse: [self memberClass printOn: stream. elementType notNil ifTrue: [keyType isNil ifTrue: [stream nextPutAll: (#Of << #lensRuntime >> ' of: ') asString. elementType isNil ifTrue: [stream nextPutAll: (#unspecified << #lensRuntime >> 'unspecified') asString] ifFalse: [elementType printNameOn: stream]] ifFalse: [self print: keyType named: (#Key << #lensRuntime >> ' key: ') asString on: stream. stream nextPut: Character space. self print: elementType named: (#Value << #lensRuntime >> ' value: ') asString on: stream]]]. stream nextPut: $)
resolveReferencesIn: aDataModel | ldm | super resolveReferencesIn: aDataModel. elementType := (ldm := self dataModel) resolveType: elementType. keyType := ldm resolveType: keyType. linkType := ldm resolveType: linkType.
</methods> <methods> Lens.LensCollectionType <category>testing</category>
isLensCollectionType "Answer whether receiver is a collection type." ^true
references: aType "Answer whether the receiver references aType." ^self == aType or: [ (elementType references: aType) or: [ keyType notNil and: [keyType references: aType]]]
</methods> <methods> Lens.LensCollectionType <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. elementType := elementType decodeAsLiteralArray. keyType := keyType decodeAsLiteralArray. linkType := linkType decodeAsLiteralArray.
</methods> <methods> Lens.LensCollectionType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent." self == type ifTrue: [^true]. ^(super isEquivalentTo: type) and: [ (self keyType isEquivalentTo: type keyType) and: [ (self elementType isEquivalentTo: type elementType)]]
</methods> <methods> Lens.LensCollectionType class <category>private</category>
encodedAspects ^#(#keyType #elementType #linkType)
</methods> <methods> Lens.LensRegistry <category>private</category>
changeCapacityTo: newCapacity "Change the size of the receiver to newCapacity. The receiver will be regrown if necessary to fit its contents." "Note that #rehash uses this -- don't optimize the case where the receiver doesn't change in size." | newSelf | newSelf := self copyEmpty: newCapacity. self keysAndValuesDo: [:key :value | newSelf noCheckAt: key put: value]. self become: newSelf
findKeyOrNil: key "Look for the key in the receiver. If it is found, answer the index of the association containting the key, otherwise answer the index of the first unused slot." | index length probe pass | length := self basicSize. pass := 1. index := self initialIndexFor: key identityHash boundedBy: length. [(probe := keyArray at: index) == nil or: [probe == key]] whileFalse: [(index := index + 1) > length ifTrue: [index := 1. pass := pass + 1. pass > 2 ifTrue: [^self grow findKeyOrNil: key]]]. ^index
noCheckAt: key put: value "Assume that the key is already in the receiver and store the value without checking to make sure." | index | index := self findKeyOrNil: key. keyArray at: index put: key. tally := tally + 1. ^self basicAt: index put: value
removeAndCleanUpAtIndex: index "Remove the key at the given index, relocating any following entries as needed." | location oldKey length | keyArray at: index put: nil. self basicAt: index put: nil. tally := tally - 1. length := self basicSize. location := index. [location := location = length ifTrue: [1] ifFalse: [location + 1]. (keyArray at: location) == nil] whileFalse: [oldKey := self findKeyOrNil: (keyArray at: location). location = oldKey ifFalse: [self swap: location with: oldKey]]
removeDangerouslyKey: key ifAbsent: errorBlock self shouldNotImplement
setTally "Initialize tally and other instance variables." super setTally. keyArray := Array new: self basicSize
swap: oneElement with: otherElement "Store otherElement in the position for oneElement, and vice versa." super swap: oneElement with: otherElement. keyArray swap: oneElement with: otherElement
</methods> <methods> Lens.LensRegistry <category>copying</category>
postCopy super postCopy. keyArray := keyArray copy
</methods> <methods> Lens.LensRegistry <category>adding</category>
add: anAssociation "Include anAssociation as one of the receiver's elements. Answer anAssociation." self at: anAssociation key put: anAssociation value. ^anAssociation
</methods> <methods> Lens.LensRegistry <category>accessing</category>
associationAt: key ifAbsent: aBlock "Answer an Association consisting of key and the value of the receiver at that key. If key is not found, evaluate aBlock." | index storedKey | index := self findKeyOrNil: key. ^(storedKey := keyArray at: index) == nil ifTrue: [aBlock value] ifFalse: [Association key: storedKey value: (self basicAt: index)]
at: key ifAbsent: aBlock "Answer the value at key. If key is not found, evaluate aBlock." | index | index := self findKeyOrNil: key. ^(keyArray at: index) == nil ifTrue: [aBlock value] ifFalse: [self basicAt: index]
at: key put: value "Set the value at key to be value." | index | key == nil ifTrue: [^self subscriptBoundsError: key]. index := self findKeyOrNil: key. (keyArray at: index) == nil ifTrue: [tally := tally + 1. keyArray at: index put: key]. self basicAt: index put: value. self fullCheck. ^value
keyAtValue: value ifAbsent: exceptionBlock "Answer the key whose value equals the argument, value. If there is none, answer the result of evaluating exceptionBlock." | theKey | 1 to: self basicSize do: [:index | value == (self basicAt: index) ifTrue: [(theKey := keyArray at: index) == nil ifFalse: [^theKey]]]. ^exceptionBlock value
keys "Answer a set containing the receiver's keys." | aSet | aSet := IdentitySet new: self size. self keysDo: [:key | aSet add: key]. ^aSet
</methods> <methods> Lens.LensRegistry <category>dictionary removing</category>
removeKey: key ifAbsent: aBlock "Remove key from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value associated with key." | index value | index := self findKeyOrNil: key. (keyArray at: index) == nil ifTrue: [^aBlock value]. value := self basicAt: index. self removeAndCleanUpAtIndex: index. ^value
</methods> <methods> Lens.LensRegistry <category>dictionary enumerating</category>
associationsDo: aBlock "Evaluate aBlock for associations consisting of the receiver's keys and their values." 1 to: self basicSize do: [:index | (keyArray at: index) == nil ifFalse: [aBlock value: (Association key: (keyArray at: index) value: (self basicAt: index))]]
</methods> <methods> Lens.LensRegistry <category>enumerating</category>
do: aBlock "Evaluate aBlock with each of the receiver's elements as the argument." 1 to: self basicSize do: [:index | (keyArray at: index) == nil ifFalse: [aBlock value: (self basicAt: index)]]
keysAndValuesDo: aBlock "Evaluate aBlock with each of the receiver's key/value pairs as the arguments." 1 to: self basicSize do: [:index | | key | (key := keyArray at: index) == nil ifFalse: [aBlock value: key value: (self basicAt: index)]]
</methods> <methods> Lens.LensDataModelGenerator <category>classes management</category>
automaticClassForType: aLST "Creates a class based on the description found in the type aLST" | varNames cl confirmedName vs theClass superclass cat ns | confirmedName := aLST memberClass. cl := confirmedName asQualifiedReference valueOrDo: [nil]. cl isNil ifTrue: [superclass := Object. cat := (self defaultCategory: false). cat isNil ifTrue: [cat := ClassOrganizer defaultProtocol]] ifFalse: [superclass := cl superclass. cat := cl category]. "Build a class to match the description" varNames := aLST variables collect: [:v | v name]. vs := String new writeStream. varNames do: [:vn | vs nextPutAll: vn; space]. vs := vs contents. ns := confirmedName asQualifiedReference environment. theClass := ns defineClass: confirmedName simpleName superclass: superclass name asQualifiedReference indexedType: #none private: false instanceVariableNames: vs classInstanceVariableNames: String new imports: String new category: cat. SourceFileManager default logChange: theClass definition. aLST memberClass: theClass. "do not Generate accessor methods now, it may be dangerous because the data model may be not completely resolved yet, regenerate the methods later." ^theClass
</methods> <methods> Lens.LensDataModelGenerator <category>annotations</category>
updateClassFromAnnotation: typ "typ is a LensStructureType, check the class and update it's instance variables according to the type's" | cl newVariables newNames newLocalNames superNames vs theClass ns | cl := typ memberClass. newVariables := typ variables. superNames := cl superclass allInstVarNames. newNames := newVariables collect: [:var | var name]. newLocalNames := (newNames reject: [:nm | superNames includes: nm]) copy. vs := String new writeStream. newLocalNames do: [:vn | vs nextPutAll: vn; space]. vs := vs contents. ns := cl environment. theClass := ns defineClass: cl name asQualifiedReference simpleName superclass: cl superclass name asQualifiedReference indexedType: cl behaviorType private: ((ns bindingFor: cl name asSymbol) isPrivate) instanceVariableNames: vs classInstanceVariableNames: cl class instanceVariablesString imports: cl asNameSpace importString category: cl category. SourceFileManager default logChange: theClass definition. typ regenerateAccessMethods. ^true
</methods> <methods> Lens.LensGlobalDescriptor <category>state transitions</category>
add: object externalId: anExternalId lensContainer: aContainer "Add receiver to the object registry for a newly-persistent object." | objectLens | self register: object externalId: anExternalId lensContainer: aContainer. (objectLens := lensContainer lensSession) isInTransaction ifTrue: [ objectLens isActive: true. self persistence: Added ]
commit "Perform commit state transition." | persistence | persistence := self persistence. persistence == Added ifTrue: [ self persistence: Persistent ]. lastCommitedVersion := nil. self markClean
finalize "Finalize receiver when being removed from a weak registry." "Assume: the objectRegistryIndex was set to nil before this is invoked." self unregister
lock | accessor stream objectLens | objectLens := lensContainer lensSession. objectLens delayingOperations ifTrue: [self saveLastCommitedVersionOf: self object. ^objectLens addPendingLock: self object]. objectLens lensPolicy transactionsAreSerializable ifFalse: [accessor := lensContainer locking. accessor operation postFlag: false. accessor answer: [:x | x externalId]. accessor selectWhere: [:x | x externalId = self externalId]. stream := accessor readStream. stream atEnd ifTrue: ["Check whether there is still a row, but don't worry about multiples. That will be detected soon enough (in an update for example)." LensSession rowForObjectNotFoundSignal raise]. stream close]
markClean "Note that object has been updated in image from database." self synchronization: Clean.
markDirty "Note that object has been updated in image and not database." self synchronization: Dirty.
markPendingRemoval "Note that a request for the object to be Removed has been made." "Set the receiver's synchronization state." flags := flags bitOr: PendingRemoval.
postOrDeferUpdateOf: object "Make note of the need to update this object or do it depending on the policy." | objectLens | self objectIsRemoved ifTrue: [ ^self ]. objectLens := lensContainer lensSession. (objectLens isInTransaction and: [lensContainer type defersPostingUpdates]) ifTrue: [ objectLens addPendingOperation: object ] ifFalse: [ self postUpdateOf: object ]
postUpdateOf: object "Update the associated record." | objectLens newId | objectLens := lensContainer lensSession. "Nothing to do if the object is clean or has been removed in this transaction." (updatedInstVarsMask == 0 or: [self objectIsRemoved]) ifTrue: [ ^self ]. objectLens delayingOperations ifTrue: ["treat postUpdateOf: as no-op" ^ self]. "If the identity will be changed (only possible for a user defined key)" (lensContainer type isUserKeyed and: [externalId ~= (newId := lensContainer type externalIdOf: object in: objectLens)]) ifTrue: [ "Check for references. If there are any, this will raise exceptions." lensContainer checkForReferencesToId: externalId] ifFalse: [ "Prevent even the thought they might be different." newId := externalId ]. "Do the update if there are unposted changes." objectLens resetCascadedAdds. "Protection for side-effect adds" [ lensContainer transporter update: object withId: externalId andMask: updatedInstVarsMask withOldObject: lastCommitedVersion] ensure: [ objectLens resetCascadedAdds ]. "if identity changed..." externalId ~= newId ifTrue: [ "Check for identity conflict not reported by dbms. This minimizes cache corruption, but the only reasonable recovery from this is to rollback the transaction since we succeeded in making the change. The database clearly isn't enforcing uniqueness and an update or delete will get all of the rows, not just the one the application thinks it is manipulating." (lensContainer privateCache includesKey: newId) ifTrue: [ lensContainer class objectNotUniquelyIdentifiedSignal raise ] ]. "Everything worked, clean up our state machine." updatedInstVarsMask := 0. lastCommitedVersion := nil. objectLens isInTransaction ifTrue: [ objectLens isActive: true. self markDirty ]. "Ensure that the entry in pendingUpdates is gone." objectLens removePendingOperation: object. "if identity changed, reregister in cache" externalId ~= newId ifTrue: [ "The key has changed." (objectLens isInTransaction and: [objectLens keyChanges includesKey: self]) ifFalse: [ "This is the first change to the key in this transaction. Save original key in case of rollback." objectLens keyChanges at: self put: externalId ]. "Update the externalId and reregister the object we just updated." self externalId: newId ]
readd: object withId: newId "Note that object has been readded to database." | objectLens | objectLens := lensContainer lensSession. "Return to container's cache" lensContainer register: self at: externalId. "This is the equivalent of postUpdateOf: for any changed fields as they were sent to the server when the row was reinserted." (objectLens isInTransaction and: [updatedInstVarsMask > 0]) ifTrue: [ self markDirty ]. updatedInstVarsMask := 0. lastCommitedVersion := nil. externalId ~= newId ifTrue: [ "The key has changed." (objectLens isInTransaction and: [objectLens keyChanges includesKey: self]) ifFalse: [ "This is the first change to the key in this transaction. Save original key in case of rollback." objectLens keyChanges at: self put: externalId ]. self externalId: newId ]. "Change state from Removed to Persistent." self persistence: Persistent. objectLens removedObjects remove: self
refresh: object "The object is being refreshed. This will discard any pending updates." updatedInstVarsMask > 0 ifTrue: [ lensContainer lensSession removePendingOperation: object. updatedInstVarsMask := 0. lastCommitedVersion := nil]
register: object externalId: anExternalId lensContainer: aContainer "Add receiver to the object registry." externalId := anExternalId. lensContainer := aContainer. updatedInstVarsMask := 0. lastCommitedVersion := nil. LensGlobalDescriptor at: object put: self. lensContainer register: self at: externalId
removeFromLens "Note that object has been removed from database." self objectIsAdded ifTrue: [ self unregister ] ifFalse: [ | objectLens | self persistence: Removed. objectLens := lensContainer lensSession. objectLens isInTransaction ifTrue: [ objectLens isActive: true. objectLens removedObjects add: self ]. lensContainer removeKey: self externalId ].
resetPendingRemoval "Note that a request for the object to be removed has not been made." "Set the receiver's synchronization state." flags := flags maskClear: PendingRemoval
revert "Revert receiver's object to a proxy." | object | ((object := self object) isProxy or: [object == nil]) ifFalse: [ self postUpdateOf: object. object become: (LensProxy externalId: externalId lensContainer: lensContainer)]
revertDiscardingUnpostedUpdates "Revert receiver's object to a proxy without posting the updates." | object | ((object := self object) isProxy or: [object == nil]) ifFalse: [ self markClean. updatedInstVarsMask := 0. lastCommitedVersion := nil. object become: (LensProxy externalId: externalId lensContainer: lensContainer)]
rollback "Perform rollback state transition." | persistence | (persistence := self persistence) == Added ifTrue: [ ^self unregister ]. persistence == Removed ifTrue: [ self persistence: Persistent. lastCommitedVersion := nil. ]. (self objectIsDirty or: [self objectHasUnpostedUpdates]) ifTrue: [ updatedInstVarsMask := 0. lastCommitedVersion := nil. self revert. self markClean ]. self resetPendingRemoval.
saveLastCommitedVersionOf: object "Make a shallow copy of object to save its state at the start of the current transaction." lastCommitedVersion := object shallowCopy.
unregister "Unregister receiver, removing it from the registry, cache and any side collections." | objectLens ori | objectLens := lensContainer lensSession. objectLens removedObjects remove: self ifAbsent: []. objectLens keyChanges removeKey: self ifAbsent: []. self objectIsRemoved ifFalse: [ lensContainer removeKey: externalId ]. Registry registryCritical: [(ori := self objectRegistryIndex) notNil ifTrue: [ | obj | (obj := self object) isProxy ifTrue: [ obj lensContainer: nil ]. objectLens removePendingOperation: obj. LensGlobalDescriptor removeAtIndex: ori ]]
update: object instVarAt: index put: value "Update object's instVar indicated by index to value." (lensContainer lensSession savingLastCommitedVersions and: [lastCommitedVersion isNil]) ifTrue: [self saveLastCommitedVersionOf: object]. object instVarAt: index put: value. "Track who changed and mark dirty just case it is readded in this transaction." updatedInstVarsMask := updatedInstVarsMask bitOr: (1 bitShift: index - 1).
</methods> <methods> Lens.LensGlobalDescriptor <category>accessing</category>
externalId "Answer the receiver's externalId." ^externalId
externalId: newId "Set the receiver's externalId, reregistering receiver in it's container's cache." lensContainer reregister: self at: newId. externalId := newId.
lastCommitedVersion "Answer the receiver's lastCommitedVersion or if not saved then nil." ^lastCommitedVersion
lensContainer "Answer the receiver's container." ^lensContainer
lensContainer: newContainer "Set the receiver's lensContainer to newContainer." lensContainer := newContainer
object "Answer the object represented by the receiver. Answer nil if object has been garbage collected." | object | object := Registry registryCritical: [ self class keyAtIndex: self objectRegistryIndex]. ^object == 0 ifTrue: [ nil ] ifFalse: [ object ]
objectRegistryIndex "Answer the receiver's index in the object registry." ^objectRegistryIndex
objectRegistryIndex: newIndex "Set the receiver's index in the object registry." objectRegistryIndex := newIndex
persistence "Answer the receiver's persistence state." ^flags bitAnd: PersistenceState
persistence: newPersistence "Set the receiver's persistence state." flags := (flags maskClear: PersistenceState) bitOr: newPersistence.
persistenceSymbol "Answer a symbol describing the persistence state." | persistence | persistence := self persistence. persistence == Persistent ifTrue: [ ^#persistent ]. persistence == Added ifTrue: [ ^#added ]. persistence == Removed ifTrue: [ ^#removed ].
synchronization "Answer receiver's synchronization state." ^flags bitAnd: Dirty
synchronization: newSynchronization "Set the receiver's synchronization state." flags := (flags maskClear: Dirty) bitOr: newSynchronization
synchronizationSymbol "Answer a symbol describing the synchronization state." ^self objectIsDirty ifTrue: [ self objectHasUnpostedUpdates ifTrue: [ #dirtyWithUnpostedUpdates ] ifFalse: [ #dirty ] ] ifFalse: [ self objectHasUnpostedUpdates ifTrue: [ #cleanExceptForUnpostedUpdates ] ifFalse: [ #clean ] ]
</methods> <methods> Lens.LensGlobalDescriptor <category>testing</category>
objectHasUnpostedUpdates "Answer whether receiver's object has unposted changes." ^updatedInstVarsMask > 0
objectIsAdded "Answer whether receiver's object has been added." ^(flags bitAnd: Added) > 0
objectIsDirty "Answer whether receiver's row has been updated in the current transaction. This does not reflect pending updates which have yet to be posted to the database." ^self synchronization > 0
objectIsPendingRemoval "Answer whether receiver's object is pending a removal." ^(flags bitAnd: PendingRemoval) > 0
objectIsPersistent "Answer whether receiver's object is persistent." "An object with a LensGlobalDescriptor must be persistent unless it has been removed in the current transaction." ^self objectIsRemoved not
objectIsRemoved "Answer whether receiver's object has been removed." ^(flags bitAnd: Removed) > 0
</methods> <methods> Lens.LensGlobalDescriptor <category>tracing</category>
traceFrom: aTracer aTracer raiseInvalidTraceSignalOn: self
</methods> <methods> Lens.LensGlobalDescriptor <category>initialize-release</category>
initialize flags := Persistent bitOr: Clean
</methods> <methods> Lens.LensGlobalDescriptor <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' (object='; print: self object; nextPutAll: ' id='; print: externalId; nextPutAll: ' state='; nextPutAll: self persistenceSymbol; nextPut: $,; nextPutAll: self synchronizationSymbol; nextPut: $)
</methods> <methods> Lens.LensGlobalDescriptor class <category>accessing-registry</category>
at: object ifAbsent: aBlock "Answer the global descriptor at object. If object isn't registered, answer the result of evaluating aBlock." ^Registry at: object ifAbsent: aBlock
at: object put: descriptor "Register descriptor under object." ^Registry at: object put: descriptor
descriptorsIn: objectLens do: aBlock "Invoke aBlock with each registry entry which belongs to objectLens." Registry descriptorsIn: objectLens do: aBlock
keyAtIndex: index "Answer the object at the given index." ^Registry keyAtIndex: index
removeAll: aCollection "Remove each element of aCollection from the receiver. If successful for each, answer aCollection." ^Registry removeAll: aCollection
removeAtIndex: index "Remove the object at the given index." ^Registry removeAtIndex: index
removeObjectsIn: objectLens "Remove all descriptors for objects in objectLens." Registry removeObjectsIn: objectLens
</methods> <methods> Lens.LensGlobalDescriptor class <category>class initialization</category>
initialize "LensGlobalDescriptor initialize" "define persistence state subfield and its values" Persistent := 0. Added := 1. "indicates has been added during trans" Removed := Added * 2. "indicates has been removed during trans" PersistenceState := Added + Removed. "define synchronization state subfield and its values" Clean := 0. "indicates no change" Dirty := Removed * 2. "indicates has been updated" "define pending state subfield and its values" PendingRemoval := Dirty * 2. "Indicates Remove at commit time." "Initialize the registry" Registry := LensObjectRegistry new
</methods> <methods> Lens.LensGlobalDescriptor class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensContainerReference <category>private</category>
asContainerReference "Return a copy of myself since whoever is asking may want to change me" ^self copy
</methods> <methods> Lens.LensContainerReference <category>relationships</category>
elementLabel: hints "If the hints include #simple, then we do nothing special. Otherwise we will return a check box that will enable the user to select all the subfields at once" (hints includes: #simple) ifTrue: [^super elementLabel: hints] ifFalse: [| chb | chb := CheckBoxSpec new. chb label: self name asString. chb model: false asValue. chb model compute: [:v | self checkChildren: v]. chb layout: LayoutOrigin new. ^Array with: chb]
relatedBy: token "The only relationship known here is #containsColumnRel. It returns a collection of LensVariableReference s for each one of the variables found in the referred type. The cascade of each variable reference is set so it individually contains the whole cascade of aspects required to get to the variable. The application is also notified of the newly created variable reference, this is needed for LensApplicationSpecEditor" token == #containsColumnRel ifTrue: [children isNil ifTrue: [children := Set new. referred mappedVariablesDo: [:st | | c | c := LensVariableReference on: st named: nil. c application: application. c cascade: (cascade isNil ifTrue: [OrderedCollection with: self name] ifFalse: [cascade]) copy. application notNil ifTrue: [application addVarRef: c]. children add: c]]. ^children]. ^super relatedBy: token
stringKey: hints ^name
</methods> <methods> Lens.LensContainerReference <category>printing</category>
displayString ^self name
</methods> <methods> Lens.LensInstanceVariable <category>private-code generation</category>
emitStore: codeStream value: value from: assignment "Emit code to assign a value to the variable." self emitStorePop: codeStream value: value from: assignment. self emitLoad: codeStream from: nil
emitStorePop: codeStream value: value from: assignment "Emit code to assign a value to the variable." VariableNode new name: 'SELF'; emitValue: codeStream. codeStream pushConstant: index+1. value emitValue: codeStream forAssignment: assignment. codeStream noteSourceNode: assignment. codeStream sendNoCheck: #instVarAt:put: numArgs: 2. codeStream pop
</methods> <methods> Lens.LensInstanceVariable <category>code generation</category>
emitLoad: codeStream from: var VariableNode new name: 'SELF'; emitValue: codeStream. codeStream pushConstant: index+1. codeStream sendNoCheck: #instVarAt: numArgs: 1.
</methods> <methods> Lens.LensValueSurrogate <category>symbolic evaluation</category>
doesNotUnderstand: message "Trap the message, and answer a symbolic evaluation." | nextVariable selector method class | selector := message selector. nextVariable := self nextVariableNamed: selector. ^(message arguments size = 0 and: [nextVariable notNil]) ifTrue: [nextVariable isMapped ifTrue: [ "evaluate attribute selection" self navigateThrough: nextVariable] ifFalse: [nextVariable isChildrenPointer ifTrue: [ LensChildrenSetSurrogate new variable: nextVariable inverseVariable path: self] ifFalse: [ LensContainer cannotQueryLocalVariableSignal raiseWith: (Array with: selector)]]] ifFalse: [ (class := (type memberClass whichClassIncludesSelector: selector)) == nil ifFalse: [ "evaluate query predicate" method := (class compiledMethodAt: selector) copy. method mclass: self class. method isSafeAsQuery ifFalse: [ LensContainer invalidPredicateSignal raiseWith: (Array with: selector)]. method valueWithReceiver: self arguments: message arguments] ifTrue: [ LensContainer queryErrorSignal raiseWith: (Array with: selector with: type) errorPattern: (#errSelectionBlockInvalidSelector << #lens >> 'Query error: selection block sends invalid selector <1p> to an instance of <2p>')]]
externalId "Answer a surrogate that answers the receiver's externalId." ^self navigateThrough: type idVariable
isMemberOf: class "Answer a surrogate that answers whether receiver is an instance of class." ^type memberClass == class
nextVariableNamed: selector "Answer the next variable in the current path whose name is selector." ^type variableNamed: selector ifNone: [nil]
</methods> <methods> Lens.LensValueSurrogate <category>comparing</category>
isLike: object "Answer a surrogate that answers whether receiver is like object." | condition value subcondition next | (type memberClass commonSuperclass: object class) == Object ifTrue: [ LensType typeViolationSignal raiseWith: (Array with: self with: object) errorPattern: (#incompatibleTypes << #lens >> '<1p> and <2p> have incompatible types')]. type isLensDataType ifTrue: [ ^(type memberClass includesBehavior: String) ifTrue: [self compare: #isLike: with: object] ifFalse: [self = object]]. condition := true. type mappedVariablesDo: [ :var | (value := object instVarAt: var instVarIndex) isAnything ifFalse: [ next := self perform: var name. "creates a variableSurrogate" subcondition := value == nil ifTrue: [next isNil] ifFalse: [(value isKindOf: BlockClosure) ifTrue: [value value: next "was self"] ifFalse: [(var isReference and: [value isPersistent]) ifTrue: [next = value] ifFalse: [next isLike: value]]]. condition := condition == true ifTrue: [subcondition] ifFalse: [condition & subcondition]]]. ^condition
</methods> <methods> Lens.LensSubquerySurrogate <category>initialize-release</category>
type: aType objectSurrogate: surrogate "Initialize receiver's state." type := aType. objectSurrogate := surrogate
</methods> <methods> Lens.LensSubquerySurrogate <category>subquerying</category>
answer: anAnswerBlock "Set the answerBlock." | result | answerBlock := anAnswerBlock. result := answerBlock value: objectSurrogate. variable := result Attribute. type := result Type.
select: selectBlock "Evaluate the selectBlock and capture the resulting select condition parse tree." condition := selectBlock value: objectSurrogate.
select: selectBlock answer: anAnswerBlock "Answer a collection of values selected by selectBlock, whose shape is specified by anAnswerBlock." self select: selectBlock; answer: anAnswerBlock
</methods> <methods> Lens.LensSubquerySurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPut: Character space. self printTypeOn: stream
</methods> <methods> Lens.LensSubquerySurrogate <category>accessing</category>
AnswerBlock "Answer the receiver's answerBlock." ^answerBlock
Attribute ^variable
Condition "Answer the receiver's select condition parse tree." ^condition
Condition: newCondition "Set the receiver's select condition parse tree." condition := newCondition
ObjectSurrogate "Answer the target of the selection." ^objectSurrogate
</methods> <methods> Lens.LensSubquerySurrogate <category>testing</category>
IsContainerSurrogate "Answer whether receiver is a container surrogate." ^true
</methods> <methods> Lens.LensSubquerySurrogate <category>symbolic evaluation</category>
AccumulateAttributesIn: variableSet "Accumulate all accessed variables into variableSet." variableSet add: variable. condition AccumulateAttributesIn: variableSet
</methods> <methods> Lens.LensSubquerySurrogate <category>private</category>
printTypeOn: stream stream nextPut: $(. objectSurrogate printTypeOn: stream. stream nextPutAll: ' select: '. (condition class inheritsFrom: LensQuerySurrogate) ifTrue: [condition printTypeOn: stream] ifFalse: [condition printOn: stream]. stream nextPut: $).
</methods> <methods> Lens.LensStructureVariable <category>private</category>
childrenSetDecodingStatementUsing: g | cont | cont := g variable: 'CONTAINER'. self targetValueType == objectType ifFalse: [ cont := g to: (g to: cont send: #lensSession) send: #containerOf: withArg: (g variable: self targetValueType name)]. ^g to: (g variable: LensCollectionProxy name asString) send: #query:lensContainer:parent: withArgs: (Array with: (g literal: self childrenSetQuery) with: cont with: g forSelf)
childrenSetQuery "Answer the children set query for getting the value of the receiver." | lens container id type | lens := LensSession privateOn: self dataModel. container := LensBaseContainer new. type := self targetValueType. lens containers at: type put: container. "ignore complaint the session is closed" LensSession sessionIsDisconnectedSignal handle: [:ex | ex proceed] do: [container type: type lensSession: lens]. id := objectType idVariable fieldTemplate. ^container transporter queryFor: (container selectWhere: [:x | (x perform: inverse) externalId = id]) operation.
correctColumnForNewValueType self isMapped ifTrue: [valueType isLensStructureType ifTrue: [| ids | (ids := valueType idVariables) size ~~ 1 ifTrue: [self beUnmappedOfType: valueType] ifFalse: [ids first fieldType isVariableSize not ifTrue: [self column maxColumnConstraint: nil]]] ifFalse: [valueType isVariableSize not ifTrue: [self column maxColumnConstraint: nil]]]
decodingStatementInPlace: inPlaceFlag using: g "Generate a decoding statement based on decoder, using generator g. If inPlaceFlag is true, emit an update inplace." "In place indicates that the object being 'encoded-from' will be the final object and so there is no decoding work to do for non-reference fields." | record container source value variable | record := g variable: 'RECORD'. container := g variable: 'CONTAINER'. variable := g variable: name. source := inPlaceFlag ifTrue: [variable] ifFalse: [self fetchFrom: record using: g]. "generate expresion for decoded variable value" value := self isReference ifTrue: [ g to: (g to: container send: #lensSession) send: #objectOf:withId: withArgs: (Array with: (g literal: valueType) with: source)] ifFalse: [(self isMapped and: [self decodeSelector notNil]) ifTrue: [ g newCondition: (g to: source send: #== withArg: g forNil) ifTrue: source ifFalse: (g to: source send: self decodeSelector)] ifFalse: [ self isPacked ifTrue: [false "valueIsTrivial -- someday optimize for trivial decoders" ifTrue: [source] ifFalse: [| dec | "If we're generating the same decoder we want to use, we'll temporarily find that the decoder is a ValueHolder. In that case, use the ValueHolder as the literal, and send #value to it." dec := fieldType decoder. (dec isKindOf: ValueModel) ifTrue: [dec := g to: (g literal: dec) send: #value] ifFalse: [dec := g literal: dec]. g to: dec send: #applyTo:lensContainer: withArgs: (Array with: source with: container)]] ifFalse: [self isChildrenPointer ifTrue: [self childrenSetDecodingStatementUsing: g] ifFalse: [source]]]]. "omit statement if decoding is in-place and is trivial" (value == source and: [inPlaceFlag]) ifTrue: [^self]. g addStatement: ((inPlaceFlag and: [self isPacked]) ifTrue: [ value] ifFalse: [ g assign: variable value: value])
encode: value in: session "Answer the encoding of the value in the session. If the value to be encoded is nil, do not apply the encodeSelector" | encodeSelector typeEncoder | ^self isReference ifTrue: [ session externalIdOf: value inContainerOf: valueType] ifFalse: [(encodeSelector := self encodeSelector) notNil ifTrue: [ value isNil ifTrue: [nil] ifFalse: [value perform: encodeSelector asSymbol]] ifFalse: [ self isPacked ifTrue: [ (typeEncoder := valueType encoder) isNil ifTrue: [value] ifFalse: [ typeEncoder applyTo: valueType memberClass basicNew with: value lensContainer: session]] ifFalse: [value "((value isKindOf: String) and: [value includes: $*]) ifTrue: [value asString copyReplaceAll: '*' with: '%'] ifFalse: [value]"]]]
encodeVariableOf: object in: session withUpdateMask: updatedInstVarsMask "Answer the encoding of the value in the session." | decodedValue | decodedValue := self encode: (object instVarAt: self instVarIndex) in: session. self overlapsOtherVariables ifFalse: [^decodedValue]. ^self isCompound ifTrue: [self handleOverlappingSubvariablesOf: decodedValue within: object in: session withUpdateMask: updatedInstVarsMask] ifFalse: [self encodeOverlappingVariableOf: nil within: object in: session withUpdateMask: updatedInstVarsMask]
encodingStatementUsing: g ifNonTrivial: nonTrivialBlock "Emit a statement for encoding a value based on the receiver's encoder." | object session source value | object := g variable: 'OBJECT'. session := g variable: 'SESSION'. "generate encoded value expression" value := self overlapsOtherVariables ifTrue: [ source := nil. g to: (g literal: self) send: #encodeVariableOf:in:withUpdateMask: withArgs: (Array with: object with: session with: g forNil)] ifFalse: [source := g to: object send: #instVarAt: withArg: (g literal: self instVarIndex). self isReference ifTrue: [g to: session send: #externalIdOf:inContainerOf: withArgs: (Array with: source with: (g literal: valueType))] ifFalse: [self encodeSelector notNil ifTrue: [g newCondition: (g to: source send: #== withArg: g forNil) ifTrue: source ifFalse: (g to: source send: self encodeSelector)] ifFalse: [self isPacked ifTrue: [| enc | (enc := fieldType encoder) isNil ifTrue: [source] ifFalse: [g to: (g literal: enc) send: #applyTo:with:lensContainer: withArgs: (Array with: (g to: (g variable: fieldType memberClass name) send: #basicNew) with: source with: session)]] ifFalse: [source]]]]. value == source ifFalse: ["notify that statement is non-trivial" nonTrivialBlock value]. g addStatement: (g assign: (g variable: name) value: value)
fetchFrom: source using: generator "Answer a fetch statement." ^generator to: source send: #instVarAt: withArg: (generator literal: self instVarIndex)
flags "Answer the receiver's flags." ^flags
flags: newFlags "Set the receiver's flags." flags := newFlags
flushTranscoders "Flush packed type transcoders to force regeneration." (fieldType notNil and: [fieldType isLensStructureType]) ifTrue: [ self fieldType flushTranscoders]
maskClear: mask "Clear the flag bits in the mask." flags := flags maskClear: mask
maskSet: mask "Set the flag bits in the mask." flags := flags bitOr: mask
privateIsMapped: flag "Set whether receiver describes a variable that is mapped to one or more fields." flag ifTrue: [ self maskSet: IsMappedMask] ifFalse: [ self maskClear: IsMappedMask].
setValueType: newType "Set the type of the variable's values without affecting the column." valueType := newType.
</methods> <methods> Lens.LensStructureVariable <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. valueType := valueType decodeAsLiteralArray. fieldType := fieldType decodeAsLiteralArray. column := column decodeAsLiteralArray
isReadyToSetFieldType: set ^self isReference ifTrue: [(set includes: valueType) not] ifFalse: [self isPacked ifFalse: [true] ifTrue: [ fieldType variables do: [ :var | (var isReadyToSetFieldType: set) ifFalse: [^false]]. true]]
pickledCheckAlways "The default value for checkAlways on a newly created instance of the receiver is false and so there is no need to encode this condition in the data model specification. Answering nil arranges for the keyword-value pair to be omitted." ^self checkAlways ifTrue: [ true ] ifFalse: [ nil ]
pickledCheckIfModified "The default value for checkIfModifed on a newly created instance of the receiver is false and so there is no need to encode this condition in the data model specification. Answering nil arranges for the keyword-value pair to be omitted." ^self checkIfModified ifTrue: [ true ] ifFalse: [ nil ]
pickledIsId "The default value for isId on a newly created instance of the receiver is false and so there is no need to encode this condition in the data model specification. Answering nil arranges for the keyword-value pair to be omitted." ^self isId ifTrue: [ true ] ifFalse: [ nil ]
pickledIsNotNil "The default value for isNotNil on a newly created instance of the receiver is false and so there is no need to encode this condition in the data model specification. Answering nil arranges for the keyword-value pair to be omitted." ^self isNotNil ifTrue: [ true ] ifFalse: [ nil ]
possiblyPropogateTable: aLensType "If we find an embedded structure type, it needs to have the table set to match the table from the parent. There is no back reference from the embedded structure type to the parent so we need to push it down as follows." aLensType isLensStructureType ifTrue: [ aLensType table: self objectType table ]
resolveReferencesIn: aDataModel "Eliminate duplicate references for the value and field types and the column (if any)." valueType := aDataModel resolveType: valueType. fieldType notNil ifTrue: [ fieldType isSymbol ifFalse: [ self possiblyPropogateTable: fieldType ]. fieldType := aDataModel resolveType: fieldType ]. column notNil ifTrue: [ column := self objectType table addUniqueColumn: column ]
</methods> <methods> Lens.LensStructureVariable <category>accessing</category>
accessorSelector "Answer the selector for accessing the receiver's instVar." ^name asSymbol
checkAlways: flag "Set whether the underlying column value represented by the receiver should be verified as to have not been modified when we are posting a change." flag ifTrue: [ self maskSet: CheckAlwaysMask] ifFalse: [ self maskClear: CheckAlwaysMask].
checkIfModified: flag "Set whether the underlying column value represented by the receiver should be verified as to have not been modified when the receiver has been modified and we are posting a change." flag ifTrue: [ self maskSet: CheckIfModifiedMask] ifFalse: [ self maskClear: CheckIfModifiedMask].
column "Answer the column to which the receiver maps its variable." ^column
column: newColumn "Set the receiver's column." column := newColumn
columns "Answer the columns to which the receiver is mapped." ^self isCompound ifFalse: [column notNil ifTrue: [Array with: column] ifFalse: [#()]] ifTrue: [ | columns | columns := OrderedCollection new: 128. fieldType variables do: [:att | columns addAll: att columns]. columns]
dataModel "Answer the data model to which the receiver's objectType is bound." ^objectType dataModel
decoder "Answer a decoder for the receiver's values." ^self isReference ifTrue: [ LensTranscoder dereferenceWithType: valueType] ifFalse: [ | selector | (selector := self decodeSelector) == nil ifTrue: [ LensTranscoder nullTransform] ifFalse: [ LensTranscoder sendMessage: selector]]
decodeSelector "Answer the selector to be sent to domain values to decode themselves." ^valueType decodeSelector
effectiveValueType "Answer the type of the variable's values, taking into account packing." ^(self isPacked or: [valueType isSerialNumber]) ifTrue: [fieldType] ifFalse: [valueType]
encodeSelector "Answer the selector to be sent to domain values to encode themselves." ^valueType encodeSelector
fieldAndValueType: newType "Set both field and value types." fieldType := newType. valueType := newType.
fieldType "Answer the InfoWare type of the receiver's database field." ^fieldType
fieldType: newType "Set the InfoWare type of the variable's database field." fieldType := newType
generatesAccessor: flag "Set whether receiver generates an accessor method." flag ifTrue: [ self maskSet: GeneratesAccessorMask. self regenerateAccessor] ifFalse: [ self maskClear: GeneratesAccessorMask].
generatesMutator: flag "Set whether receiver generates a mutator method, and regenerate mutator." flag ifTrue: [ self maskSet: GeneratesMutatorMask. self regenerateMutator] ifFalse: [ self maskClear: GeneratesMutatorMask].
hasNonoverlappedNullableVariables: flag "Set whether this variable or one of its subvariables is nullable and is not mapped to the same column as some other variable." flag ifTrue: [self maskSet: HasNonoverlappedNullableVariablesMask] ifFalse: [self maskClear: HasNonoverlappedNullableVariablesMask]
instVarIndex "Answer the index of the instVar described by variable." ^flags bitAnd: IndexMask
instVarIndex: newIndex "Set the index of the instVar described by variable." self maskClear: IndexMask; maskSet: newIndex
inverse "Answer the name of the inverse variable, if any." ^inverse
inverse: newInverse "Set the name of the inverse variable. Adjust access methods accordingly." self flushAccessMethods. inverse := newInverse. self regenerateAccessMethods.
inverseVariable "Answer the inverse variable, linking it if unlinked. Answer nil if none." | inverseType | inverse == nil ifTrue: [^nil]. (inverseType := self targetValueType) isLensType ifFalse: [^nil]. ^inverseType variableNamed: inverse ifNone: [^nil].
isCanonicalVariable: flag "Set whether I am either a non overlapped field or if overlapped am the designated canonical variable." flag ifTrue: [ self maskSet: IsCanonicalVariableMask] ifFalse: [ self maskClear: IsCanonicalVariableMask].
isId: flag "Set whether variable is a component of a user-visible id." flag ifTrue: [self maskSet: IsIdMask] ifFalse: [self maskClear: IsIdMask]
isMapped: flag "Set whether receiver describes a variable that is mapped to one or more fields. Adjust mutators accordingly." flag == self isMapped ifTrue: [^self]. self privateIsMapped: flag. self flushAccessMethods. self regenerateAccessMethods. objectType notNil ifTrue: [ self resetFieldType].
mutatorSelector "Answer the selector for updating the receiver's instVar." ^(name , ':') asSymbol
name "Answer the attribute's name." ^name
name: newValue "Set the variable's name." name := newValue
objectType "Answer the type of object containing the variable." ^objectType
objectType: newType "Set the type of object containing the variable." objectType := newType.
overlappingVariablePaths "Answer the overlappingVariablePaths collection." ^overlappingVariablePaths
overlappingVariablePaths: newCollection "Set the overlappingVariablePaths collection." overlappingVariablePaths := newCollection.
overlapsOtherVariables: flag "Set whether this variable or one of its subvariables is mapped to the same column as some other variable." flag ifTrue: [ self maskSet: OverlapsOtherVariablesMask] ifFalse: [ self maskClear: OverlapsOtherVariablesMask].
targetValueType "Answer the receiver's ultimate target valueType." | targetValueType | valueType isLensDataType ifTrue: [^nil]. targetValueType := valueType. ^self isChildrenPointer ifTrue: [targetValueType elementType] ifFalse: [targetValueType]
valueType "Answer the type of the variable's values." ^valueType
valueType: newType "Set the type of the variable's values, and reset the fieldType. If the valueType is of fixed size and we have a column, make sure the length of the column is nil" self checkAlways: newType isRowVersion. "Until we have UI for this" valueType == newType ifTrue: [^self]. valueType := newType. self correctColumnForNewValueType. self resetFieldType
</methods> <methods> Lens.LensStructureVariable <category>access method management</category>
accessorDefinition "Answer a string which is the definition of an access for receiver." | stream | stream := (String new: 40) writeStream. stream nextPutAll: name; cr; tab; nextPutAll: '"Answer the receiver''s '; nextPutAll: name; nextPutAll: '."'; cr; cr. self isChildrenPointer ifTrue: [ stream tab; nextPutAll: name; nextPutAll: ' == nil ifTrue: ['; cr. stream tab; tab; nextPutAll: name; nextPutAll: ' := IdentitySet new].'; cr]. stream tab; nextPut: $^; nextPutAll: name. ^stream contents
addAccessor "Add an accessor method for receiver. If a conflict arises and user chooses to leave the existing method, ask the receiver to no longer generate accessors." (self addMethod: self accessorDefinition at: self accessorSelector) ifFalse: [ self maskClear: GeneratesAccessorMask]
addMethod: newSource at: selector "Add the method to the appropriate protocol. Answer whether succeeded." | class oldSource | class := objectType memberClass. (class includesSelector: selector) ifTrue: [ "don't redundantly redefine method" (oldSource := class sourceCodeAt: selector) = newSource ifTrue: [^true]. "decide if should redefine the method" (self shouldRedefineMethod: selector from: oldSource to: newSource) ifFalse: [^false]]. class compile: newSource classified: ( ('private*' match: selector) ifFalse: ['accessing'] ifTrue: ['private']). ^true
addMutator "Add a mutator method for receiver. If a conflict arises and user chooses to leave the existing method, ask the receiver to no longer generate mutators." (self addMethod: self mutatorDefinition at: self mutatorSelector) ifFalse: [ self maskClear: GeneratesMutatorMask]
flushAccessMethods "Flush generated access methods temporarily." self generatesAccessor ifTrue: [self flushAccessor]. self generatesMutator ifTrue: [self flushMutator].
flushAccessor "Flush generated accessor method." name isNil ifFalse: [ self removeMethod: self accessorDefinition at: self accessorSelector]
flushMutator "Flush generated mutator method." name isNil ifFalse: [ self removeMethod: self mutatorDefinition at: self mutatorSelector]
generateAccessMethods "Ask receiver to generate access methods." self generatesAccessor: true. self generatesMutator: true.
mutatorDefinition "Answer a string which is the definition of an mutator for receiver." | stream arg | self isChildrenPointer ifTrue: [^nil]. stream := (String new: 40) writeStream. arg := 'new' , name. arg at: 4 put: (arg at: 4) asUppercase. stream nextPutAll: self mutatorSelector; space; nextPutAll: arg; cr; tab; nextPutAll: '"Set the receiver''s '; nextPutAll: name; nextPutAll: ' to '; nextPutAll: arg; nextPutAll: '."'; cr; cr. self isParentPointer ifTrue: [ stream tab; nextPutAll: 'self update: '; store: name; nextPutAll: ' to: '; nextPutAll: arg; nextPutAll: ' asChild: '; store: inverse asSymbol] ifFalse: [self isMapped ifTrue: [ stream tab; nextPutAll: 'self update: '; store: name; nextPutAll: ' to: '; nextPutAll: arg] ifFalse: [ stream tab; nextPutAll: name; nextPutAll: ' := '; nextPutAll: arg]]. ^stream contents
regenerateAccessMethods "Regenerate accessor and mutator methods according to rules." self regenerateAccessor; regenerateMutator
regenerateAccessor "Regenerate accessor method according to rules." | supertype superAtt | (objectType isNil or: [name isNil]) ifTrue: [^self]. objectType memberClass == Array ifTrue: [^self]. "don't generate methods for subatts" supertype := objectType supertype. superAtt := (supertype == nil or: [supertype isLensStructureType not]) ifTrue: [nil] ifFalse: [supertype variableNamed: name ifNone: [nil]]. (self generatesAccessor and: [superAtt isNil or: [ superAtt isChildrenPointer not and: [self isChildrenPointer]]]) ifTrue: [self addAccessor].
regenerateMutator "Regenerate mutator method according to rules." | supertype superVar | (objectType isNil or: [name isNil]) ifTrue: [^self]. objectType memberClass == Array ifTrue: [^self]. "don't generate methods for subvars" supertype := objectType supertype. superVar := (supertype == nil or: [supertype isLensStructureType not]) ifTrue: [nil] ifFalse: [supertype variableNamed: name ifNone: [nil]]. (self generatesMutator and: [self isChildrenPointer not and: [superVar isNil or: [ superVar isMapped not and: [self isMapped]]]]) ifTrue: [self addMutator].
removeMethod: definition at: selector "Remove the method with the given selector if it exists. Skip removal if the method is inconsistent with definition." | class | objectType isNil ifTrue: [^self]. class := objectType memberClass. ((class includesSelector: selector) and: [ (class sourceCodeAt: selector) = definition]) ifTrue: [ class removeSelector: selector]
shouldRedefineMethod: selector from: oldSource to: newSource "Decide if should redefine method with selector and oldSource. Do so by looking for an outerscope caller who will resolve the issue, and if none, redefine it since the user probably does not know better." ^Signal noHandlerSignal handle: [:ex | ex parameter signal = self class inconsistentMethodSignal ifFalse:[ ex reject ]. ^true] do: [ "ask outerscope caller" self class inconsistentMethodSignal raiseRequest]
</methods> <methods> Lens.LensStructureVariable <category>data model generation</category>
accumulateIn: set "Add self and all reachable variables in set." set add: self. self isCompound ifTrue: [ fieldType variables do: [ :var | var accumulateIn: set ] ]
addOverlappingVariablePaths: path "add overlappingVariablePaths for this variable and its subvariables. Path if not nil is the path of how to get to the containing variable." | subPath | self overlapsOtherVariables ifFalse: [^self]. subPath := path isNil ifTrue: [Array with: self] ifFalse: [path copyWith: self instVarIndex]. self isCompound ifTrue: [fieldType variables do: [:var | var addOverlappingVariablePaths: subPath]]. overlappingVariablePaths notNil ifTrue: [self overlappingVariablePaths add: subPath]
beUnmappedOfType: aType "Unmap the variable keeping the given type" self flushAccessMethods. self isMapped: false. self column: nil. self valueType: aType. self generateAccessMethods
checkForContainedNonoverlappingNullables "recursively mark whether variable contains nonoverlapping nullable variables" | nonoverlaps | self isCompound ifFalse: [^self column isNotNil not and: [self overlapsOtherVariables not]]. nonoverlaps := false. fieldType variables do: [:var | nonoverlaps := nonoverlaps | var checkForContainedNonoverlappingNullables]. self hasNonoverlappedNullableVariables: nonoverlaps. ^nonoverlaps
checkForContainedOverlaps "recursively mark whether variable contains overlaps" | overlaps | self isCompound ifFalse: [^self overlapsOtherVariables]. overlaps := false. fieldType variables do: [:var | overlaps := overlaps | var checkForContainedOverlaps]. self overlapsOtherVariables: overlaps. ^overlaps
createColumnNamed: colName "Create a default column." | ldm newColumn mapping tmpFieldType | ldm := self dataModel. "use a temp field type, since will be set when var is mapped" tmpFieldType := valueType computeFieldType. mapping := ldm mappingForFieldType: tmpFieldType. newColumn := ldm databaseContext class tableColumnClass new. newColumn name: colName; dataType: mapping columnType; maxColumnConstraint: (mapping isLongType ifTrue: [nil] ifFalse: [tmpFieldType maxColumnConstraint]); isNotNil: self isNotNil. ^newColumn
resetFieldType "Reset the field type, typically in response to a change in the objectType, valueType, or isMapped state." fieldType := nil. self setFieldType.
resetFieldTypeMax "The max of a fieldtype is not automatically set from the valueType, but is derived from the column the var is mapped to" ((fieldType notNil and: [objectType notNil]) and: [self isMapped]) ifTrue: [column notNil ifTrue: [fieldType := fieldType copy maxColumnConstraint: column maxColumnConstraint]]
setFieldType "Set the field type if necessary. Does the best it can given its state of initialization." (fieldType isNil and: [objectType notNil]) ifTrue: [ (self isMapped or: [valueType memberClass == Array]) ifTrue: [ valueType notNil ifTrue: [ (valueType isKindOf: LensReferenceType) ifTrue: [ fieldType := self dataModel typeOf: Integer] ifFalse: [ fieldType := valueType computeFieldType. fieldType isLensStructureType ifFalse: [ column notNil ifTrue: [ fieldType := fieldType copy maxColumnConstraint: column maxColumnConstraint ] ]. (valueType isSerialNumber or: [valueType isRowVersion]) ifTrue: [ fieldType := self dataModel typeNamed: #Integer ] ] ] ] ifFalse: [ fieldType := self dataModel typeOf: Object ] ]. ^fieldType
</methods> <methods> Lens.LensStructureVariable <category>testing</category>
checkAlways "Answer whether the underlying column value represented by the receiver should be verified as to have not been modified when we are posting a change." ^flags anyMask: CheckAlwaysMask
checkIfModified "Answer whether the underlying column value represented by the receiver should be verified as to have not been modified when the receiver has been modified and we are posting a change." ^flags anyMask: CheckIfModifiedMask
generatesAccessor "Answer whether receiver generates an accessor method." ^flags anyMask: GeneratesAccessorMask
generatesMutator "Answer whether receiver generates a mutator method." ^flags anyMask: GeneratesMutatorMask
hasLongType "Answer whether variable is mapped to a column whose datatype is considered long by the database." self isMapped ifTrue: [ | mapping | mapping := self dataModel mappingForColumn: column. ^mapping notNil and: [mapping isLongType]] ifFalse: [^false]
hasNonoverlappedNullableVariables "Return whether this variable or one of its subvariables is nullable and is not mapped to the same column as some other variable." ^flags anyMask: HasNonoverlappedNullableVariablesMask
isCanonicalVariable "Return whether I am either a non overlapped field or if overlapped am the designated canonical variable for the column that I am mapped to." ^flags anyMask: IsCanonicalVariableMask
isChildrenPointer "Answer whether receiver is a parent-to-child pointer in a virtual many-one relation." ^self isMapped not and: [valueType isSymbol not and: [valueType isLensCollectionType]]
isCompound "Answer whether the variable's fieldType is compound, ie. has multiple variables." ^fieldType notNil and: [fieldType isLensStructureType]
isDeclared "Answer whether receiver has been declared to have a specific valueType." ^valueType memberClass ~~ Object
isId "Answer whether receiver describes a variable that is (part of) an externalId." ^flags anyMask: IsIdMask
isMapped "Answer whether receiver describes a variable that is mapped to one or more fields." ^flags anyMask: IsMappedMask
isNotNil "Answer whether the receiver's valueType doesn't include nil." ^column == nil ifTrue: [ flags anyMask: IsNotNilMask ] ifFalse: [ column isNotNil ]
isNotNil: aBoolean "Answer whether the receiver's valueType doesn't include nil." aBoolean ifTrue: [ self maskSet: IsNotNilMask ] ifFalse: [ self maskClear: IsNotNilMask ]
isPacked "Answer whether the variable's fieldType is packed." ^self isReference not and: [self isCompound]
isParentPointer "Answer whether receiver is a parent pointer." ^inverse notNil and: [valueType isLensCollectionType not]
isPersistenceDependent "Answer whether receiver describes a variable that references an object on which the referencing object depends for its persistence. For now, persistence-dependence is completely defined by whether the variable is part of the referencing object's external ID." ^self isId
isReference "Answer whether the object variable is a reference to a mapped type." ^valueType isSymbol not and: [valueType isMapped]
isReferenceTo: aType withVariables: varList "Answer whether the object variable is a reference to aType with variables varList." | varStream | self valueType == aType ifFalse: [^false]. varStream := ReadStream on: varList. self forLeavesDo: [:leafVar | | leafColumn | ((leafColumn := leafVar column) notNil and: [leafColumn name = varStream next column name]) ifFalse: [^false]]. ^true
isSystemGenerated "Answer whether receiver holds system-generated values." ^objectType notNil and: [self == objectType idVariable and: [objectType isUserKeyed not]]
needsUpdate: updatedInstVarsMask "Return true if this column mapped to this variable is not being generated through some other variable mapped to the same column given the set of instVars being updated. If updatedInstVarsMask is nil then this is for an add and the column should be generated if this is the canonical variable for that variable." self overlapsOtherVariables ifFalse: [^true]. updatedInstVarsMask isNil ifTrue: [^self isCanonicalVariable]. overlappingVariablePaths do: [:path | path first == self ifTrue: [^true]. (updatedInstVarsMask bitAnd: (1 bitShift: path first instVarIndex - 1)) > 0 ifTrue: [^false]]
overlapsOtherVariables "Return whether this variable or one of its subvariables is mapped to the same column as some other variable." ^flags anyMask: OverlapsOtherVariablesMask
</methods> <methods> Lens.LensStructureVariable <category>iteration</category>
forLeavesDo: block "Evaluate block on each leaf variable reachable from the receiver." self isCompound ifTrue: [ fieldType variables do: [ :subvar | subvar forLeavesDo: block ]] ifFalse: [ block value: self ]
</methods> <methods> Lens.LensStructureVariable <category>initialize-release</category>
initialize flags := 0. "Warning: the following defaults cannot be changed without also changing the encoding logic for pickling the data model in which this variable might be represented." self checkAlways: false. self checkIfModified: false. self isId: false. self isNotNil: false
</methods> <methods> Lens.LensStructureVariable <category>relationships</category>
mappedRel (self isMapped and: [self isCompound not]) ifTrue: [^IdentitySet with: column] ifFalse: [^IdentitySet new]
referencesRel (self isReference) ifTrue: [^IdentitySet with: valueType] ifFalse: [^IdentitySet new]
relatedBy: token (#(#mappedRel #relatedRel referencesRel) includes: token) ifTrue: [^self perform: token] ifFalse: [^super relatedBy: token]
relatedRel self isCompound ifTrue: [^fieldType variables asSet]. ^IdentitySet new
sortKey "Returns a 3 digit string appropriately padded with 0's. This will work fine for types with up to 999 variables" | i str | i := self instVarIndex. str := WriteStream on: (String new: 3). i < 100 ifTrue: [str nextPut: $0. i < 10 ifTrue: [str nextPut: $0]]. str nextPutAll: i printString. ^str contents
stringKey: hints | n | n := WriteStream on: (String new: 16). self isId ifTrue: [n nextPutAll: '= ']. n nextPutAll: name. ^n contents
</methods> <methods> Lens.LensStructureVariable <category>runtime support</category>
checkShallowIncludes: value "Complain if object isn't a member of the receiver's type. In general we use the valueType to check whether the given value is acceptable for this variable, but the valueType does not contain information about the expected length of the data. For the types that the length information is important we use the fieldType. These cases are: The valueType is a simple dataType and it's member class is the same as the member class of the fieldType and it is a variableSize tpe and it is not encoded" (value == nil and: [self isNotNil]) ifTrue: [valueType isSerialNumber ifFalse: [LensType typeViolationSignal raiseErrorString: (#mustNotBeNil << #lens >> 'Must not be nil')]]. (value isAnything or: [value isProxy]) ifTrue: [^self]. (fieldType notNil and: [valueType isLensDataType and: [fieldType memberClass = valueType memberClass and: [valueType isVariableSize and: [valueType isLensEncodedType not]]]]) ifTrue: [fieldType checkShallowIncludes: value] ifFalse: [valueType checkShallowIncludes: value]
encodeOverlappingVariableOf: value within: object in: session withUpdateMask: updatedInstVarsMask "Return an Object if the column represented by this variable has already been generated through a different variable. Otherwise check to make sure that all variables that map to the same column as this variable are consistent and return the encoded value for this column. If object isNil then we are processing value from a template. Either return value or (Object new) as a place holder" | result resultDetermined | object isNil ifTrue: [^(self needsUpdate: updatedInstVarsMask) ifTrue: [value] ifFalse: [Object new]]. (self needsUpdate: updatedInstVarsMask) ifFalse: [^nil]. result := nil. resultDetermined := false. overlappingVariablePaths do: [:path | | val containingVar | containingVar := path first. val := containingVar encode: (object instVarAt: containingVar instVarIndex) in: session. 2 to: path size do: [:i | val notNil ifTrue: [val := val instVarAt: (path at: i)]]. (val == nil and: [containingVar hasNonoverlappedNullableVariables]) ifFalse: [resultDetermined ifTrue: [val = result ifFalse: [session class overlappingVariablesValueConflictSignal raise]] ifFalse: [result := val. resultDetermined := true]]]. ^result
fieldTemplate "Answer an object to be used as a database field template." ^self fieldTemplateForUpdate: false withUpdateMask: nil.
fieldTemplateForUpdate: forUpdate withUpdateMask: updatedInstVarsMask "Answer an object to be used as a database field template." ^self isMapped ifTrue: [| result | result := fieldType recordTemplate. (forUpdate and: [self overlapsOtherVariables]) ifTrue: [self isCompound ifTrue: [result := self handleOverlappingSubvariablesOf: result within: nil in: nil withUpdateMask: updatedInstVarsMask] ifFalse: [result := self encodeOverlappingVariableOf: result within: nil in: nil withUpdateMask: updatedInstVarsMask]]. result] ifFalse: [Object basicNew]
getValueOf: object "Answer the value of the variable of object described by receiver." ^object perform: self accessorSelector
handleOverlappingSubvariablesOf: value within: object in: session withUpdateMask: updatedInstVarsMask "Replace overlapping subvariables of this compound variable with properly encoded versions. If object isNil then we are processing a template." | vars result | vars := fieldType variables. result := value isNil ifTrue: [Array new: vars size] ifFalse: [value shallowCopy]. 1 to: vars size do: [:i | | var | var := vars at: i. var overlapsOtherVariables ifTrue: [var isCompound ifTrue: [result instVarAt: i put: (var handleOverlappingSubvariablesOf: (value instVarAt: i) within: object in: session withUpdateMask: updatedInstVarsMask)] ifFalse: [result instVarAt: i put: (var encodeOverlappingVariableOf: (result instVarAt: i) within: object in: session withUpdateMask: updatedInstVarsMask)]]]. ^result
setValueOf: object to: newValue "Set the value of the variable of object described by receiver to newValue." ^object perform: self mutatorSelector with: newValue
</methods> <methods> Lens.LensStructureVariable <category>printing</category>
displayString | strm | strm := (String new: 128) writeStream. self printNameOn: strm. ^strm contents
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
printStringWithId "Answer a print string including indication if the receiver is an id variable." ^self isId ifTrue: [name, ' (ID)'] ifFalse: [name]
referencePrintString "Answer a print string for the receiver viewed as a reference." | stream | stream := (String new: 128) writeStream. stream print: objectType; nextPut: $.; nextPutAll: self printStringWithId; nextPutAll: ' -> '; print: valueType. ^stream contents
</methods> <methods> Lens.LensStructureVariable <category>copying</category>
cloneStructure | clone | clone := self copy. clone setFieldType. clone fieldType: clone fieldType cloneStructure. ^clone
postCopy self maskClear: GeneratesAccessorMask; maskClear: GeneratesMutatorMask
</methods> <methods> Lens.LensStructureVariable class <category>private</category>
encodedAspects ^#(#name #(#valueType #setValueType:) #fieldType #column #inverse #(#pickledCheckAlways #checkAlways:) #(#pickledCheckIfModified #checkIfModified:) #generatesAccessor #generatesMutator #(#pickledIsId #isId:) #(#isMapped #privateIsMapped:) #(pickledIsNotNil #isNotNil:) )
valueEncoder ^[:value | (value isKindOf: LensType) ifTrue: [value referenceEncoding] ifFalse: [value literalArrayEncoding]]
</methods> <methods> Lens.LensStructureVariable class <category>instance creation</category>
name: varName valueType: type objectType: objectType "Answer a new variable with the given name and value type." ^self new name: varName; objectType: objectType; valueType: type
new ^super new initialize
</methods> <methods> Lens.LensStructureVariable class <category>signal constants</category>
inconsistentMethodSignal "Answer the signal indicating that an access method is about to be generated that is inconsistent with an existing method." ^InconsistentMethod
</methods> <methods> Lens.LensStructureVariable class <category>class initialization</category>
initialize "LensStructureVariable initialize" IndexMask := 255. CheckAlwaysMask := IndexMask + 1. CheckIfModifiedMask := CheckAlwaysMask * 2. IsNotNilMask := CheckIfModifiedMask * 2. IsIdMask := IsNotNilMask * 2. IsMappedMask := IsIdMask * 2. GeneratesAccessorMask := IsMappedMask * 2. GeneratesMutatorMask := GeneratesAccessorMask * 2. OverlapsOtherVariablesMask := GeneratesMutatorMask * 2. IsCanonicalVariableMask := OverlapsOtherVariablesMask * 2. HasNonoverlappedNullableVariablesMask := IsCanonicalVariableMask * 2. IsClassDescriptorMask := HasNonoverlappedNullableVariablesMask * 2. InconsistentMethod notifierString: (#inconsistentAccessMethod << #lens >> 'Inconsistent access method'); nameClass: self message: #inconsistentMethodSignal.
</methods> <methods> Lens.LensDataType <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. max := max decodeAsLiteralArray
</methods> <methods> Lens.LensDataType <category>printing</category>
displayString | strm | strm := (String new: 128) writeStream. name notNil ifTrue: [strm nextPutAll: name] ifFalse: [memberClass printOn: strm]. self maxColumnConstraint == nil ifFalse: [strm nextPut: $(. self maxColumnConstraint printOn: strm. strm nextPut: $)]. ^strm contents
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. name notNil ifTrue: [stream nextPutAll: name] ifFalse: [stream nextPutAll: (#class << #lensRuntime >> 'class: ') asString. memberClass printOn: stream]. self maxColumnConstraint == nil ifFalse: [self print: self maxColumnConstraint named: (#MaxColumnConstraint << #lensRuntime >> ' maxColumnConstraint: ') asString on: stream]. stream nextPut: $)
</methods> <methods> Lens.LensDataType <category>accessing</category>
maxColumnConstraint "Answer the receiver's maxColumnConstraint." max == 0 ifTrue: [max := nil]. ^max
maxColumnConstraint: newMax "Set receiver's maxColumnConstraint to newMax." max := newMax
</methods> <methods> Lens.LensDataType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent." self == type ifTrue: [^true]. ^(super isEquivalentTo: type) and: [self maxColumnConstraint = type maxColumnConstraint]
</methods> <methods> Lens.LensDataType <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^self maxColumnConstraint notNil ifTrue: [ ByteFieldDescriptor new template: memberClass recordTemplate max: self maxColumnConstraint] ifFalse: [memberClass recordTemplate]
</methods> <methods> Lens.LensDataType <category>type checking</category>
checkIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifTrue: [^self]. memberClass checkShallowIncludes: object. (memberClass checkLensSizeOf: object max: self maxColumnConstraint) ifFalse: [ | objString | objString := (object isString) ifTrue: [object contractTo: (UISettings preferenceFor: #toolsLabelStringLimit)] ifFalse: [object]. LensType typeViolationSignal raiseWith: (Array with: objString with: self) errorPattern: (#tooLargeFor << #lens >> '<1p><n>is too large for <2p>') ]
</methods> <methods> Lens.LensDataType class <category>private</category>
encodedAspects ^#(#maxColumnConstraint)
</methods> <methods> Lens.LensRowHolder <category>interests</category>
onChangeSend: aSymbol to: anObject for: aClient "Arrange to receive a message with aSymbol when the value aspect changes on anObject. Record the beneficiary of this connection." self clientMap at: (self expressInterestIn: #value for: anObject sendBack: aSymbol) put: aClient
</methods> <methods> Lens.LensRowHolder <category>constructing</category>
compute: aBlock for: aClient "Answer a BlockValue that computes aBlock with the receiver's value as the argument. aBlock will become a dependent of the receiver, and will be sent the message value: when the receiver is sent the message value:. Record that the arrangement is for the benefit of aClient." | result | self clientMap at: (result := BlockValue block: aBlock arguments: (Array with: self)) put: aClient. ^result
</methods> <methods> Lens.LensRowHolder <category>accessing</category>
clientMap ^clientMap isNil ifTrue: [clientMap := IdentityDictionary new. clientMap] ifFalse: [clientMap]
</methods> <methods> Lens.LensRowHolder <category>dependents access</category>
expressInterestIn: anAspect for: anObject sendBack: aSelector "Arrange to receive a message with aSelector when anAspect changes at anObject. Be sure to return the DependencyTransformer." | dt | dt := DependencyTransformer new. dt setReceiver: anObject aspect: anAspect selector: aSelector. self addDependent: dt. ^dt
removeDependentsFor: aClient | map | (map := self clientMap) keys do: [:dep | (map at: dep) == aClient ifTrue: [self removeDependent: dep. map removeKey: dep]]
</methods> <methods> Lens.EmbeddedDetailSpec <category>accessing</category>
autoFetch ^autoFetch == nil ifTrue: [true] ifFalse: [autoFetch]
autoFetch: aBoolean autoFetch := aBoolean
autoOpen ^false
contentKey ^contentKey
contentKey: aSymbol contentKey := aSymbol
fetchAction ^fetchAction
fetchAction: aSymbol fetchAction := aSymbol
lockPolicy ^lockPolicy isNil ifTrue: [#current] ifFalse: [lockPolicy]
lockPolicy: aSymbolOrNil lockPolicy := aSymbolOrNil
majorKeyFullName | cl | ^nameSpace isNil ifTrue: [majorKey] ifFalse: [(cl := (nameSpace at: majorKey asSymbol ifAbsent: [nil])) notNil ifTrue: [cl fullName] ifFalse: [majorKey]]
majorKeyReference | cl | ^(self nameSpace isNil or: [(cl := (self nameSpace at: (majorKey asSymbol) ifAbsent: [nil])) isNil]) ifTrue: [majorKey asQualifiedReference] ifFalse: [cl fullyQualifiedReference]
nameSpace ^nameSpace
nameSpace: aNameSpace nameSpace := aNameSpace
openAction ^nil
sourceType ^sourceType isNil ifTrue: [#query] ifFalse: [sourceType]
sourceType: aSymbol sourceType := aSymbol
synchronize ^synchronize isNil ifTrue: [true] ifFalse: [synchronize]
synchronize: aBoolean synchronize := aBoolean
</methods> <methods> Lens.EmbeddedDetailSpec <category>private</category>
componentSpecDo: anEnumerator ^anEnumerator doLeafEmbeddedDetail: self
dispatchTo: policy with: builder "Hook up an embedded detail to the right source." self sourceType ~~ #query ifTrue: [self contentKey notNil ifTrue: [builder aspectAt: self contentKey]]. ^super dispatchTo: policy with: builder
literalArrayEncoding nameSpace == nil ifFalse: [nameSpace := nameSpace fullName asQualifiedReference]. ^super literalArrayEncoding
value ^self
</methods> <methods> Lens.EmbeddedDetailSpec class <category>private</category>
decodeFromLiteralArray: anArray | temp | temp := super decodeFromLiteralArray: anArray. temp nameSpace isNil ifFalse: [temp nameSpace: temp nameSpace value.]. ^temp
</methods> <methods> Lens.DatabaseCommand <category>adding</category>
addBinding: value "Add an element to bindObject." bindObject == nil ifTrue: [bindObject := OrderedCollection with: value] ifFalse: [bindObject add: value]
addTemplate: value "Add an element to bindTemplate." bindTemplate == nil ifTrue: [bindTemplate := OrderedCollection with: value] ifFalse: [bindTemplate add: value]
copyBindingsToTemplate "Copy bindings to template so as to make them the same length." bindObject == nil ifTrue: [^self]. bindTemplate == nil ifTrue: [ bindTemplate := bindObject] ifFalse: [ bindTemplate size + 1 to: bindObject size do: [:i | bindTemplate addLast: (bindObject at: i)]]
</methods> <methods> Lens.DatabaseCommand <category>accessing</category>
bindObject "Answer the bindObject, converting orderedCollections into arrays." ^bindObject
bindObject: object "Set the bindObject." bindObject := object
bindTemplate "Answer the template used to define bind variables in queryString." ^bindTemplate
bindTemplate: newTemplate "Set the template used to define bind variables in queryString." bindTemplate := newTemplate
body "Answer the command body." ^body
body: newBody "Set the command string." body := newBody
commandProcedure: procedureName "Set the body to the procedure name, and set for RPC." body := procedureName. isRPC := true.
commandString: newBody "Set the body to a query string." body := newBody.
decoder "Answer the value decoder." ^decoder
decoder: newDecoder "Set the value decoder." decoder := newDecoder
isRPC: flag isRPC := flag
queryProcedure: procedureName "Set the body to the procedure name, and set for RPC." body := procedureName. isRPC := true. isQuery := true.
queryString: newBody "Set the body to a query string." body := newBody. isQuery := true.
resultTemplate "Answer the receiver's result template." ^resultTemplate
resultTemplate: newTemplate "Set the receiver's result template." resultTemplate := newTemplate
</methods> <methods> Lens.DatabaseCommand <category>copying</category>
postCopy "Do post-copy stuff." bindObject := bindObject shallowCopy. bindTemplate := bindTemplate shallowCopy.
</methods> <methods> Lens.DatabaseCommand <category>testing</category>
isQuery "Answer whether the command is a query." ^isQuery
isRPC "Answer whether receiver represents a remote procedure call." ^isRPC
</methods> <methods> Lens.DatabaseCommand <category>initialization</category>
initialize isRPC := false. isQuery := false. body := nil. decoder := nil.
</methods> <methods> Lens.DatabaseCommand class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LinkedDetailSpec <category>accessing</category>
autoFetch ^autoFetch == nil ifTrue: [true] ifFalse: [autoFetch]
autoFetch: aBoolean autoFetch := aBoolean
autoOpen ^autoOpen == nil ifTrue: [false] ifFalse: [autoOpen]
autoOpen: aBoolean autoOpen := aBoolean
clientKey ^clientKey
clientKey: aSymbol clientKey := aSymbol
contentKey ^contentKey
contentKey: aSymbol contentKey := aSymbol
fetchAction ^fetchAction
fetchAction: aValue fetchAction := aValue
lockPolicy ^lockPolicy isNil ifTrue: [#current] ifFalse: [lockPolicy]
lockPolicy: aSymbolOrNil lockPolicy := aSymbolOrNil
majorKey ^majorKey
majorKey: aSymbol majorKey := aSymbol
majorKeyFullName | cl | ^nameSpace isNil ifTrue: [majorKey] ifFalse: [(cl := (nameSpace at: majorKey ifAbsent: [nil])) notNil ifTrue: [cl fullName] ifFalse: [majorKey]]
majorKeyReference | cl | ^(self nameSpace isNil or: [(cl := (self nameSpace at: (majorKey asSymbol) ifAbsent: [nil])) isNil]) ifTrue: [majorKey asQualifiedReference] ifFalse: [cl fullyQualifiedReference]
minorKey ^minorKey
minorKey: aSymbol minorKey := aSymbol
model "Useful for browsing" ^self clientKey
modelInBuilder: builder self openAction == nil ifTrue: [^self typeConvert: self defaultModel]. ^self openAction isSymbol ifTrue: [self typeConvert: (self getBindingIn: builder)] ifFalse: [self typeConvert: self openAction]
nameSpace ^nameSpace
nameSpace: aNameSpace nameSpace := aNameSpace
openAction ^openAction
openAction: aValue openAction := aValue
sourceType ^sourceType isNil ifTrue: [#query] ifFalse: [sourceType]
sourceType: aSymbol sourceType := aSymbol
synchronize ^synchronize isNil ifTrue: [true] ifFalse: [synchronize]
synchronize: aBoolean synchronize := aBoolean
</methods> <methods> Lens.LinkedDetailSpec <category>private</category>
componentSpecDo: anEnumerator ^anEnumerator doLeafLinkedDetail: self
dispatchTo: policy with: builder "Hook up an embedded detail to the right source." self sourceType ~~ #query ifTrue: [self contentKey notNil ifTrue: [builder aspectAt: self contentKey]]. ^super dispatchTo: policy with: builder
getBindingIn: builder | m | m := builder actionAt: self openAction. m == nil ifFalse: [^m]. builder isEditing ifFalse: [^builder raiseErrorMessage: (#bindingNotFound << #lens >> 'binding: <1p> not found!') with: self openAction]. m := self defaultModel. builder cacheWhileEditing ifTrue: [builder actionAt: self openAction put: m]. ^m
literalArrayEncoding nameSpace == nil ifFalse: [nameSpace := nameSpace fullName asQualifiedReference]. ^super literalArrayEncoding
value ^self
</methods> <methods> Lens.LinkedDetailSpec class <category>private</category>
decodeFromLiteralArray: anArray | temp | temp := super decodeFromLiteralArray: anArray. temp nameSpace isNil ifFalse: [temp nameSpace: temp nameSpace value.]. ^temp
</methods> <methods> Lens.LensVariableSurrogate <category>testing</category>
IsExternalId "Answer whether receiver's variable is an externalId var." ^source Type isMapped and: [variable == source Type idVariable]
IsVariableSurrogate "Answer whether receiver is a variable surrogate." ^true
</methods> <methods> Lens.LensVariableSurrogate <category>accessing</category>
Attribute "Answer the receiver's variable." ^variable
Container "Answer the receiver's container, if any." ^source Container
Destination "Answer the object surrogate representing the receiver's attribute's value." destination == nil ifTrue: [ destination := LensObjectSurrogate new type: type lensContainer: (source Container lensSession containerOf: type)]. ^destination
PathSource "Answer the object surrogate from which the query path originates." "if there is no predecessor, or the variable isn't part of a compound reference, answer the source, else ask the predecessor to answer its path source" ^(predecessor == nil or: [ source Type isMapped and: [ variable objectType memberClass ~= Array]]) ifTrue: [source] ifFalse: [predecessor PathSource]
Predecessor "Answer the receiver's predecessor in a navigational path." ^predecessor
Predecessor: newPredecessor "Set the receiver's predecessor in a navigational path." predecessor := newPredecessor
Source "Answer the receiver's source object surrogate." ^source
</methods> <methods> Lens.LensVariableSurrogate <category>symbolic evaluation</category>
AccumulateAttributesIn: variableSet "Accumulate all accessed variables into variableSet." variableSet add: variable.
externalId "Answer a surrogate representing the receiver's external id." | var variableSurrogate | variable isReference ifFalse: [ self error: (#errVariablesHaveNoExternalID << #lens >> 'data-valued variables have no externalIds') ]. "Create a pseudo-variable which references the column(s) of receiver's table rather than following the reference." var := variable copy. var fieldType isLensStructureType ifTrue: [ var setValueType: variable fieldType copy. var valueType table: nil ] ifFalse: [ var setValueType: variable fieldType ]. variableSurrogate := LensVariableSurrogate new source: source via: var. variableSurrogate Predecessor: predecessor. ^variableSurrogate
navigateThrough: nextAttribute "Symbolically evaluate a navigation step, via reference to nextAttribute, answering the resulting attributeSurrogate." ^(self Destination navigateThrough: nextAttribute) Predecessor: self
nextVariableNamed: selector "Answer the next variable in the current path whose name is selector." ^(variable isCompound and: [variable isReference not]) ifTrue: [variable fieldType variableNamed: selector ifNone: [nil]] ifFalse: [type variableNamed: selector ifNone: [nil]].
</methods> <methods> Lens.LensVariableSurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printTypeOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensVariableSurrogate <category>operation graph processing</category>
JoinCondition "Answer a condition the effectuates a join." ^self = self Destination
</methods> <methods> Lens.LensVariableSurrogate <category>private</category>
printTypeOn: stream (predecessor == nil ifTrue: [source] ifFalse: [predecessor]) printTypeOn: stream. stream nextPut: $.. variable printNameOn: stream
</methods> <methods> Lens.LensVariableSurrogate <category>initialize-release</category>
source: surrogate via: att "Initialize receiver's state." source := surrogate. variable := att. type := variable isPacked ifTrue: [variable fieldType] ifFalse: [variable valueType]. isAscending := true.
</methods> <methods> Lens.LensVariableSurrogate <category>comparing</category>
= value "Symbolically evaluate an equality comparison." (variable isReference and: [value IsQS]) ifTrue: [ destination := value Destination]. ^super = value
in: collection "Answer a surrogate for inquiring if receiver is an element of collection." | operation coll lensSession | variable isCompound ifTrue: [ LensContainer queryErrorSignal raiseWith: (Array with: type with: variable) errorPattern: (#packedOrCompoundNotAllowed << #lens >> 'in: on <1p>.<2p> is packed or compound user-key reference not allowed')]. coll := collection. lensSession := nil. (collection IsQS and: [collection IsContainerSurrogate]) ifFalse: [ coll class == QueryOperationAccessor ifTrue: [ | cont surrogate | cont := coll lensContainer. surrogate := LensObjectSurrogate new type: cont type lensContainer: cont. coll := LensSubquerySurrogate new type: cont type objectSurrogate: surrogate. coll select: collection operation selectBlock answer: [:x | x externalId]] ifFalse: [ coll := coll collect: [:value | type checkIncludes: value. (variable isReference and: [value isPersistent not]) ifTrue: [ LensContainer objectNotPersistentSignal raiseWith: (Array with: value)]. lensSession isNil ifTrue: [lensSession := value lensSession]. "get lensSession from first element" variable encode: value in: lensSession]]]. operation := LensOperationSurrogate new left: self operator: #in: right: coll. operation Type: BooleanType. ^operation
</methods> <methods> Lens.LensMethodGenerator <category>accessing</category>
body "Answer the method body, resetting to generate a new method." | temp | temp := body. self reset. ^temp
statements "Answer the number of statements in the current body." ^body size
targetClass "Answer the target class, whose methods are being generated by receiver." ^targetClass
targetClass: newClass "Set the target class, whose methods are being generated by receiver." targetClass := newClass
temps "Answer the set of temporaries for the method." ^temps
tracing: flag "Set whether to trace method generation to Transcript." tracing := flag
</methods> <methods> Lens.LensMethodGenerator <category>statement generation</category>
addFirstStatement: aStatement "Prefix a statement node in the receiver's body." body addFirst: aStatement
addStatement: aStatement "Accumulate a statement node in the receiver's body." body add: aStatement
statement "Answer the current statement." ^statement
thenSend: selector "Cascade another message on the current statement." statement := self to: statement send: selector.
thenSend: selector withArg: argument "Cascade another message on the current statement." statement := self newMessageReceiver: statement selector: selector argument: argument
to: receiver send: selector "Answer a new message send." ^self newMessageReceiver: receiver selector: selector.
to: receiver send: selector withArg: argument "Answer a new message send." ^self newMessageReceiver: receiver selector: selector argument: argument
to: receiver send: selector withArgs: arguments "Answer a new message send." ^self newMessageReceiver: receiver selector: selector arguments: arguments
to: receiver sendCascaded: selector "Initialize current statement to a new message send." statement := self to: receiver send: selector.
</methods> <methods> Lens.LensMethodGenerator <category>node creation-basic</category>
assign: variable value: value "Answer a node assigning value to variable." ^self newAssignmentVariable: variable value: value
forSelf "When generating encoder/decoder blocks, the 'receiver' is not the receiver of the method that creates the decoder block, but is instead the first argument of the decoder or encoder block. By convention, this argument is named 'SELF'." ^self newVariableName: 'SELF'
literal: value "Answer a new literal node with value." ^self newLiteralValue: value
newTemp: name "Create and answer a new temp with the given name." | newTemp | temps add: (newTemp := self newVariableName: name). ^newTemp
return: value "Answer a return with value." ^self newReturnValue: value
temp: name "Answer the temp named name." ^temps detect: [:temp | temp name = name] ifNone: [nil]
variable: name "Answer a new node for variable." ^self newVariableName: name
</methods> <methods> Lens.LensMethodGenerator <category>initialize-release</category>
fork "Create a copy of the receiver, typically for processing an embedded block." ^self shallowCopy reset
initialize self reset. tracing := false.
reset "Prepare the receiver to generate a new method." temps := OrderedCollection new. body := OrderedCollection new.
</methods> <methods> Lens.LensMethodGenerator <category>method manipulation</category>
generateBlockWithArgs: args temps: temporaries "Answer a blockClosure with the indicated args and temps." | methodNode compiledMethod blockBody | blockBody := self newBlockArguments: args body: (self newSequenceTemporaries: temporaries statements: self body). methodNode := self newMethodSelector: #TEMP primitive: nil block: (self newBlockBody: (self newReturnValue: blockBody)). tracing ifTrue: [ Transcript cr; show: methodNode printString. tracing := false]. compiledMethod := LensCompiler new compile: methodNode in: targetClass. ^LensTranscoder with: (targetClass basicNew performMethod: compiledMethod arguments: #())
newMethodSelector: selector comment: comment arguments: args temporaries: temporaries statements: stats "Install a generated method with the given selector, args, temporaries, and comment, and whose body is the receivers." ^(self newMethodSelector: selector arguments: args temporaries: temporaries statements: stats) comment: (Array with: comment)
</methods> <methods> Lens.LensMethodGenerator class <category>instance creation</category>
new ^super new initialize
newFor: targetClass "Answer a new method generator on targetClass." ^(super new initialize) targetClass: targetClass
</methods> <methods> Lens.LensCompiler <category>private</category>
scopeForMethod: methodNode | cache key scope ns | ns := methodNode environment == nil ifTrue: [self environment] ifFalse: [methodNode environment]. cache := CachedScope. key := cache at: 1. ((key at: 1) == class and: [(key at: 2) == ns]) ifTrue: [^cache at: 2]. scope := NameScope forClass: class outerScope: (NameScope global: ns) localScope: LensScope new. CachedScope := Array with: (WeakArray with: class with: ns) with: scope. ^scope
</methods> <methods> Lens.LensCompiler class <category>initialize</category>
clearCaches "LensCompiler clearCaches" CachedScope := #(#(nil nil) nil)
initialize "LensCompiler initialize" self clearCaches
</methods> <methods> Lens.LensEnumerationType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent." self == type ifTrue: [^true]. ^(super isEquivalentTo: type) and: [ members = type members]
</methods> <methods> Lens.LensEnumerationType <category>accessing</category>
computeFieldType "Answer a field type for an attribute whose value type is the receiver." ^elementType computeFieldType
decodeSelector "Answer the receiver's decodeSelector." ^elementType decodeSelector
elementType "Answer the type of all the receiver's members." ^elementType
elementType: newType "Set the type of all the receiver's members." elementType := newType
encodeSelector "Answer the receiver's encodeSelector." ^elementType encodeSelector
memberClass "Answer the memberClass." ^elementType memberClass
members "Answer the receiver's members." ^members
members: collection "Assign aCollection as the members of receiver, checking that collection is homogeneous." members := collection.
</methods> <methods> Lens.LensEnumerationType <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. name notNil ifTrue: [self printNameOn: stream] ifFalse: [members storeOn: stream]. stream nextPut: $)
</methods> <methods> Lens.LensEnumerationType <category>testing</category>
checkIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." ((members includes: object) or: [object == nil]) ifFalse: [ self signalTypeViolation: object]
isLensEnumerationType "Answer whether receiver is an enumeration type, i.e. its members are in a fixed collection." ^true
</methods> <methods> Lens.LensEnumerationType <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^elementType recordTemplate
</methods> <methods> Lens.LensEnumerationType <category>to/from specification</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. elementType := elementType decodeAsLiteralArray. members := members collect: [:member | member decodeAsLiteralArray].
</methods> <methods> Lens.LensEnumerationType <category>initialize-release</category>
initialize members := Array new. name := (#unnamed1 << #lensRuntime >> '<unnamed>') asString
</methods> <methods> Lens.LensEnumerationType class <category>private</category>
encodedAspects ^#(#elementType #members)
</methods> <methods> Lens.LensEnumerationType class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensDatabaseIndex <category>printing</category>
displayString | strm | strm := String new writeStream. strm nextPutAll: name. ^strm contents
printOn: stream super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensDatabaseIndex <category>accessing</category>
indexedVariables "Answer the receiver's indexedVariables." ^indexedVariables
name "Answer the receiver's name." ^name
</methods> <methods> Lens.LensDatabaseIndex <category>testing</category>
isPrimary "Answer whether receiver represents a primary index (the index on the primary key) in database." ^self subclassResponsibility
isUnique "Answer whether receiver represents a unique index in database." ^self subclassResponsibility
</methods> <methods> Lens.LensDatabaseIndex <category>accessing-private</category>
indexedVariables: newIndexedVariables "Set the receiver's indexedVariables to newIndexedVariables." indexedVariables := newIndexedVariables
name: newName "Set the receiver's name to newName." name := newName
</methods> <methods> Lens.LensDatabaseIndex class <category>private</category>
encodedAspects "Default encoded aspects to all instvars." ^#(#name #indexedVariables)
valueEncoder ^[ :value | (value isKindOf: Array) ifTrue: [ value collect: [ :var | var name] ] ifFalse: [ value literalArrayEncoding ] ]
</methods> <methods> Lens.LensReferenceType <category>printing</category>
displayString ^self referencedClassName asString
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self referencedClassName printOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensReferenceType <category>testing</category>
isLensCollectionType "Answer whether receiver is a collection type." ^false
isLensDataType "Answer whether receiver is a datatype, i.e. its members are to be treated as manifest values." ^true
isLensStructureType "Answer whether receiver is a structure." ^false
isLensType "Answer whether the receiver behaves as a type." ^true
isMapped "Answer whether receiver is mapped to a database." ^false
isSerialNumber "Answer whether receiver represents serial numbers." ^false
</methods> <methods> Lens.LensReferenceType <category>to/from specification</category>
literalArrayEncoding ^self referencedClassName
</methods> <methods> Lens.LensReferenceType <category>accessing</category>
memberClass "Answer the receiver's memberClass." ^nil "LensReferenceType instances don't have memberClasses."
name "Answer the receiver's name." ^referencedClassName
referencedClassName "Answer the name of the referenced class." ^referencedClassName
referencedClassName: aSymbol "Set the name of the referenced class." referencedClassName := aSymbol
</methods> <methods> Lens.LensReferenceType <category>private</category>
decodeSelector "Answer the receiver's decodeSelector." ^nil
encodeSelector "Answer the receiver's encodeSelector." ^nil
</methods> <methods> Lens.LensReferenceType class <category>private</category>
encodedAspects ^#(#referencedClassName)
</methods> <methods> Lens.LensBaseContainer <category>private</category>
checkForReferencesToId: externalId "Make sure there are no mapped rows that reference the object with this id. If there are any an exception will be raised" type referencingMappedVariables do: [ :var | (lensSession containers at: var objectType) transporter checkForReferencesOfVar: var toId: externalId].
commit "Cleanup during a session commit." cache do: [:gd | gd commit]
forGlobalDescriptors: descriptors do: actionBlock "For each global descriptor in descriptors, evaluate actionBlock on the object and its global descriptor, respectively." descriptors do: [:gd | | object | (object := gd object) == nil ifFalse: [ actionBlock value: object value: gd]]
objectOf: aType withId: id "Answer the object of aType with the given id." | container gd object | "Objects can't have a nil or nils for the externalId" id isNilExternalId ifTrue: [^nil]. "Look in aType's container to see if an entry with externalId of id exists" container := self lensSession containerOf: aType. gd := container privateCache at: id ifAbsent: []. "If there is no entry, or it refers to an object no longer in the image..." (gd isNil or: [(object := gd object) isNil]) ifTrue: [ "Make a new proxy." object := LensProxy externalId: id lensContainer: container. "Make a new LGD and register the proxy in the container." LensGlobalDescriptor new register: object externalId: id lensContainer: container]. ^object
printTypeOn: stream type printNameOn: stream
privateCache "Answer the receiver's cache." ^cache
refreshAllObjects "Refresh all objects in the receiver's cache from database." | childrenVars objectLens | childrenVars := type variables select: [ :var | var isChildrenPointer ]. objectLens := self lensSession. cache do: [:gd | | object | ((object := gd object) == nil or: [object isProxy or: [gd objectIsRemoved]]) ifFalse: [ transporter objectAtId: gd externalId. gd refresh: object. "replace children sets with new collection proxies to force refreshing when next accessed." childrenVars do: [ :var | object instVarAt: var instVarIndex put: (LensCollectionProxy query: var childrenSetQuery lensContainer: (objectLens containerOf: var targetValueType) parent: object)]]]
register: gd at: externalId "Register the gd under the externalId in the receiver's cache." cache == nil ifFalse: [ cache at: externalId put: gd]
register: record withId: id ifPresent: presentTranscoder ifAbsent: absentTranscoder "If no object exists under id, create a new gd and evaluate absentTranscoder with record. If a proxy exists under id, swap record and proxy and evaluate absentTranscoder with record. If an object exists under id - either return the object if the object has unposteded updates, or evaluate presentTranscoder with the object if the object is posted/clean." | gd o | "Look in receiver's cache to see if an entry with externalId of id exists" gd := cache at: id ifAbsent: []. "Is there an entry and does the object it describes still exist in the image..." ^(gd isNil or: [(o := gd object) isNil]) ifTrue: [ "not in cache, so register and return object" LensGlobalDescriptor new register: record externalId: id lensContainer: self. absentTranscoder applyTo: record lensContainer: self] ifFalse: [ "in cache, so swap and return record" gd lensContainer: self. "specialize to subcontainer" o isProxy ifTrue: [ o become: record. absentTranscoder applyTo: o lensContainer: self ] ifFalse: [gd lastCommitedVersion notNil ifTrue: [ o ] ifFalse: [ presentTranscoder applyTo: o with: record lensContainer: self ] ] ]
removeKey: externalId "Remove the item in the receiver's cache whose key is externalId." cache == nil ifFalse: [ cache removeKey: externalId ifAbsent: nil]
reregister: gd at: newExternalId "Reregister the gd under newExternalId." "Enforce-quietly: there is a cache" cache == nil ifTrue: [ ^self ]. "If gd is the value at its externalId, we need to remove it. Otherwise, it must be that the gd was removed and another object has been added (or updated to have this key value) and that cache entry will be handled elsewhere." (cache at: gd externalId ifAbsent: [nil]) == gd ifTrue: [ cache removeKey: gd externalId ]. "Put the gd into its proper place in the cache." cache at: newExternalId put: gd
resume "Reinitialize after LensSession has resumed." cache == nil ifTrue: [ cache := LensProtectedLinkedDictionary new. self transporter ]
revertAllChildrenSets "Revert children sets to force resynchronization." | childVars | childVars := type variables select: [:att | att isChildrenPointer]. childVars isEmpty ifTrue: [^self]. cache do: [:gd | | object | gd rollback. ((object := gd object) == 0 or: [object == nil or: [object isProxy]]) ifFalse: [ childVars do: [ :var | object instVarAt: var instVarIndex put: (LensCollectionProxy query: var childrenSetQuery lensContainer: (self lensSession containerOf: var targetValueType) parent: object)]]]
rollback "Cleanup during a session rollback. Revert any children sets to force resynchronization." "The cache copy is required as rollback may perturb the collection." cache copy do: [:gd | gd rollback]. self revertAllChildrenSets.
type: aType lensSession: aLensSession "Setup receiver to access members of aType in aLensSession." super type: aType lensSession: aLensSession. cache := LensProtectedLinkedDictionary new.
</methods> <methods> Lens.LensBaseContainer <category>data access services</category>
removeDataWhere: selectBlock "Remove all records satisfying selectBlock, without enforcing any referential integrity constraints." self lensSession checkChange. transporter removeDataWhere: selectBlock
resultTemplate "Answer the result template." ^transporter resultTemplate
selectFieldList "Answer a string containing the associated table's select fields in instVar order." ^transporter selectFieldList
</methods> <methods> Lens.LensBaseContainer <category>private-activation</category>
disconnect "Release the receiver's resources." super disconnect. cache := nil
</methods> <methods> Lens.LensBaseContainer <category>collection protocol</category>
add: object "Add object to the receiver, thereby making it persistent, answering object. Do nothing if object is already contained in receiver. Raise LensContainer>objectInAnotherContainerSignal if object is already contained in another lens session's container." "References to other transient objects are added leaf-first by recording receiver in the lensSession's cascadedAdds collection and then adding the referenced objects into their containers. The cascadedAdds collection is used to detect cycles in the reference graph." | gd id cascadedAdds brokenReferences | cascadedAdds := lensSession cascadedAdds. brokenReferences := nil. "Has receiver already been visited in the reference graph for the initial add:?" (cascadedAdds includes: object) ifTrue: [ "we're in the process of adding object, and got here because of a cycle in the object graph; temporarily remove cyclic references (if allowed to be nil) in order to break the cycle, add the object, then restore the references. For references not allowed to be nil raise an exception (this should be handled)" brokenReferences := Dictionary new. type variables do: [:var | var isMapped ifTrue: [ | index ref | index := var instVarIndex. ref := object instVarAt: index. (cascadedAdds includes: ref) ifTrue: [ var isNotNil ifTrue: [ LensSession unhandledCircularReferenceSignal raiseWith: (Array with: type with: var)] ifFalse: [ brokenReferences at: index put: ref. object instVarAt: index put: nil ] ]]]]. "The receiver hasn't been visited in the current add: graph or a cyclic reference has been broken." "Initialize any VersionNumber fields." type variablesDo: [ :var | (var valueType isRowVersion and: [(object instVarAt: var instVarIndex) isNil]) ifTrue: [object instVarAt: var instVarIndex put: 0]]. type checkIncludes: object. (gd := object globalDescriptor) == nil ifTrue: [ "object is transient; get id, add object to database" lensSession checkChange. (id := self transporter add: object) == nil ifFalse: [ "id is not nil if object has already been added" LensGlobalDescriptor new add: object externalId: id lensContainer: self ] ] ifFalse: [ gd lensContainer == self ifFalse: [ self class objectInAnotherLensContainerSignal raiseWith: (Array with: object with: self) ]. gd objectIsRemoved ifTrue: [ "Just put it back in." (id := self transporter add: object) == nil ifFalse: [ "id is nil if object has already been added" gd readd: object withId: id ] ] ]. "repair broken references" brokenReferences == nil ifFalse: [ brokenReferences associationsDo: [:assoc | object update: assoc key to: assoc value]]. ^object
at: eid "Answer the element whose externalId is eid." | gd object | ^(cache == nil or: [(gd := cache at: eid ifAbsent: [nil]) == nil or: [(object := gd object) == nil or: [object isProxy]]]) ifTrue: [ self lensSession checkRead. transporter objectAtId: eid ] ifFalse: [ object ]
at: key put: object "Set the value at key to be object. If key is not found, type-check object, then insert object into receiver under key. Answer object." ^self add: object
includes: object "Answer whether object is one of the receiver's elements." | gd | gd := LensGlobalDescriptor at: object ifAbsent: [^false]. ^gd lensContainer == self
includesKey: key "Answer whether the receiver has a key equal to the argument, key." ^((self selectWhere: [:x | x externalId = key]) answer: [:x | x Count]) first > 0
remove: object ifAbsent: exceptionBlock "Remove object as one of the receiver's elements. If object isn't in receiver, answer the result of evaluating exceptionBlock. Otherwise, answer object." | gd | ^(((gd := object globalDescriptor) notNil and: [gd lensContainer == self]) and: [gd isRemoved not]) ifTrue: [self lensSession checkChange. self checkForReferencesToId: gd externalId. transporter removeObject: object checkingAgainst: object globalDescriptor lastCommitedVersion. self transporter removeFromChildrenSets: object. gd removeFromLens] ifFalse: [exceptionBlock value]
</methods> <methods> Lens.LensBaseContainer <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. type notNil ifTrue: [stream nextPutAll: ' (type='. self printTypeOn: stream. stream nextPut: $)]
</methods> <methods> Lens.QueryCompiler <category>private</category>
nonInteractiveCompilerErrorHandlerClass ^QueryCompilerErrorHandler
</methods> <methods> Lens.QueryCompiler <category>public access</category>
compile: code class: target classified: protocol notifying: aRequestor ifFail: failBlock "Compile the argument, code, as source code in the context of target and install the result in the target' method dictionary. The argument aRequestor is to be notified if an error occurs. The argument code is either a string or an object that converts to a string or a PositionableStream on an object that converts to a string. Evaluate the failBlock if the compilation does not succeed. If it does succeed, store the source code" | methodNode | methodNode := self compile: code in: target notifying: aRequestor ifFail: failBlock. target installSelector: methodNode selector method: methodNode generate classified: protocol sourceCode: code
</methods> <methods> Lens.QueryOperationAccessor <category>evaluating</category>
value "Execute the operation, answering a single result value." ^self valueWithArguments: #()
value: arg "Evaluate the operation represented by the receiver. Fail if the operation expects other than one argument." ^self valueWithArguments: (Array with: arg)
value: arg1 value: arg2 "Evaluate the operation represented by the receiver. Fail if the operation expects other than two arguments." ^self valueWithArguments: (Array with: arg1 with: arg2)
value: arg1 value: arg2 value: arg3 "Evaluate the operation represented by the receiver. Fail if the operation expects other than three arguments." ^self valueWithArguments: (Array with: arg1 with: arg2 with: arg3)
valueWithArguments: actualArgs "Execute the operation specified by the receiver using the given actual arguments." ^operation executeWithArguments: actualArgs session: session lensContainer: lensContainer
</methods> <methods> Lens.QueryOperationAccessor <category>querying</category>
answer: answerBlock "Set the operation's answer block to answerBlock." operation answer: answerBlock
detect: selBlock "Answer an object in the receiver satisfying selBlock. If no such object is found, evaluate noneBlock." ^self selectWhere: selBlock; first
detect: selBlock ifNone: noneBlock "Answer an object in the receiver satisfying selBlock. If no such object is found, evaluate noneBlock." self selectWhere: selBlock. operation privateEmptyResultBlock: noneBlock. ^self first
distinct "Specify that values to be returned are to be distinct." operation distinct
groupBy: aBlock "Specify the groupBy block, which specifies the attributes by which values are to be grouped." operation groupBy: aBlock
locking "Specify query to be locking." operation locking
orderBy: orderByBlock "Set the receiver's orderByBlock, which specifies the order in which to return results." operation orderBy: orderByBlock
select: aBlock "Set the receiver's selectBlock." operation privateSelectBlock: aBlock. ^self values
select: selectBlock answer: answerBlock "Answer a collection of values selected by selectBlock, whose shape is specified by answerBlock." ^self answer: answerBlock; select: selectBlock
selectWhere: aBlock "Set the receiver's selectBlock, which specifies which values to return." operation selectWhere: aBlock
unique "Assert that result must be unique." operation unique
useSqlAccessInterface "Ask receiver to access information via the SQL Access Interface. This means that all returned values are raw, i.e. aren't decoded nor encached, and that any execution arguments passed to the receiver aren't encoded." operation useSqlAccessInterface
</methods> <methods> Lens.QueryOperationAccessor <category>accessing</category>
lensContainer "Answer the receiver's container." ^lensContainer
operation "Answer the accessor's operation." ^operation
resultType "Answer the type of results of the last query, where the type is as follows: single object -> the object's structure type single attribute -> the attribute's value type a set of attributes -> an array of hte value types a composite record containing multiple objects -> an array of their structure types ." operation resultType == nil ifTrue: [ operation resultType: lensContainer transporter resultType]. ^operation resultType
</methods> <methods> Lens.QueryOperationAccessor <category>results access</category>
first "Execute the operation, answering the first result value." operation privateReturnsFirstValue: true. ^self value
readStream "Set the receiver's isStreaming to true." operation privateIsStreaming: true. ^self value
size "Answer the size of the result." operation answerBlock isNil ifFalse: [ self error: (#errQueryingSizeAndResult << #lens >> 'can''t request size and result: in same query')]. operation answer: (SizeBlocks at: lensContainer components size). ^self first
values "Answer a collection of query results. If the query operation was asked to use streaming, then we return a special kind of list (LensStreamList) that will give the illusion of being a full List to the applications" operation useStreaming ifTrue: [^LensStreamList new stream: self readStream] ifFalse: [operation privateIsStreaming: false. ^self value]
</methods> <methods> Lens.QueryOperationAccessor <category>private</category>
includes: object "Answer whether the query represented by the receiver would include the object." ^object notNil and: [operation selectBlock value: object]
</methods> <methods> Lens.QueryOperationAccessor <category>initialization</category>
operation: anOperation session: aSession lensContainer: aContainer operation := anOperation. session := aSession. lensContainer := aContainer.
</methods> <methods> Lens.QueryOperationAccessor class <category>class initialization</category>
initialize "QueryOperationAccessor initialize" "initialize array of blocks to be used by various size composites to get size" SizeBlocks := Array with: [:x1 | x1 Count] with: [:x1 :x2 | x1 Count] with: [:x1 :x2 :x3 | x1 Count] with: [:x1 :x2 :x3 :x4 | x1 Count].
</methods> <methods> Lens.LensBasicTransporter <category>querying</category>
collectionFor: query withParent: parent "Fetch a collection defined by query, all of whose members are parent." | stream cursor | session checkRead. query bindObject: parent externalId. cursor := self baseCursor doCommand: query. stream := cursor answerAfterCommandOfClass: QueryStream. stream lensContainer: lensContainer; decoder: type decoder. ^stream addContentsTo: IdentitySet new
execute: operation "Execute the operation, answering the appropriate kind of stream." | cmd cursor stream | cmd := operation command. "if command isn't generated, generate it" (cmd == nil or: [cmd body == nil]) ifTrue: [ operation command: (cmd := self queryFor: operation)]. cmd isQuery ifTrue: [session checkRead: operation postFlag] ifFalse: [session checkChange]. "get a cursor for the query" cursor := (operation isStreaming or: [resultTemplate ~~ cmd resultTemplate]) ifTrue: [session connection getSession] ifFalse: [self baseCursor]. "issue the command" cursor doCommand: cmd. "if the interface is SQL Access or the container is a simple projection, create a data stream, else an object stream." (operation interface == #sqlAccess or: [ lensContainer isComposite not and: [lensContainer type memberClass == Array]]) ifFalse: [ stream := cursor answerAfterCommandOfClass: QueryStream. stream lensContainer: lensContainer; decoder: cmd decoder ] ifTrue: [ stream := cursor answer]. ^stream
objectAtId: externalId "Answer the object in lensContainer at the externalId." | cursor answer object noMore | fetchCommand == nil ifTrue: [ self initFetchCommand ]. fetchCommand bindObject: externalId. cursor := self baseCursor. cursor blockFactor: 2. cursor doCommand: fetchCommand. answer := cursor answerAfterCommand. answer atEnd ifTrue: [ LensSession rowForObjectNotFoundSignal raise ]. object := type decoder decodeFrom: (answer next) lensContainer: lensContainer. noMore := answer atEnd. answer close. noMore ifFalse: [ LensContainer objectNotUniquelyIdentifiedSignal raise ]. ^object
validatePendingLockOn: object "Verify that there are no lock conflicts as a result of another process modifying the row associated with object." | cursor answer count| lockCommand == nil ifTrue: [ self initLockCommand ]. lockCommand bindObject: nil. lockCommand addBinding: object externalId. type mappedVariablesDo: [ :var | var checkAlways ifTrue: [lockCommand addBinding: (var encode: (object instVarAt: var instVarIndex) in: session)]]. cursor := self baseCursor. cursor blockFactor: 2. cursor doCommand: lockCommand. answer := cursor answerAfterCommand. count := answer next at: 1. answer close. (count ~~ 1) ifTrue: [LensSession optimisticConflictDetectedSignal raise].
</methods> <methods> Lens.LensBasicTransporter <category>initialize-release</category>
disconnect baseCursor == nil ifFalse: [ baseCursor disconnect. baseCursor := nil ]
lensContainer: aContainer "Setup the receiver's basic state for transporting objects for aContainer." lensContainer := aContainer. session := lensContainer lensSession. type := lensContainer type. self initForQueries.
startCommand "Start command generation." referencedObjectSurrogates := IdentitySet new. referencedObjectSurrogates addAll: objectSurrogates. answerSurrogate := nil. decoder := nil.
</methods> <methods> Lens.LensBasicTransporter <category>command execution</category>
doCommand: command "Do the command, answering the cursor." ^session connection doCommand: command
</methods> <methods> Lens.LensBasicTransporter <category>accessing</category>
addCommand "Answer the receiver's add command." addCommand == nil ifTrue: [ self initAddCommand]. ^addCommand
baseCursor "Answer the receiver's baseCursor, creating one if none exists." baseCursor == nil ifTrue: [ baseCursor := session connection getSession]. ^baseCursor
resultTemplate "Answer a result template for records transported by the receiver." ^resultTemplate
resultType "Answer the type of results of the last query, where the type is as follows: single object -> the object's structure type single variable -> the variable's value type a set of variables -> a structure type for an array with the value types a composite record containing multiple objects -> an array of their structure types ." ^answerSurrogate isNil ifTrue: [ lensContainer isComposite ifTrue: [ | stream variables | stream := stream := WriteStream on: (String new: 256). variables := OrderedCollection new. objectSurrogates do: [:surrogate | variables add: surrogate Attribute. stream nextPutAll: surrogate Type name; nextPutAll: ', ']. stream skip: -2. (LensStructureType memberClass: Array variables: variables) name: stream contents] ifFalse: [ type]] ifFalse: [ answerSurrogate size == 1 ifTrue: [ answerSurrogate first Type] ifFalse: [ (LensStructureType memberClass: Array variables: ( answerSurrogate collect: [:surrogate | surrogate Attribute])) name: (#Projection << #lensRuntime >> 'Projection') asString]]
</methods> <methods> Lens.LensBasicTransporter <category>command initialization</category>
initAddCommand "Initialize command to add objects to container." self subclassResponsibility
initFetchCommand "Initialize single-object proxy-fetch command." self subclassResponsibility
initForQueries "Initialize receiver for performing queries." self subclassResponsibility
initLockCommand "Initialize command to verify an optimistic lock." self subclassResponsibility
initUpdateCommand "Initialize command template for updating objects in container." self subclassResponsibility
</methods> <methods> Lens.LensBasicTransporter <category>data manipulation</category>
add: object "Add a object to database, answering its externalId." | snVar sn record id cascadedAdds | cascadedAdds := session cascadedAdds. snVar := type serialNumberVariable. self addCommand. "make sure addCommand is initialized" (cascadedAdds includes: object) ifTrue: [ "second attempt to add object" snVar notNil ifTrue: [ sn := object instVarAt: snVar instVarIndex ] ] ifFalse: [ "first attempt to add object" cascadedAdds add: object. "if type has a serialNumbered variable, generate and assign the serial number now" snVar notNil ifTrue: [ sn := self giveNextSerialNumberTo: snVar of: object ] ]. record := type encode: object inSession: session. (cascadedAdds includes: object) ifFalse: [ "object got added in the course of encoding by virtue of being part of a reference cycle, so don't add it again" ^nil]. "Get the externalId out of the object." id := snVar == nil ifTrue: [ type externalIdOf: object in: session ] ifFalse: [ sn ]. "We're finally ready to insert the row into the database." addCommand bindObject: record. (self doCommand: addCommand) answerAfterCommand. self postAdd: record withId: id. "Check for identity conflict not reported by dbms. This minimizes cache corruption, but the only reasonable recovery from this is to rollback the transaction since we succeeded in making the change. The database clearly isn't enforcing uniqueness and an update or delete will get all of the rows, not just the one the application thinks it is manipulating." (lensContainer privateCache includesKey: id) ifTrue: [ lensContainer class objectNotUniquelyIdentifiedSignal raise ]. cascadedAdds remove: object. "mark the object added" ^id
giveNextSerialNumberTo: variable of: object "Put the next-generated serial number into variable of object. Answer the value used." | nextValue description sngb | nextValue := nil. description := Array with: variable objectType name with: variable name with: variable objectType table qualifiedName with: variable column name. (sngb := session serialNumberGeneratorBlock) notNil ifTrue: [ "Just use the block." nextValue := sngb value: description ] ifFalse: [ | signal | "Let's see if anyone is handling the exception." signal := LensSession serialNumberRequestSignal. Signal noHandlerSignal handle: [ :ex | ex signal == signal ifTrue: [ ex return "Give up." ] ifFalse: [ ex reject "Something else went wrong." ] ] do: [ nextValue := signal raiseRequestWith: description ] ]. ^object instVarAt: variable instVarIndex put: nextValue
postAdd: record withId: id "Perform post-add operations."
removeFromChildrenSets: object "Remove object from all children sets. NB: this leaves the parent pointer intact in object. This is so that object can still be tested for removal set membership. It is also ok, since the parent-child invarient only applies to persistent objects, and object will soon be temporary." type variables do: [ :var | var isParentPointer ifTrue: [ | parent siblings | ((parent := var getValueOf: object) isNothing or: [parent isProxy]) ifFalse: [ siblings := parent perform: var inverseVariable accessorSelector. siblings isProxy ifFalse: [ siblings remove: object. parent child: object removedFrom: siblings]]]]
</methods> <methods> Lens.LensBasicTransporter <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. type notNil ifTrue: [stream nextPutAll: ' (type='. type printNameOn: stream. stream nextPut: $)]
</methods> <methods> Lens.LensBasicTransporter class <category>fileIn/Out</category>
prerequisitesForLoading "LensBasicTransporter requires LensQuerySurrogate to initialize its types." ^super prerequisitesForLoading add: LensQuerySurrogate; yourself
</methods> <methods> Lens.LensFunctionSurrogate <category>accessing</category>
args ^args
argsNumber ^args size
Attribute "Answer an attribute describing the receiver." ^LensStructureVariable new name: self printString; setValueType: type
name ^name
</methods> <methods> Lens.LensFunctionSurrogate <category>symbolic evaluation</category>
AccumulateAttributesIn: attributeSet "Accumulate all accessed attributes into attributeSet." args do: [:arg | arg IsQS ifTrue: [arg AccumulateAttributesIn: attributeSet]]
</methods> <methods> Lens.LensFunctionSurrogate <category>testing</category>
IsRealFunctionSurrogate ^true
</methods> <methods> Lens.LensFunctionSurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." stream nextPutAll: name. stream nextPut: $(. args do: [:arg | arg printOn: stream]. stream nextPut: $)
printTypeOn: stream stream nextPutAll: type name
</methods> <methods> Lens.LensFunctionSurrogate <category>initialize-release</category>
name: nm args: arguments type: tp name := nm. args := arguments. type := tp
</methods> <methods> Lens.LensFunctionSurrogate class <category>instance creation</category>
name: nm args: arguments type: ty ^self new name: nm args: arguments type: ty
</methods> <methods> Lens.LensAnswerStream <category>private-activation</category>
dismiss | s | s := session. super dismiss. s afterOrdinaryAnswerStreamFromCommand
</methods> <methods> Lens.LensChildrenSetSurrogate <category>symbolic evaluation</category>
size "Answer a query to return the size of the set." ^self ChildrenSurrogate answer: [:x | x Count]
</methods> <methods> Lens.LensChildrenSetSurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printTypeOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensChildrenSetSurrogate <category>private</category>
ChildrenSurrogate "Answer a subquery surrogate representing the children." | allChildren | allChildren := LensObjectSurrogate new type: type lensContainer: (path Container lensSession containerOf: type). ^(LensSubquerySurrogate new type: type objectSurrogate: allChildren) select: [:child | (child perform: variable accessorSelector) = path]
printTypeOn: stream path printTypeOn: stream. stream nextPut: $.; nextPutAll: variable inverse
</methods> <methods> Lens.LensChildrenSetSurrogate <category>initialize-release</category>
variable: var path: surrogate "Initialize receiver's state." variable := var. path := surrogate. type := variable objectType
</methods> <methods> Lens.LensArbitraryFunctionSurrogate <category>testing</category>
isArbitraryFunctionSurrogate ^true
</methods> <methods> Lens.LensAspectPath <category>private</category>
adaptorStartingAt: aValueModel | path index model getSel | (head isNil) ifTrue: [^nil]. path := OrderedCollection new. index := 1. (tail at: index) == #@ ifTrue: [ | n | (n := builder source indexForTag: (tail at: index + 1)) == 0 ifFalse: [path addLast: n]. index := index + 2]. index to: (tail size -1) do: [:i | path addLast: (tail at: i)]. tail isEmpty ifTrue: [model := aValueModel] ifFalse: [(model := (getSel := tail at: tail size) isInteger ifTrue: [IndexedAdaptor forIndex: getSel accessPath: path] ifFalse: [AspectAdaptor forAspect: getSel accessPath: path]) subjectChannel: aValueModel]. trigger notNil ifTrue: [model := BufferedValueHolder subject: model triggerChannel: (builder aspectAt: trigger)]. ^model
</methods> <methods> Lens.LensDataModel <category>testing</category>
isCompiled "Answer whether receiver is compiled." ^validity == #compiled or: [validity == #installed]
isInstalled "Answer whether receiver is installed in the data dictionary and is therefore capable of creating sessions." ^validity == #installed
</methods> <methods> Lens.LensDataModel <category>type manipulation</category>
baseTypeNamed: typeName "Answer the base data type with the given name, or nil if none exists." ^dataTypes detect: [:t | t name = typeName] ifNone: [self checkForObsoleteTypes: typeName]
checkForObsoleteTypes: typeName typeName == #ByteString ifTrue: [^self typeNamed: #String]. typeName == #ByteSymbol ifTrue: [^self typeNamed: #Symbol]. ^nil
getTypeFor: toc "Answer the type associated with the given type or class toc, creating one as necessary." | type | toc isLensType ifTrue: [ toc isLensDataType ifTrue: [ "answer toc if already in dataTypes" (self dataTypes includes: toc) ifTrue: [ ^toc ]. "add and answer unregistered enumerations" toc isLensEnumerationType ifTrue: [ ^dataTypes add: toc ]. "answer an equivalent type if found" type :=self baseTypeNamed: toc name. type == nil ifTrue: [ self error: ((#errDatabaseTypeFor << #lens >> 'cannot find base data type for <1p>') expandMacrosWith: toc )]. toc maxColumnConstraint notNil ifTrue: [ type := type isLensEncodedType ifTrue: [type copy fieldType: (self getTypeFor: (type fieldType copy maxColumnConstraint: toc maxColumnConstraint))] ifFalse: [type copy maxColumnConstraint: toc maxColumnConstraint]]]. toc isLensStructureType ifTrue: [ "answer toc if already in structureTypes" (structureTypes includes: toc) ifTrue: [^toc] ifFalse: [self error: ((#errTypeNotFound << #lens >> 'type not found<1p>')expandMacrosWith: toc)]]. toc isLensCollectionType ifTrue: [ | elementType | (dataTypes includes: toc) ifTrue: [^toc]. "first intern the elementType" elementType := self getTypeFor: toc elementType. toc of: elementType. type := dataTypes detect: [:t | t memberClass == toc memberClass and: [ t isLensCollectionType and: [ t elementType == toc elementType]]] ifNone: [dataTypes add: toc]]] ifFalse: [ "toc must be a class" toc isBehavior ifFalse: [self error: (#errIllegalTypeOrClass << #lens >> 'illegal type or class')]. type := structureTypes detect: [:t | t memberClass == toc] ifNone: [dataTypes detect: [:t | t memberClass == toc] ifNone: [self error: ((#errDatabaseTypeFor << #lens >> 'cannot find base data type for <1p>') expandMacrosWith: toc )].]]. ^type
mappedTypesDo: block "Evaluate block on each type mapped by the receiver." 1 to: structureTypes size do: [ :index | | type | type := structureTypes at: index. type isMapped ifTrue: [ block value: type ] ]
typeNamed: typeName "Answer the structure or data type with the given name, or nil if none exists." ^structureTypes detect: [:t | t name = typeName] ifNone: [self baseTypeNamed: typeName]
typeOf: typeOrClass "Answer the type associated with the given object, or nil if none exists." typeOrClass isLensType ifTrue: [^typeOrClass]. typeOrClass isBehavior ifFalse: [^nil]. ^dataTypes detect: [:t | t memberClass == typeOrClass or: [t name = typeOrClass name]] ifNone: [structureTypes detect: [:t | t memberClass == typeOrClass] ifNone: [nil]]
</methods> <methods> Lens.LensDataModel <category>verification</category>
changeClassToMatch: typ ^LensDataModelGenerator new updateClassFromAnnotation: typ
changeTypeToMatchClass: type " Attempt to reconcile type to class definition" | varNames newVarList newVarName | "read the 'new' class definition and make sure we have a variable list that matches it" newVarList := List new. "iterate through the new instance variables; find the matching existing LSVar or create a new LSVar (set to Object)" varNames := type memberClass allInstVarNames. 1 to: varNames size do: [:index| | var| newVarName := varNames at: index. var := type variableNamed: newVarName ifNone: [nil]. var isNil ifTrue: [ "create new LSVar for this new instVar" var := LensStructureVariable new. var setValueType: (self typeNamed: #Object). var generatesAccessor: true; generatesMutator: true; name: newVarName; objectType: type. ]. var instVarIndex: index. "should take care of reorderings" newVarList addLast: var ]. type variables: newVarList. "check whether the defined key is still valid. If not then remove the key" type dataModel invalidate. ^true
isConsistent "Here we test that we are in a reasonable state to be installed. Some tests may be added in the future." "Verify that all the structureTypes have keys." self structureTypes do: [:st | (st isMapped and: [st idVariable isNil]) ifTrue: [Dialog warn: ((#noKeyDefined << #lens >> 'The Entity: <1s> has no key defined. To define a key open the Mappings View and use the "Edit Key..." option in the "Entity" menu') expandMacrosWith: st name). ^false]]. ^true
reconciliateClassAndType: type "Try to make the type and the class agree, at least enough so the model can be loaded." | opt msg | type variables size = type memberClass instSize ifTrue: [ msg := (#orderingVariables << #lens >> 'Entity ''<1s>'' has a different ordering of variables than its member class' ) ] ifFalse: [ type variables size > type memberClass instSize ifTrue: [msg := (#moreVariables << #lens >> 'Entity ''<1s>'' has more variables than its member class')] ifFalse: [msg := (#fewerVariables << #lens >> 'Entity ''<1s>'' has fewer variables than its member class')] ]. opt := Dialog choose: (msg expandMacrosWith: type name) labels: (Array with: (#Terminate << #lens >> 'Terminate') with: (#UpdateEntity << #lens >> 'Update Entity') with: (#UpdateClass << #lens >> 'Update Class')) values: #(#abort #theEntity #theClass ) default: #theClass. opt == #theClass ifTrue: [^self changeClassToMatch: type] ifFalse: [opt == #theEntity ifTrue: [^self changeTypeToMatchClass: type] ifFalse: [^false]]
verifyDataType: type havingVisited: typeSet alongPath: path "Verify that type is a simple data type, using typeSet to terminate recursion." (typeSet includes: type) ifTrue: [^self]. type isLensDataType ifTrue: [^self]. typeSet add: type. path addLast: type. type variables do: [:att | | valueType | valueType := att valueType. path addLast: att name. self verifyType: valueType isDefinedAlongPath: path. valueType isMapped ifTrue: [ path addLast: valueType. self dataDefinitionErrorWith: (Array with: self with: type with: path asArray) errorPattern: (#errDataDefinitionPath << #lens >> '<1p> data definition error:<n><2p> is packed<n>and references a mapped entity along the path:<n><3p>')]. self verifyDataType: valueType havingVisited: typeSet alongPath: path. path removeLast]. path removeLast
verifyRulesOnType: type havingVisited: typeSet alongPath: path "Verify generic design rules on type possibly mapped by receiver, using typeSet to terminate recursion. Path is an ordered collection starting at a type and followed by the chain of attributes traversed to get to type (non-empty only when type is unmapped)." (typeSet includes: type) ifTrue: [^self]. type isLensDataType ifTrue: [ self verifyDataType: type havingVisited: typeSet alongPath: path] ifFalse: [ self verifyStructureType: type havingVisited: typeSet alongPath: path]
verifyStructureType: type havingVisited: typeSet alongPath: path "Verify structure type, using typeSet to terminate recursion." typeSet add: type. path addLast: type. "check type/class structure consistency" (type memberClass ~= Array and: [ type matchesClass not]) ifTrue: [ (self reconciliateClassAndType: type) ifFalse: [ self dataDefinitionErrorWith: (Array with: self displayString with: type name asString) errorPattern: (#errClassDifferentVars << #lens >> '<1p> data definition error:<n>Entity <2p><n>and its class have a different number of variables and instVars')]]. "Check that all the id variables are mapped" type idVariables do: [:idv | idv isMapped not ifTrue: [ self dataDefinitionErrorWith: (Array with: self displayString with: idv name asString with: type name asString) errorPattern: (#errShouldBeMapped << #lens >> '<1p> data definition error:<n>Variable: <2p><n>is part of the key of entity: <3p><n>therefore it should be mapped')]]. type mappedVariablesDo: [ :var | | valueType | path addLast: var name. valueType := var valueType. "verify that valueType is properly defined" self verifyType: valueType isDefinedAlongPath: path. "id attributes must be unencoded" var isId ifTrue: [ var decodeSelector notNil ifTrue: [ self dataDefinitionErrorWith: (Array with: self displayString with: var name asString with: type name asString) errorPattern: (#errVariableShouldntBeEncoded << #lens >> '<1p> data definition error:<n>Variable <2p><n>of entity <3p><n>is an id, hence shouldn''t be encoded')]]. "recursively check valueType for mapped variables" var isMapped ifTrue: [ self verifyRulesOnType: valueType havingVisited: typeSet alongPath: path]. path removeLast]. "check that children types are defined" type variables do: [ :var | | valType | valType := var targetValueType. (var isChildrenPointer and: [valType isMapped not]) ifTrue: [ self dataDefinitionErrorWith: (Array with: self displayString with: var name asString with: type name asString with: valType name asString) errorPattern: (#errIsParentPointer << #lens >> '<1p> data definition error:<n>Variable <2p><n>of entity <3p><n>is a parent pointer, and references<n><4p><n>which is unmapped')]]. path removeLast
verifyType: type isDefinedAlongPath: path "Verify generic design rules on type possibly mapped by receiver, using typeSet to terminate recursion. Path is an ordered collection starting at a type and followed by the chain of attributes traversed to get to type (non-empty only when type is unmapped)." type isLensType ifFalse: [ self dataDefinitionErrorWith: (Array with: self displayString with: type name asString) errorPattern: (#errDataDefinitionNotEntity << #lens >> '<1p> data definition error:<n><2p><n>isn''t an entity')]. type memberClass == Object ifTrue: [ path isEmpty ifTrue: [ self dataDefinitionErrorWith: (Array with: self displayString) errorPattern: (#errDataDefinitionMapped << #lens >> '<1p> data definition error:<n>Object shouldn''t be mapped')] ifFalse:[ self dataDefinitionErrorWith: (Array with: self displayString with: path asArray) errorPattern: (#errDataDefinitionObject << #lens >> '<1p> data definition error:<n>Path <2p><n>ends up at Object')]]
</methods> <methods> Lens.LensDataModel <category>administration</category>
compile "Verify the receiver's design and compile transcoders." | visitedTypes | "Flush any caches in the LensCompiler because we are starting a fresh new compilation batch and classes may have changed since the last compilation" LensCompiler clearCaches. self resetTypesAndTables. "verify generic rules and database constraints" visitedTypes := IdentitySet new. self mappedTypesDo: [ :type | | path | path := OrderedCollection new. self verifyType: type isDefinedAlongPath: path. self verifyRulesOnType: type havingVisited: visitedTypes alongPath: path. self databaseContext class verifyConstraintsOnType: type ]. "Find overlapping variables" self mappedTypesDo: [ :type | type findOverlappingVariables ]. "flush transcoders so will be regenerated" structureTypes do: [ :type | type flushTranscoders ]. "generate transport machinery" self mappedTypesDo: [:type | type generateTranscoders]. LensCompiler clearCaches. self isCompiled ifFalse: [self validity: #compiled].
invalidate "Mark receiver as invalid, generally in response to a change in one of its mapped types." self saved: false. self isCompiled ifFalse: [^self]. self validity: #invalid. operations do: [:operation | operation wasExtracted ifFalse: [ operation invalidateCommand]]
migrateDatabaseContext: newDatabaseContext "Migrate the context for this LensDataModel. This means mapping all type entries appropriately for the dialect of the new context." self setDatabaseContext: newDatabaseContext. dataTypes := newDatabaseContext class basicTypes shallowCopy. self mappedTypesDo: [:type | newDatabaseContext migrateType: type]. self resetTypesAndTables
</methods> <methods> Lens.LensDataModel <category>initialize-release</category>
initialize "Initialize receiver." selector := #dataModelSpec. dataTypes := OrderedCollection new. structureTypes := OrderedCollection new. validity := #invalid. tables := OrderedCollection new. operations := OrderedCollection new. lensPolicyName := #Mixed. lensTransactionPolicyName := #PessimisticRR.
setTables "Initialize tables instVar." tables := OrderedCollection new. self mappedTypesDo: [:t | tables add: t table].
</methods> <methods> Lens.LensDataModel <category>accessing</category>
addStructureType: type "Add the given structure type to myself" structureTypes add: type. type dataModel: self. ^type
application "Answer the application class to which the receiver is attached." ^application
application: newApplication "Set the application class to which the receiver is to be attached." application := newApplication
applicationName ^application == nil ifTrue: [ nil ] ifFalse: [ application fullyQualifiedReference ]
applicationName: aStringOrSymbol application := self class environment at: aStringOrSymbol asSymbol ifAbsent: [ nil ].
databaseContext "Answer the context in which instances of this ObjectLens will access the database." ^databaseContext
databaseContext: newDatabaseContext "Set the context in which instances of this ObjectLens will access the database." "Assume: no migration will occur due to newDatabaseContext." self setDatabaseContext: newDatabaseContext. dataTypes := newDatabaseContext == nil ifTrue: [#()] ifFalse: [newDatabaseContext class basicTypes shallowCopy]. (newDatabaseContext notNil and: [newDatabaseContext username isNil]) ifTrue: [newDatabaseContext username: (UISettings preferenceFor: #dbDevUsername)]. self lensTransactionPolicyName: newDatabaseContext class defaultTransactionPolicy. self resetTypesAndTables
dataTypes "Answer the reciever's collection of datatypes." ^dataTypes
lensPolicy "Answer the default lens policy." ^LensPolicy named: lensPolicyName
lensPolicyName "Answer the name of the default lens policy." ^lensPolicyName
lensPolicyName: newName "Set the name of the default lens policy." lensPolicyName := newName
lensTransactionPolicy "Answer the default lens policy." ^LensTransactionPolicy named: lensTransactionPolicyName
lensTransactionPolicyName "Answer the name of the default lens Transaction policy." ^lensTransactionPolicyName
lensTransactionPolicyName: newName "Set the name of the default lens Transaction policy." lensTransactionPolicyName := newName
makeInstalled "Assert that receiver is installed." self validity: #installed
mappedTypes "Answer the set of mapped types mapped by the receiver to its subject database." ^structureTypes select: [:type | type isMapped]
operations "Answer the dictionary of remote operations associated with the receiver." ^operations
removeStructureType: type uiWindow: win "Remove the type from the list of structure types. Retype to 'Object' any variable referencing the defunct type" structureTypes remove: type ifAbsent: [^nil]. structureTypes do: [:st | st variablesDo: [:var | var targetValueType = type ifTrue: [var isId ifTrue: [Dialog warn: ((#variableReferencesRemovedEntity << #lens >> 'The variable: <1s> is in the key of entity: <2s> and it references the removed entity. Use the mapping tool to redefine the type of this variable') expandMacrosWith: var name with: st name) for: win]. var flushAccessMethods. var isMapped ifTrue: [var isMapped: false. var column: nil]. var valueType: (self typeOf: Object). var inverse: nil. var generateAccessMethods]]]
rootStructureTypes "Answer those structure types at the root of their local type hierarchy." ^structureTypes select: [:t | t isRoot]
saved "Say whether the receiver has been installed since last changed." saved isNil ifTrue: [saved := true]. ^saved
saved: flag "Assert whether or not the receiver has been installed since last being changed." saved := flag
selector "Answer the receiver's selector." ^selector
selector: newSelector "Set the receiver's selector to newSelector." selector := newSelector
structureTypes "Answer all structure types in receiver." ^structureTypes
structureTypes: newTypes "Set all structure types in receiver." structureTypes := newTypes
tables "Answer the schema's tables." ^tables
tables: tableCollection "Set the schema's tables." tables := tableCollection
validity "Answer the receiver's validity." ^validity
validity: newValidity "Set the receiver's validity to newValidity." validity := newValidity
valueTypes "Answer an ordered collection of possible value types, grouped as follows: - data types and unmapped collection types - mapped structure and collection types - unmapped structure types Within each group, the types are sorted alphabetically." | valueTypes | valueTypes := OrderedCollection new. valueTypes addAll: ( dataTypes asSortedCollection: [:a :b | a printString <= b printString]). valueTypes addAll: ( (structureTypes select: [:t | t isMapped]) asSortedCollection: [:a :b | a printString <= b printString]). valueTypes addAll: ( (structureTypes select: [:t | t isLensStructureType and: [t isMapped not]]) asSortedCollection: [:a :b | a printString <= b printString]). "remove link types" self mappedTypes do: [:t | t isLensCollectionType ifTrue: [valueTypes remove: t linkType ifAbsent: [] ]]. ^valueTypes
</methods> <methods> Lens.LensDataModel <category>to/from specification</category>
fromLiteralArrayEncoding: anArray "If a class doesn't exist for an entity we create it on the fly. Since generating accessors and mutators may use information in the datamodel, we delay the regeneration of access methods to the end of the process" | newTypes | newTypes := OrderedCollection new. super fromLiteralArrayEncoding: anArray. self databaseContext first asQualifiedReference valueOrDo: [Dialog warn: ((#contextNotFound << #lens >> '<1s> not found. Database driver probably not loaded in the image. Install the corresponding database driver and try again') expandMacrosWith: self databaseContext first). LensDataModel dataDefinitionErrorSignal raise]. self setDatabaseContext: self databaseContext decodeAsLiteralArray. dataTypes := OrderedCollection new. self databaseContext isNil ifFalse: [ dataTypes addAll: self databaseContext class basicTypes ]. structureTypes := structureTypes asOrderedCollection collect: [:t | t decodeAsLiteralArray]. 1 to: structureTypes size do: [ :index | | t | t := structureTypes at: index. (t memberClass isSymbol or: [t memberClass isBindingReference]) ifTrue: [self recreateMemberClassFor: t. newTypes add: t]. t isMapped ifTrue: [ tables add: t table ]. t resolveReferencesIn: self. t setSupertype ]. self resetTypesAndTables. newTypes do: [:newT | newT generateAccessMethods]
resolveType: type "Look up the type in this data model to eliminate duplicates." type isNil ifTrue: [ ^nil ]. ^type isSymbol ifTrue: [ | result | result := self typeNamed: type. result isNil ifTrue: [ LensReferenceType new referencedClassName: type ] ifFalse: [ result ] ] ifFalse: [ type resolveReferencesIn: self ]
setDataTypes: dt dataTypes := dt
writeSpec self writeSpecMethod: self selector on: self application
writeSpecMethod: aSelector on: class "Write a spec method on the given class. Flush the data models cached in the class" Cursor execute showWhile: [ | s | s := (String new: 200) writeStream. s nextPutAll: aSelector; cr; tab; nextPutAll: '"LensEditor new openOnClass: self andSelector: #'; nextPutAll: selector; nextPut: $"; cr; crtab; nextPutAll: '<resource: #dataModel>'; crtab; nextPut: $^. UISpecification prettyPrintSpecArray: self literalArrayEncoding on: s tabLevel: 1. class class compile: s contents classified: #'lens data model specs'. class class removeSelector: #markedAsSystemClass]
</methods> <methods> Lens.LensDataModel <category>private</category>
getCatalogSession "Answer a new lens session on the catalog for the database context." | ls | ls := self databaseContext catalogDataModel getSession. ls username: self databaseContext username. ls environment: self databaseContext environment. ^ls
mappingForColumn: aColumn "Answer the data type mapping for the field type." ^self databaseContext class dataTypeMappings detect: [:m | aColumn dataType = m columnType] ifNone: [nil]
mappingForFieldType: type "Answer the data type mapping for the field type." ^self databaseContext class dataTypeMappings detect: [:m | "type isNamed and: [type name = m fieldType name]]" (type name = m fieldType name) and: [type maxColumnConstraint isNil or: [type maxColumnConstraint asInteger <= m maxSize]]] ifNone: [ | class max mapping | class := type memberClass. max := type maxColumnConstraint. mapping := nil. [mapping == nil and: [class notNil]] whileTrue: [ mapping := self databaseContext class dataTypeMappings detect: [:m | m fieldType memberClass == class and: [max isNil or: [max asInteger <= m maxSize]]] ifNone: [class := class superclass. nil]]. mapping isNil ifTrue: [ self error: (#errMappingNotFoundForType << #lens >> 'Internal ObjectLens error: mapping not found for type')]. mapping]
printNameOn: stream (self application notNil and: [ self selector notNil ]) ifTrue: [ stream nextPutAll: self applicationName asString; nextPutAll: '>>'; nextPutAll: self selector ] ifFalse: [ stream nextPutAll: (#unnamed << #lensRuntime >> 'unnamed') asString]
removeDesignator (application notNil and: [selector notNil]) ifTrue: [application class removeSelector: #dataModelDesignator]
removeFromDataDictionary: type in: session "Remove tables and indexes for type from data dictionary." type table removeFrom: session.
setDatabaseContext: newDatabaseContext databaseContext := newDatabaseContext
</methods> <methods> Lens.LensDataModel <category>session creation</category>
getSession "Answer a closed lens session on the data model." self isCompiled ifFalse: [self compile]. ^LensSession on: self
</methods> <methods> Lens.LensDataModel <category>operation access</category>
addOperation: operation "Add the operation, after removing any synonymous ones." | existingOp | existingOp := operations detect: [:op | op name = operation name] ifNone: [nil]. operations remove: existingOp ifAbsent: []. operations add: operation
operationNamed: aSelector "Answer the named operation, or nil if none." ^operations detect: [:op | op name == aSelector] ifNone: [nil]
</methods> <methods> Lens.LensDataModel <category>printing</category>
displayString | strm | strm := WriteStream on: (String new: 128). self printNameOn: strm. ^strm contents
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensDataModel <category>data model generation</category>
fieldTypeForColumn: column "Answer the type for a variable mapped to this column. Returns the first one found, in the dataTypeMappings collection" | fieldType mapping | mapping := self databaseContext class dataTypeMappings detect: [:m | m columnType sameAs: column dataType] ifNone: [self error: (#errUnrecognizedColumnType << #lens >> 'unrecognized column type')]. fieldType := mapping fieldType. ^fieldType
newVariableFor: column "Answer a new variable for the given column." | var | var := LensStructureVariable new name: column internalName. var isMapped: true. var column: column. var valueType: (self fieldTypeForColumn: column). ^var
resetTypesAndTables "Recompute data types and tables." | vars | vars := IdentitySet new. structureTypes do: [:t | t accumulateIn: vars]. vars do: [:var | var resetFieldTypeMax]. tables := OrderedCollection new. self mappedTypesDo: [:t | tables add: t table. t table columns: t columns]
</methods> <methods> Lens.LensDataModel <category>error handling</category>
dataDefinitionErrorWith: parameters errorPattern: template "Raise a data definition error." | message | message := template expandMacrosWithArguments: parameters. Signal noHandlerSignal handle: [:ex | ex parameter signal = self class dataDefinitionErrorSignal ifTrue: [LensSession complain: message proceed: false] ifFalse: [ex reject]] do: [self class dataDefinitionErrorSignal raiseWith: (Array with: message) , parameters]
dataDefinitionWarningWith: parameters errorPattern: template "Raise a data definition error." | message | message := template expandMacrosWithArguments: parameters. Signal noHandlerSignal handle: [:ex | ex parameter signal = self class dataDefinitionWarningSignal ifTrue: [ LensSession complain: message proceed: true] ifFalse: [ex reject]] do: [self class dataDefinitionWarningSignal raiseRequestWith: (Array with: message) , parameters]
recreateMemberClassFor: aType "The member class for aType disappeared from the system, raise a warning signal, if there is no handler for it, then inform the user and give the opportunity to recreate the class" | message | message := ((#errClassNotFound << #lens >> '<1p> data definition error:<n>class not found: <2p>') expandMacrosWith: self with: aType). Signal noHandlerSignal handle: [:ex | ex parameter signal = self class dataDefinitionWarningSignal ifTrue: [| ldmg | Dialog warn: ((#deleteUnfoundClassFromModel << #lens >> 'The class: <1s> was not found in the system. It will be recreated. If necessary, it can be deleted from the Data Model and the System using the Data Modeler.') expandMacrosWith: aType memberClass asSymbol). ldmg := LensDataModelGenerator new. ldmg lensDataModel: self. ldmg automaticClassForType: aType. ex return] ifFalse: [ex reject]] do: [ self class dataDefinitionWarningSignal raiseRequestWith: (Array with: message with: self with: aType)]
</methods> <methods> Lens.LensDataModel class <category>private</category>
encodedAspects ^#( #(#databaseContext #setDatabaseContext:) #structureTypes #lensPolicyName #lensTransactionPolicyName #validity )
valueEncoder ^[:value | value isBehavior ifTrue: [value name] ifFalse: [value literalArrayEncoding]]
</methods> <methods> Lens.LensDataModel class <category>instance creation</category>
new ^super new initialize
readFromClass: class methodName: methodName "Answer a LensDataModel decoded from the literal encoding found in the method on aClass with the selector selectorSymbol or nil if no method is found." | literalArray ldm | literalArray := class messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil] do: [class perform: methodName]. literalArray isNil ifTrue: [^nil]. ldm := self new. ldm application: class. ldm fromLiteralArrayEncoding: literalArray. ldm selector: methodName. ^ldm
</methods> <methods> Lens.LensDataModel class <category>signal access</category>
dataDefinitionErrorSignal "Answer the signal indicating an error in the data model structure." ^DataDefinitionError
dataDefinitionWarningSignal "Answer the signal indicating a warning while reconstructing a data model." ^DataDefinitionWarning
</methods> <methods> Lens.LensDataModel class <category>class initialization</category>
initialize "LensDataModel initialize" self initializeExceptionClasses
initializeExceptionClasses "Initialize related exception classes." DataDefinitionError notifierString: (#dataDefinitionError << #lens >> 'Data definition error'); nameClass: self message: #dataDefinitionErrorSignal. DataDefinitionWarning notifierString: (#dataDefinitionProblemEncountered << #lens >> 'Data definition problem encountered'); nameClass: self message: #dataDefinitionWarningSignal
</methods> <methods> Lens.LensSpecReplicator <category>accessing</category>
editPolicy ^editPolicy
editPolicy: sym editPolicy := sym
fieldSpec ^fieldSpec
fieldSpec: aValue fieldSpec := aValue
offset ^offset
offset: aValue offset := aValue
</methods> <methods> Lens.LensSpecReplicator <category>secondary dispatch</category>
doLeafComponentSpec: aSpec aSpec layout: (self offsetLayout: aSpec layout by: self offset). ^aSpec
doLeafDataSetColumnSpec: aSpec "Change the spec of a data set column according to the canvas specification. If the edit policy is neverEdit then set the appropriate editor in the column, otherwise set the callback to validate the proper state for editing" | label | aSpec label notNil ifTrue: [((label := aSpec label) isKindOf: Symbol) ifTrue: [aSpec label: (self mutateLabel: label asString) asSymbol] ifFalse: [aSpec label: (self mutateLabel: label)]]. aSpec model notNil ifTrue: [aSpec model: (self mutateAspect: aSpec model)]. aSpec type: (aSpec class getTypePropForClassNamed: (self fieldSpec at: 2)). editPolicy == #neverEdit ifTrue: [aSpec editorType: #None] ifFalse: [| sz | sz := fieldSpec at: 3. sz == nil ifFalse: [sz := sz asInteger]. aSpec size: sz. aSpec callbacksSpec valueChangeSelector: #valueChanged. editPolicy == #enableEditingOnSelection ifTrue: [aSpec callbacksSpec requestFocusInSelector: #focusInRequest] ifFalse: [aSpec callbacksSpec requestFocusInSelector: #explicitFocusInRequest]]
doLeafDataSetSpec: aSpec self doLeafWidgetSpec: aSpec. aSpec callbacksSpec requestFocusInSelector: #focusInRequest. aSpec callbacksSpec valueChangeSelector: #valueChanged
doLeafGroupBoxSpec: aSpec | label | self doLeafNamedSpec: aSpec. aSpec label notNil ifTrue: [((label := aSpec getLabel) isKindOf: Symbol) ifTrue: [aSpec setLabel: (self mutateLabel: label asString) asSymbol] ifFalse: [aSpec setLabel: (self mutateLabel: label)]]. ^aSpec
doLeafInputFieldSpec: aSpec self doLeafWidgetSpec: aSpec. aSpec type: (aSpec class getTypePropForClassNamed: (self fieldSpec at: 2)). editPolicy == #neverEdit ifTrue: [aSpec isReadOnly: true] ifFalse: [| sz | sz := fieldSpec at: 3. sz == nil ifFalse: [sz := sz asInteger]. aSpec numChars: sz. aSpec callbacksSpec valueChangeSelector: #valueChanged. editPolicy == #enableEditingOnSelection ifTrue: [aSpec callbacksSpec requestFocusInSelector: #focusInRequest] ifFalse: [aSpec callbacksSpec requestFocusInSelector: #explicitFocusInRequest]]
doLeafLabelSpec: aSpec | label | self doLeafNamedSpec: aSpec. aSpec label notNil ifTrue: [((label := aSpec getLabel) isKindOf: Symbol) ifTrue: [aSpec setLabel: (self mutateLabel: label asString) asSymbol] ifFalse: [aSpec setLabel: (self mutateLabel: label)]]. ^aSpec
doLeafNamedSpec: aSpec self doLeafComponentSpec: aSpec. aSpec name notNil ifTrue: [aSpec name: (self mutateID: aSpec name)]. ^aSpec
doLeafWidgetSpec: aSpec self doLeafNamedSpec: aSpec. aSpec model notNil ifTrue: [aSpec model: (self mutateAspect: aSpec model)]. ^aSpec
</methods> <methods> Lens.LensSpecReplicator <category>private</category>
aspect ^self fieldSpec at: 1
mutateAspect: aspectSymbol ^(self mutateString: aspectSymbol asString with: self aspect) asSymbol
mutateID: anIDSymbol | string index stream info | index := (string := anIDSymbol asString) findString: '*' startingAt: 1 ifAbsent: [^nil]. stream := String new writeStream. info := self aspect copyWithout: #@. 1 to: info size do: [:pos | | copy | (copy := (info at: pos) asString copy) at: 1 put: (pos = 1 ifTrue: [(copy at: 1) asLowercase] ifFalse: [(copy at: 1) asUppercase]). stream nextPutAll: copy]. ^(string copyReplaceFrom: index to: index with: stream contents) asSymbol
mutateLabel: aString ^self mutateString: aString with: (self aspect copyWithout: #@)
mutateString: aString with: replacement | index stream | index := aString findString: '*' startingAt: 1 ifAbsent: [0]. stream := String new writeStream. replacement do: [:sym | stream nextPutAll: sym asString. stream space]. stream skip: -1. ^(index = 0 ifTrue: [stream contents] ifFalse: [aString copyReplaceFrom: index to: index with: stream contents])
offsetLayout: aLayout by: aPoint | result | (aLayout isKindOf: Layout) ifTrue: [result := aLayout copy. result leftOffset: result leftOffset + aPoint x. result topOffset: result topOffset + aPoint y. (aLayout isKindOf: LayoutFrame) ifTrue: [result rightOffset: result rightOffset + aPoint x. result bottomOffset: result bottomOffset + aPoint y]] ifFalse: [result := aLayout translatedBy: aPoint]. ^result
</methods> <methods> Lens.LensObjectSurrogate <category>accessing</category>
Attribute "Answer an attribute describing the receiver." | name | name := type name asString. name at: 1 put: name first asLowercase. name = type name asString ifTrue: [name := name, '_']. ^LensStructureVariable new name: name; setValueType: type
Container "Answer the receiver's container, if any." ^lensContainer
Destination "Answer the object surrogate representing the receiver's value." ^self
TableName "Answer the type's tableName." ^type tableName
</methods> <methods> Lens.LensObjectSurrogate <category>subquerying</category>
answer: answerBlock "Answer a subquery surrogate that answers values specified by answerBlock." ^(LensSubquerySurrogate new type: type objectSurrogate: self) answer: answerBlock
select: selectBlock "Answer a subquery surrogate that performs a nested selection." | surrog | surrog := LensObjectSurrogate new type: type lensContainer: lensContainer. ^(LensSubquerySurrogate new type: type objectSurrogate: surrog) select: selectBlock
select: selectBlock answer: answerBlock "Answer a collection of values selected by selectBlock, whose shape is specified by answerBlock." ^(self select: selectBlock) answer: answerBlock
</methods> <methods> Lens.LensObjectSurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printTypeOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensObjectSurrogate <category>aggregate operations</category>
Count "Answer the number of objects in result." ^LensAggregateSurrogate apply: #Count to: self of: IntegerType
</methods> <methods> Lens.LensObjectSurrogate <category>testing</category>
IsObjectSurrogate "Answer whether receiver is an object surrogate." ^true
IsOuterJoin "Answer whether receiver should be outer-joined." ^isOuterJoin
</methods> <methods> Lens.LensObjectSurrogate <category>initialize-release</category>
type: aType lensContainer: aContainer "Initialize receiver's state." type := aType. isOuterJoin := false. destinations := IdentityDictionary new. lensContainer := aContainer
</methods> <methods> Lens.LensObjectSurrogate <category>symbolic evaluation</category>
AccumulateAttributesIn: attributeSet "Accumulate all accessed attributes into attributeSet."
externalId "Answer a surrogate that answers the receiver's externalId." | idv | (idv := type idVariable) isReference ifTrue: [ | pseudoIdVar | pseudoIdVar := idv copy. pseudoIdVar fieldType isLensStructureType ifTrue: [ pseudoIdVar setValueType: pseudoIdVar fieldType copy. pseudoIdVar valueType table: nil ] ifFalse: [ pseudoIdVar setValueType: pseudoIdVar fieldType ]. ^LensVariableSurrogate new source: self via: pseudoIdVar ] ifFalse: [ ^self navigateThrough: idv ]
navigateThrough: var "Symbolically evaluate a navigation step, via reference to variable, answering the resulting variableSurrogate." "Answer a LensVariableSurrogate which references my type's var variable. var may be either one of the type's variables or the idVariable." | variableSurrogate | (type isMapped and: [var ~~ type idVariable and: [isOuterJoin]]) ifTrue: [ LensContainer queryErrorSignal raiseWith: (Array with: type with: var) errorPattern: (#errNavigateOuterJoin << #lens >> 'Attempting to navigate through outer join via <1p>.<2p>.') ]. "reuse existing surrogate for the variable, if any" variableSurrogate := destinations at: var ifAbsent: [ destinations at: var put: (LensVariableSurrogate new source: self via: var) ]. variableSurrogate ascending. "ensure isAscending on reuse" ^variableSurrogate
outerJoin "Mark receiver as an outer join component." isOuterJoin := true
</methods> <methods> Lens.LensObjectSurrogate <category>private</category>
printTypeOn: stream stream nextPutAll: type name
</methods> <methods> Lens.LensExceptionInfo <category>accessing</category>
exception "Return the receiver's exception attribute." ^exception
exception: newException "set the receiver's exception attribute." exception := newException.
object "Return the receiver's object attribute." ^object
object: newObject "Set the receiver's object attribute." object := newObject.
operation "Return the operation that was involved in generating this exception." | gd | gd := object globalDescriptor. ^gd == nil ifTrue: [#add] ifFalse: [gd objectIsPendingRemoval ifTrue: [#remove] ifFalse: [#update]]
</methods> <methods> Lens.LensExceptionInfo <category>initialize-release</category>
initialize ^self
</methods> <methods> Lens.LensExceptionInfo class <category>instance creation</category>
new ^super new initialize
on: newObject with: newException "Return a new LensExceptionInfo on the specified Object and Exception" ^(self new) object: newObject; exception: newException
</methods> <methods> Lens.LensLinkedAssociation <category>accessing</category>
key: aKey value: anObject "Store the arguments as the variables of the receiver." key := aKey. value := anObject
nextLink "Answer the LensLinkedAssociation to which the receiver points." ^nextLink
nextLink: aLink "Store the argument as the LensLinkedAssociation to which the receiver refers." nextLink := aLink
</methods> <methods> Lens.LensLinkedAssociation class <category>instance creation</category>
key: newKey value: newValue "Answer a new instance of the receiver with the arguments as the key and value of the association." ^(self new) key: newKey value: newValue
</methods> <methods> Lens.LensDatabaseTableColumn <category>accessing</category>
dataType "Answer the receiver's dataType." ^self subclassResponsibility
dataType: newDataType "Set the receiver's dataType to newDataType." self subclassResponsibility
isNotNil "Answer whether the column described by the receiver cannot store nulls." ^self subclassResponsibility
isNotNil: newIsNotNil "Set the receiver's isNotNil to newIsNotNil." self subclassResponsibility
maxColumnConstraint "Answer the receiver's maxColumnConstraint." ^self subclassResponsibility
maxColumnConstraint: newWidth "Set the receiver's maxColumnConstraint to newWidth." self subclassResponsibility
maxColumnLength "Answer the receiver's maxColumnLength." | constr | constr := self maxColumnConstraint. ^(constr == nil or: [constr isInteger]) ifTrue: [constr] ifFalse: [constr length]
maxColumnLength: newWidth "Set the receiver's maxColumnLength to newWidth." | constr | constr := self maxColumnConstraint. (constr == nil or: [constr isInteger]) ifTrue: [self maxColumnConstraint: newWidth] ifFalse: [self maxColumnConstraint: (self maxColumnConstraint copy length: newWidth)]
name "Answer the receiver's name." ^self subclassResponsibility
name: newName "Set the receiver's name to newName." self subclassResponsibility
table "Answer the receiver's table." ^self subclassResponsibility
table: newTable "Set the receiver's table to newTable." self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTableColumn <category>DDL generation</category>
putBasicDefinitionOn: stream "Emit a column definition expression for receiver on stream, minus nullness spec." stream nextPutAll: self name; space; nextPutAll: self dataType. (self maxColumnConstraint == nil or: [self maxColumnConstraint isZero]) ifFalse: [| mapping | mapping := self class contextClass dataTypeMappings detect: [:m | self dataType = m columnType] ifNone: nil. (mapping isNil or: [mapping isLongType not]) ifTrue: [stream nextPut: $(; nextPutAll: self printedWidth; nextPut: $)]]
putDefinitionOn: stream "Emit a column definition expression for receiver on stream." self putBasicDefinitionOn: stream. self putNullnessDefinitionOn: stream.
putNullnessDefinitionOn: stream "Put nullness definition on stream." stream nextPutAll: (self isNotNil ifTrue: [' not null'] ifFalse: [' null'])
</methods> <methods> Lens.LensDatabaseTableColumn <category>relationships</category>
relatedBy: token "The Falcon relationships dispatcher for this class" (#(#relatedRel) includes: token) ifTrue: [^self perform: token] ifFalse: [^super relatedBy: token]
relatedRel "This method implements the Falcon relationship 'relatedRel'" self table notNil ifTrue: [^IdentitySet with: self table] ifFalse: [^IdentitySet new]
stringKey: hints "The string to be used when I'm presented in a Falcon graph" ^'<', self name, '>'
</methods> <methods> Lens.LensDatabaseTableColumn <category>defaults</category>
defaultBLOBSize "Answer the default size to use for a Binary Large OBject." ^32700
</methods> <methods> Lens.LensDatabaseTableColumn <category>data model compatibility</category>
width: newWidth "Provided solely to load data models from VW2.0" self maxColumnConstraint: newWidth
</methods> <methods> Lens.LensDatabaseTableColumn <category>printing</category>
definition "Answer the DDL definition for the column." | stream | stream := WriteStream on: (String new: 128). self putDefinitionOn: stream. ^stream contents
displayString ^self name
printedWidth "Answer a printed representation of width, suppressing nils." ^(self maxColumnConstraint isNil or: [self maxColumnConstraint isZero]) ifTrue: [''] ifFalse: [self maxColumnLength asInteger printString]
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensDatabaseTableColumn <category>testing</category>
canQuery "Return whether we we can reference this column in a query" ^true
</methods> <methods> Lens.LensDatabaseTableColumn <category>converting</category>
internalName ^self class contextClass internalNameFor: self name
</methods> <methods> Lens.LensDatabaseTableColumn <category>private</category>
pickledIsNotNil "The default value for isNotNil on a newly created instance of the receiver is false and so there is no need to encode this condition in the data model specification. Answering nil arranges for the keyword-value pair to be omitted." ^self isNotNil ifTrue: [ true ] ifFalse: [ nil ]
</methods> <methods> Lens.LensDatabaseTableColumn <category>initialize-release</category>
initialize "Warning: the default cannot be changed from isNotNil: false without changing the encoding logic for pickling the data model in which this column might be represented." self isNotNil: false
</methods> <methods> Lens.LensDatabaseTableColumn class <category>accessing</category>
contextClass "Answer the name of the class which provides database context." self subclassResponsibility
</methods> <methods> Lens.LensDatabaseTableColumn class <category>private</category>
encodedAspects ^#()
</methods> <methods> Lens.LensDatabaseTableColumn class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensOperationSurrogate <category>accessing</category>
Attribute "Answer an attribute describing the receiver." ^LensStructureVariable new setValueType: type
Left "Answer the receiver's left-hand operand." ^left
Operator "Answer the receiver's operator." ^operator
Right "Answer the receiver's right-hand operand." ^right
</methods> <methods> Lens.LensOperationSurrogate <category>symbolic evaluation</category>
AccumulateAttributesIn: attributeSet "Accumulate all accessed attributes into attributeSet." left IsQS ifTrue: [left AccumulateAttributesIn: attributeSet]. right IsQS ifTrue: [right AccumulateAttributesIn: attributeSet]
</methods> <methods> Lens.LensOperationSurrogate <category>testing</category>
IsLogical "Answer whether the receiver is a logical operator." ^#(not & | and: or:) includes: operator
IsOperationSurrogate "Answer whether receiver is a operation surrogate." ^true
</methods> <methods> Lens.LensOperationSurrogate <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPut: Character space. self printTypeOn: stream
</methods> <methods> Lens.LensOperationSurrogate <category>private</category>
printTypeOn: stream stream nextPut: $(. (left class inheritsFrom: LensQuerySurrogate) ifTrue: [left printTypeOn: stream] ifFalse: [left printOn: stream]. stream nextPut: $ ; nextPutAll: operator; nextPut: $ . right == nil ifFalse: [(right class inheritsFrom: LensQuerySurrogate) ifTrue: [right printTypeOn: stream] ifFalse: [right printOn: stream]]. stream nextPut: $).
</methods> <methods> Lens.LensOperationSurrogate <category>initialize-release</category>
left: l operator: op right: r "Initialize the receiver's state." left := l. operator := op. right := r. type := left Type.
</methods> <methods> Lens.LensEncodedType <category>printing</category>
displayString | strm max | name notNil ifTrue: [^name copy]. strm := (String new: 128) writeStream. memberClass printOn: strm. max := self maxColumnConstraint. (max notNil and: [memberClass isVariableSize]) ifTrue: [ strm nextPut: $(. max printOn: strm. strm nextPut: $) ]. ^strm contents
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. self print: fieldType named: (#FieldType << #lensRuntime >> ' fieldType: ') asString on: stream. stream nextPut: $)
</methods> <methods> Lens.LensEncodedType <category>accessing</category>
computeFieldType "Answer a field type for an attribute whose value type is the receiver." ^fieldType
decodeSelector "Answer the receiver's decodeSelector." ^decodeSelector
decodeSelector: newDecodeSelector "Set the receiver's decodeSelector to newDecodeSelector." decodeSelector := newDecodeSelector
encodeSelector "Answer the receiver's encodeSelector." ^encodeSelector
encodeSelector: newEncodeSelector "Set the receiver's encodeSelector to newEncodeSelector." encodeSelector := newEncodeSelector
fieldType "Answer a field type for an attribute whose value type is the receiver." ^fieldType
fieldType: newFieldType "Set the receiver's fieldType to newFieldType." fieldType := newFieldType
maxColumnConstraint "Answer the receiver's maxColumnConstraint bound." ^(self isVariableSize or: [fieldType isVariableSize]) ifTrue: [fieldType maxColumnConstraint] ifFalse: [nil]
maxColumnConstraint: newMax "Set the receiver's fieldType's max to newMax." fieldType := fieldType copy maxColumnConstraint: newMax
</methods> <methods> Lens.LensEncodedType <category>private</category>
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. fieldType := fieldType decodeAsLiteralArray.
resolveReferencesIn: aDataModel "Get the data model's type instance which matches the receiver." fieldType notNil ifTrue: [fieldType := aDataModel resolveType: fieldType]. ^super resolveReferencesIn: aDataModel
</methods> <methods> Lens.LensEncodedType <category>testing</category>
isLensEncodedType "Answer whether receiver is encoded." ^true
</methods> <methods> Lens.LensEncodedType <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^fieldType recordTemplate
</methods> <methods> Lens.LensEncodedType <category>comparing</category>
isEquivalentTo: type "Answer whether receiver and type are semantically equivalent." self == type ifTrue: [^true]. ^(super isEquivalentTo: type) and: [fieldType isEquivalentTo: type fieldType]
</methods> <methods> Lens.LensEncodedType <category>type checking</category>
checkIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifTrue: [^self]. memberClass checkShallowIncludes: object. (memberClass checkLensSizeOf: object max: self maxColumnConstraint) ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#errTooLargeFor << #lens >> '<1p> is too large for <2p>') ]
</methods> <methods> Lens.LensEncodedType class <category>private</category>
encodedAspects ^#(#fieldType #encodeSelector #decodeSelector)
</methods> <methods> Lens.LensWeakRegistry <category>updating</category>
update: anAspectSymbol with: aParameter from: aSender "Finalize all finalizable entries of aSender." (aSender == keyArray and: [anAspectSymbol = #ElementExpired]) ifTrue: [self finalizeElements] ifFalse: [^self]
</methods> <methods> Lens.LensWeakRegistry <category>private</category>
changeCapacityTo: newCapacity "Change the size of the receiver to newCapacity. The receiver will be regrown if necessary to fit its contents." "Note that #rehash uses this -- don't optimize the case where the receiver doesn't change in size." accessLock critical: [| heirs newSelf | heirs := OrderedCollection new. keyArray removeDependent: self. newSelf := self copyEmpty: newCapacity. newSelf setAccessLock: accessLock. self keysAndValuesDo: [:key :value | key = 0 ifTrue: [heirs add: value] ifFalse: [newSelf noCheckAt: key put: value]]. self become: newSelf. keyArray breakDependents; addDependent: self. heirs do: [:heir | heir finalize]]
fixCollisionsFrom: index self shouldNotImplement
removeAndCleanUpAtIndex: index "Remove the key at the given index, relocating any following entries as needed." | location oldKey length oldLocation | keyArray at: index put: nil. self basicAt: index put: nil. tally := tally - 1. length := self basicSize. location := index. [location := location = length ifTrue: [1] ifFalse: [location + 1]. (oldKey := keyArray at: location) == nil or: [oldKey = 0]] whileFalse: [oldLocation := self findKeyOrNil: oldKey. location = oldLocation ifFalse: [self swap: location with: oldLocation]]. "If oldKey is = 0, then we bailed out unable to do the partial rehash." oldKey = 0 ifTrue: [self rehash]
setAccessLock: aRecursionLock accessLock := aRecursionLock
setTally "Initialize tally and other instance variables." super setTally. keyArray := WeakArray new: self basicSize. keyArray addDependent: self. accessLock := RecursionLock new
unlockedAt: key put: value "Set the value at key to be value." | index | key == nil ifTrue: [^self subscriptBoundsError: key]. index := self findKeyOrNil: key. (keyArray at: index) == nil ifTrue: [tally := tally + 1. keyArray at: index put: key]. self basicAt: index put: value. self fullCheck. ^value
</methods> <methods> Lens.LensWeakRegistry <category>copying</category>
copy " Answer another instance just like the receiver. " ^accessLock critical: [super copy]
postCopy super postCopy. keyArray addDependent: self. accessLock := RecursionLock new
</methods> <methods> Lens.LensWeakRegistry <category>dictionary enumerating</category>
associationsDo: aBlock "Evaluate aBlock for associations consisting of the receiver's keys and their values." accessLock critical: [super associationsDo: aBlock]
keysDo: aBlock "Evaluate aBlock for each of the receiver's keys." self keysAndValuesDo: [:key :value | key = 0 ifFalse: [aBlock value: key]]
</methods> <methods> Lens.LensWeakRegistry <category>accessing</category>
at: key ifAbsent: aBlock "Answer the value at key. If key is not found, evaluate aBlock." ^accessLock critical: [super at: key ifAbsent: aBlock]
at: key put: value "Set the value at key to be value." ^accessLock critical: [self unlockedAt: key put: value]
keyAtValue: value ifAbsent: exceptionBlock "Answer the key whose value equals the argument, value. If there is none, answer the result of evaluating exceptionBlock." ^accessLock critical: [super keyAtValue: value ifAbsent: exceptionBlock]
registryCritical: aBlock ^accessLock critical: aBlock.
</methods> <methods> Lens.LensWeakRegistry <category>dictionary removing</category>
removeKey: key ifAbsent: aBlock "Remove the key from the receiver. If the key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value associated with the key." ^accessLock critical: [super removeKey: key ifAbsent: aBlock]
</methods> <methods> Lens.LensWeakRegistry <category>finalization</category>
finalizeElements | heirs | heirs := OrderedCollection new. accessLock critical: [| deathMarker size | size := self basicSize. deathMarker := 1. [deathMarker ~= 0] whileTrue: [(deathMarker := keyArray indexOf: 0 replaceWith: nil startingAt: deathMarker stoppingAt: size) = 0 ifFalse: [heirs add: (self basicAt: deathMarker). keyArray at: deathMarker put: nil. self basicAt: deathMarker put: nil]]. self rehash]. heirs do: [:heir | heir finalize]. ^self
</methods> <methods> Lens.LensWeakRegistry <category>dictionary testing</category>
includesKey: key "Answer whether the receiver has a key equal to the argument, key." ^accessLock critical: [super includesKey: key]
</methods> <methods> Lens.LensWeakRegistry <category>enumerating</category>
do: aBlock "Evaluate aBlock with each of the receiver's elements as the argument." accessLock critical: [super do: aBlock]
keysAndValuesDo: aBlock "Evaluate aBlock with each of the receiver's key/value pairs as the arguments." accessLock critical: [super keysAndValuesDo: aBlock]
</methods> <methods> Lens.LensWeakCollection <category>accessing</category>
add: object "Add an object to the registry, and answer its index." "//A.R. This needs to change to follow the normal precident for the answer of an add: method." | index | index := array indexOf: nil replaceWith: object startingAt: 1 stoppingAt: array size. ^index == 0 ifTrue: [ array grow. self add: object] ifFalse: [ index]
indexOf: anElement "Answer the index of the first occurrence of anElement within the receiver. If the receiver does not contain anElement, answer 0." ^array indexOf: anElement
remove: object "Remove object from the registry." array indexOf: object replaceWith: nil startingAt: 1 stoppingAt: array size.
</methods> <methods> Lens.LensWeakCollection <category>private</category>
update: anAspectSymbol with: aParameter from: aSender "Nil out corpses." anAspectSymbol == #ElementExpired ifTrue: [ array nilAllCorpsesAndDo: [:item | ] ]
</methods> <methods> Lens.LensWeakCollection <category>enumerating</category>
do: block "Evaluate block on each non-nil and non-zombie item." array do: [:item | (item == nil or: [item == 0]) ifFalse: [ block value: item]]
select: block "Evaluate block with each of the values of the receiver as the argument. Collect into a new ordered collection only those items for which block evaluates to true." | newCollection | newCollection := OrderedCollection new. array do: [:item | (item == nil or: [item == 0 or: [(block value: item) not]]) ifFalse: [ newCollection add: item]]. ^newCollection
values "Answer all non-nil and non-zombie items." | values | values := OrderedCollection new. self do: [:item | values add: item]. ^values
</methods> <methods> Lens.LensWeakCollection <category>initialize-release</category>
initialize array := WeakArray new: 1. array addDependent: self.
</methods> <methods> Lens.LensWeakCollection <category>testing</category>
includes: anObject "Answer whether anObject is one of the receiver's elements." ^array includes: anObject
</methods> <methods> Lens.LensWeakCollection class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensSession <category>accessing</category>
password "Answer the password being (to be) used for this lens session." ^self connection password
password: aString "Set the password to be used for this ObjectLens session. If not set by default a dialog will be raised prompting for the password." self connection password: aString
serialNumberGeneratorBlock "Answer the block to be invoked if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation. The block is given an array with 4 entries (class name <Symbol>, variable <String>, qualified table name <String>, and the column name <String>) and must answer an appropriate value." ^serialNumberGeneratorBlock
serialNumberGeneratorBlock: aBlockClosure "Provide the block to be invoked if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation. The block is given an array with 4 entries (class name <Symbol>, variable <String>, qualified table name <String>, and the column name <String>) and must answer an appropriate value." serialNumberGeneratorBlock := aBlockClosure
username "Answer the username being (to be) used for this lens session." ^self connection username
username: aString "Set the username to be used for this lens session." self connection username: aString
</methods> <methods> Lens.LensSession <category>private-accessing</category>
cascadedAdds ^cascadedAdds
connection "Answer the receiver's connection." ^connection
containerFor: object "Answer one of the receiver's containers capable of containing object." ^self containerOf: object class
containerNamed: name "Answer the container with the given name." ^containers detect: [:container | name = container type name] ifNone: [self error: ((#errCannotFindContainer << #lens >> 'Cannot find container named <1s>') expandMacrosWith: name)]
containerOf: typeOrClass "Answer the container whose members are instances of type." ^typeOrClass isBehavior ifTrue: [ containers detect: [:container | container type memberClass == typeOrClass] ifNone: [self cantStore: typeOrClass]] ifFalse: [ containers at: typeOrClass ifAbsent: [self cantStore: typeOrClass]]
containers "Answer the receiver's containers." ^containers
dataModel "Answer the receiver's dataModel." ^dataModel
dataModel: newDataModel "Set receiver's dataModel" self setDataModel: newDataModel. connection := newDataModel databaseContext class connectionClass new. connection isolationLevel: lensTransactionPolicy underlyingIsolationLevel.
environment "Answer the environment being (to be) used for this lens session." ^self connection environment
environment: aString "Set the environment to be used for this lens session." self connection environment: aString
isActive: aBoolean "Setting this to true indicates that there are actual changes that have occurred within the transaction." isActive := aBoolean
keyChanges ^keyChanges
lensPolicy "Answer the receiver's lens policy." ^lensPolicy
lensPolicy: newPolicy "Set the receiver's lens policy." self hasDatabaseConnection ifTrue: [ LensSession cannotChangePolicyWhileConnectedSignal raiseWith: (Array with: self) ]. lensPolicy := newPolicy.
lensTransactionPolicy "Answer the receiver's transaction policy." ^lensTransactionPolicy
lensTransactionPolicy: newPolicy "Set the receiver's transaction policy." self hasDatabaseConnection ifTrue: [ LensSession cannotChangePolicyWhileConnectedSignal raiseWith: (Array with: self) ]. lensTransactionPolicy := newPolicy. connection notNil ifTrue: [ connection isolationLevel: newPolicy underlyingIsolationLevel ].
nonBaseContainers "Answer the registry of non-base containers." ^nonBaseContainers
objectOf: aType withId: id "Answer the object of aType with the given id." | container gd object | "Objects can't have a nil or nils for the externalId" id isNilExternalId ifTrue: [^nil]. "Look in aType's container to see if an entry with externalId of id exists" container := self containerOf: aType. gd := container privateCache at: id ifAbsent: []. "If there is no entry, or it refers to an object no longer in the image..." (gd isNil or: [(object := gd object) isNil]) ifTrue: [ "Make a new proxy." object := LensProxy externalId: id lensContainer: container. "Make a new LGD and register the proxy in the container." LensGlobalDescriptor new register: object externalId: id lensContainer: container]. ^object
removedObjects ^removedObjects
setDataModel: newDataModel "Minimal initialization when setting data model." dataModel := newDataModel. lensPolicy isNil ifTrue: [ lensPolicy := newDataModel lensPolicy ]. lensTransactionPolicy isNil ifTrue: [ lensTransactionPolicy := newDataModel lensTransactionPolicy ].
</methods> <methods> Lens.LensSession <category>private-cache management</category>
activateDelayedTransaction "Post all unposted operations. Switch to pessimistic locking mode." delayingOperations ifTrue: [connection begin. delayingOperations := false. savingLastCommitedVersions := false. self postPendingOperations. self hasPostponedOperations ifFalse: [self validatePendingLocks]].
addPendingLock: object "Add a pendingLock. Ignore if is already included. " pendingLocks add: object.
addPendingOperation: object "Add a pendingOperation. Ignore if is already included. " (pendingOperationsIndex includesKey: object) ifTrue: [^self]. pendingLocks remove: object ifAbsent: nil. pendingOperations add: object. pendingOperationsIndex at: object put: pendingOperations size.
cantStore: typeOrClass "Signal that can't store members or instances of typeOrClass." self class cannotStoreTypeOfObjectSignal raiseWith: (Array with: self with: typeOrClass) errorPattern: (#incompatibleMembers << #lens >> '<1p> can''t store members of <2p>')
disconnectContainers "Terminate operation on the receiver's containers." nonBaseContainers values do: [ :container | container disconnect ]. containers values do: [ :container | container disconnect ]. self initializeContainers
externalIdOf: object inContainerOf: type "Answer the externalId of object in the receiver session. Add the object to the named container if object is temporary." | gd | ^object isNil ifTrue: [nil] ifFalse: [object isProxy ifTrue: [object externalId] ifFalse: [((gd := object globalDescriptor) == nil or: [gd objectIsRemoved]) ifFalse: [gd externalId] ifTrue: [| container | container := self containerOf: type. container add: object. object globalDescriptor externalId]]]
flushAllObjects "Flush all objects owned by receiver." containers do: [:container | container transporter removeDataWhere: [:x | true]].
initializeContainers "Initialize the container holding variables." nonBaseContainers := LensWeakCollection new. containers := IdentityDictionary new.
pauseContainers "Suspend operation on the receiver's containers." nonBaseContainers do: [ :container | container disconnect ]. containers do: [ :container | container disconnect ]
pendingOperationsRemove: object ifAbsent: exceptionBlock "Remove the object from the sequence of pendingOperations. Return object or exceptionBlock value" | index | (index := pendingOperationsIndex removeKey: object ifAbsent: [nil]) notNil ifTrue: [index == pendingOperations size ifTrue: [pendingOperations removeLast] ifFalse: [pendingOperations at: index put: nil]. ^object] ifFalse: [^exceptionBlock value]
postPendingOperationOn: object "Post pending operations to the associated record." | gd | gd := object globalDescriptor. gd == nil ifTrue: [self add: object] ifFalse: [gd objectIsPendingRemoval ifTrue: [self remove: object] ifFalse: [gd postUpdateOf: object ]]
postPendingOperations "Post all pending operations to receiver's contents." | localPendingOperations | delayingOperations ifTrue: [^self]. localPendingOperations := pendingOperations select: [ :obj | obj notNil]. self resetPendingOperations. 1 to: localPendingOperations size do: [ :operationsIndex | | object ex exResponse| object := localPendingOperations at: operationsIndex. [ex := self exceptionFrom: [self postPendingOperationOn: object]. ex notNil ifTrue: [ exResponse := self class errorWhilePostingSignal raiseRequestWith: (LensExceptionInfo on: object with: ex). exResponse == #postpone ifTrue: [postponedOperations add: object. "In case the object was modified while handling the exception - remove it from pending list." self removePendingOperation: object] ifFalse: [(exResponse isNil or: [exResponse == #revert]) ifTrue: [ | gd | gd := object globalDescriptor. gd notNil ifTrue: [gd rollback]. "In case the object was modified while handling the exception - remove it from pending list." self removePendingOperation: object] ifFalse: [exResponse == #retry ifTrue: [self addPendingOperation: object] ifFalse: [LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#invalidProceedOption << #lens >> 'Invalid proceed option.')]]. "Post any unposted updates done while handling exception." self postPendingOperations]]] ifCurtailed: [operationsIndex to: localPendingOperations size do: [:i | self addPendingOperation: (localPendingOperations at: i)]]].
removePendingOperation: object "Remove the object from the sequence of pendingOperations." | index | (index := pendingOperationsIndex removeKey: object ifAbsent: [nil]) notNil ifTrue: [ index == pendingOperations size ifTrue: [ pendingOperations removeLast] ifFalse: [ pendingOperations at: index put: nil]]
resetCascadedAdds "Reset the collection of cascadedAdds to be empty." cascadedAdds := IdentitySet new
resetKeyChanges "Reset the collection of keyChanges to be empty." keyChanges := IdentityDictionary new
resetPendingLocks "Reset the collection of pendingLocks to be empty." pendingLocks := IdentitySet new
resetPendingOperations "Reset the collection of pendingOperations to be empty." pendingOperationsIndex := IdentityDictionary new. pendingOperations := OrderedCollection new: 4.
resetPostponedOperations "Reset the collection of postponedOperations to be empty." postponedOperations := OrderedCollection new.
resetRemovedObjects "Reset the collection of removedObjects to be empty." removedObjects := IdentitySet new
retryPostponedOperations "Retry postponed operations" postponedOperations do: [ :object | self addPendingOperation: object]. self resetPostponedOperations. self postPendingOperations. self hasPostponedOperations ifFalse: [self validatePendingLocks].
returnObjectsToContainers "Reconnect all objects to their caches." containers do: [ :cont | cont resume ]. nonBaseContainers do: [ :cont | cont resume ]. LensGlobalDescriptor descriptorsIn: self do: [:gd | | cont obj | cont := self containerFor: (obj := gd object). obj isProxy ifTrue: [ obj lensContainer: cont ]. gd lensContainer: cont. gd lensContainer register: gd at: gd externalId ]
revertAllChildrenSets "Revert all children sets in the receiver's cache." containers do: [:container | container revertAllChildrenSets]
sequencePendingOperation: object "Set the pendingOperation to be the next operation to be performed." | index | (index := pendingOperationsIndex at: object ifAbsent: [nil]) notNil ifTrue: [ index == pendingOperations size ifFalse: [ pendingOperations at: index put: nil. "Remove old operation" pendingOperations add: object. pendingOperationsIndex at: object put: pendingOperations size]] ifFalse:[ pendingOperations add: object. pendingOperationsIndex at: object put: pendingOperations size].
validatePendingLocks "Validate all the locks on objects in pendingLocks." [pendingLocks do: [:object | | ex | ex := self exceptionFrom: [object globalDescriptor lensContainer transporter validatePendingLockOn: object]. ex notNil ifTrue: [self class errorWhilePostingSignal raiseRequestWith: (LensExceptionInfo on: object with: ex)]]] ensure: [self resetPendingLocks]
</methods> <methods> Lens.LensSession <category>cache management</category>
refresh: anObject "Refresh anObject from the database if it is persistent." | gd lensContainer objectLens | "Skip if a proxy or transient." (anObject isProxy or: [(gd := anObject globalDescriptor) isNil or: [gd objectIsRemoved]]) ifTrue: [ ^self ]. lensContainer := gd lensContainer. objectLens := lensContainer lensSession. gd refresh: anObject. lensContainer transporter objectAtId: gd externalId. "replace children sets with new collection proxies to force refreshing when next accessed." lensContainer type variablesDo: [ :var | var isChildrenPointer ifTrue: [ anObject instVarAt: var instVarIndex put: (LensCollectionProxy query: var childrenSetQuery lensContainer: (objectLens containerOf: var targetValueType) parent: anObject) ] ]
refreshAllObjects "Refresh all persistent objects in the receiver's cache. This will cause all the active mapped objects to be refetched from the database. This operation may potentially take a long time" self checkRead. containers do: [:container | container refreshAllObjects]
revert: anObject "Revert anObject to a proxy if it is persistent." | gd | (gd := anObject globalDescriptor) == nil ifFalse: [gd revert]
revertAllObjects "Revert all persistent objects in the receiver's cache. Reverting the mapped objects will free some memory because they will be replaced by proxies. Subsequent operations on a mapped object will cause it to be fetched from the database" LensGlobalDescriptor descriptorsIn: self do: [:gd | gd revert ].
revertDiscardingUnpostedUpdates: anObject "Revert object to a proxy if persistent. Any unposted updates will be discarded." | gd | (gd := anObject globalDescriptor) == nil ifFalse: [gd revertDiscardingUnpostedUpdates]
</methods> <methods> Lens.LensSession <category>private-collection protocol</category>
match: template "Answer the set of objects in the receiver that match template." ^(self containerFor: template) match: template
</methods> <methods> Lens.LensSession <category>testing</category>
delayingOperations "Answer whether we are currently delaying until commit time the posting of updates." ^delayingOperations.
hasPostponedOperations "Answer whether receiver has any postponed operations pending." ^postponedOperations size > 0
isActive "Answer whether receiver is in a transaction with changes." ^isActive or: [pendingOperations size > 0]
isDisconnected "Answer whether receiver has been disconnected." ^(OpenLensSessions includes: self) not
isInTransaction "Answer whether receiver is in a transaction." ^delayingOperations or: [connection inTransactionMode]
isPaused "Answer whether receiver has been paused." ^(OpenLensSessions includes: self) and: [ self hasDatabaseConnection not ]
savingLastCommitedVersions "Answer whether we should make a copy of row objects before updating." ^savingLastCommitedVersions.
</methods> <methods> Lens.LensSession <category>connection management</category>
connect "Connect the session with the dbms. If a password is required, it must have previously been supplied. Answer nil if the connection attempt fails or self if it succeeds." ^self connect: self password
connect: aPasswordOrNil "Connect the session with the dbms. aPasswordOrNil should be used in the ExternalDatabaseConnection>>connect: send. Answer nil if the connection attempt fails or self if it succeeds." self isDisconnected ifFalse: [ ^LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#connectAttemptWhenConnected << #lens >> 'Attempting to connect when not disconnected.')]. self isDataModelChecked. (self authenticate: aPasswordOrNil) isNil ifTrue: [^nil]. OpenLensSessions add: self. self dataModel mappedTypesDo: [ :type | | container | container := LensBaseContainer new. containers at: type put: container. container type: type lensSession: self ]. self resetTransactionState: false. self dataModel databaseContext postConnectIn: self
disconnect "Disconnect receiver and release its resources." "Don't fight it." self isDisconnected ifTrue: [ ^self ]. "Are we already part way done?" self isPaused ifFalse: [ "Dispose of the transaction." Signal noHandlerSignal handle: [ :ex | (ex parameter signal inheritsFrom: Object controlInterruptedSignal) ifTrue: [ ex reject ]. ex return ] do: [ connection notNil ifTrue: [ self terminateTransaction ] ]. "disconnect and drop connections, this will attempt rollback if the above didn't do anything." Signal noHandlerSignal handle: [ :ex | (ex parameter signal inheritsFrom: Object controlInterruptedSignal) ifTrue: [ ex reject ]. ex return ] do: [ connection notNil ifTrue: [ connection disconnect ] ] ]. "if objects don't survive closure, revert them" lensPolicy revertPersistentObjectsOnDisconnect ifTrue: [ self revertAllObjects ]. "unregister all session's objects" LensGlobalDescriptor removeObjectsIn: self. "unregister self as a session" OpenLensSessions remove: self. "release all containers" Signal noHandlerSignal handle: [ :ex | (ex parameter signal inheritsFrom: Object controlInterruptedSignal) ifTrue: [ ex reject ]. ex return ] do: [ self disconnectContainers ]
pause "Disconnect receiver from the database and retain identity information so database objects may be used after resuming." self hasDatabaseConnection ifFalse: [ ^LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#errPauseAttemptedNotConnected << #lens >> 'Attempting to pause when not connected.') ]. self terminateTransaction. connection disconnect. self pauseContainers
resume "Reconnect receiver to database after a pause." ^self resume: self password
resume: aPasswordOrNil "Reactivate receiver after a pause or return from snapshot. aPasswordOrNil should be used in the ExternalDatabaseConnection > connect: send. Answer nil if the connection attempt fails or self if it succeeds." self isPaused ifFalse: [^LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#errResumeWhenNotPaused << #lens >> 'Attempting to resume when not paused.')]. (self authenticate: aPasswordOrNil) isNil ifTrue: [^nil]. self returnObjectsToContainers. self checkSerializable. self dataModel databaseContext postConnectIn: self
</methods> <methods> Lens.LensSession <category>private-connection management</category>
authenticate: aPasswordOrNil "Make the actual connection to the database server and answer self if it succeeded or nil if the user cancelled the request for password, or raise an exception if there was an error." | pw first signal | "Make sure that we have a password, but don't store it in the connection if it isn't there already." pw := aPasswordOrNil. pw isNil ifTrue: [ pw := UISettings preferenceFor: #dbDevPassword ]. self username isNil ifTrue: [self username: (UISettings preferenceFor: #dbDevUsername)]. first := true. "This is written this way because the system locks up if you try to place a 'self halt' anywhere inside the handle: expression, and I'm too old, too wise, and too impatient to write code without a debugger." [ Signal noHandlerSignal handle: [:ex | "Something bad happened during the connection attempt and nobody was there for it." signal := ex parameter signal. (ex signal inheritsFrom: ExternalDatabaseConnection externalDatabaseErrorSignal) ifTrue: [ex return] ifFalse: [ex reject] ] do: [ "Connect to the dbms." self connection connect: pw. ^self ]. signal == connection class authenticationFailureSignal ifTrue: [ first ifTrue: [ first := false ] ifFalse: [ Dialog warn: (#badNameOrPassword << #lens >> 'Unable to connect: bad user name or password') ] ] ifFalse: [ | str | str := ((#unableToConnectError << #lens >> 'Unable to connect to database server.<n><1s>') expandMacrosWith: signal errorString). Dialog warn: str. ^nil ]. pw := self authenticationDialog: pw. pw isNil ifTrue: [^nil] ] repeat
authenticationDialog: aPasswordOrNil "Prompt the user for confirmation of the username and a password." | sd b usernameHolder passwordHolder | sd := SimpleDialog new. b := sd builder. usernameHolder := BufferedValueHolder subject: ((AspectAdaptor forAspect: #username) subject: self) triggerChannel: sd accept. b aspectAt: #usernameHolder put: usernameHolder. passwordHolder := aPasswordOrNil asValue. b aspectAt: #passwordHolder put: passwordHolder. ^(sd openFrom: (UISpecification from: self class connectSpec)) ifTrue: [passwordHolder value] ifFalse: [nil]
checkChange "Make sure that we're in a proper state to make changes to the database." self checkConnected. self isInTransaction ifFalse: [ lensPolicy onUntransactedChange == #complain ifTrue: [ LensSession untransactedOperationSignal raiseWith: (Array with: self)]. lensPolicy onUntransactedChange == #beginTransaction ifTrue: [ self begin ] ]
checkConnected "If receiver is paused, attempt to resume." self isDisconnected ifTrue: [ ^LensSession sessionIsDisconnectedSignal raiseRequestWith: (Array with: self) ]. self isPaused ifTrue: [ lensPolicy onUnconnectedOperation == #resume ifTrue: [ (self resume) isNil ifTrue: [LensSession doNotProceedSignal raiseRequestWith: (Array with: self)]] ifFalse: [ LensSession sessionIsPausedSignal raiseRequestWith: (Array with: self)]]
checkLocking: isLocking "If operation is locking, begin transaction if not in one and answer true. Otherwise, answer whether policy specifies locking." ^isLocking ifTrue: [ self isInTransaction ifFalse: [self begin]. true] ifFalse: [ "lensPolicy transactionsAreSerializable" false]
checkRead "Check if read should start a transaction, complain, or proceed." self checkRead: true
checkRead: postFlag "Check if read should start a transaction, complain, or proceed. postFlag should be true unless doing this as part of the query to get a single row lock." self checkConnected. self isInTransaction ifFalse: [ lensPolicy onUntransactedRead == #complain ifTrue: [ LensSession untransactedOperationSignal raiseWith: (Array with: self with: #read)]. lensPolicy onUntransactedRead == #beginTransaction ifTrue: [ self begin]]. (postFlag and: [delayingOperations not]) ifTrue: [ self postPendingOperations ]
checkSerializable lensPolicy transactionsAreSerializable ifTrue: [self revertAllObjects]
install "On image restart, each LensSession is effectively paused and must be reactivated explicitly." self pauseContainers. self changed: #install
</methods> <methods> Lens.LensSession <category>collection protocol</category>
add: object "Add anObject to the receiver's appropriate container, thereby making it persistent. Answer anObject. Do nothing if anObject is already contained in the receiver. Raise LensSession > cannotStoreTypeOfObjectSignal if no appropriate container can be found. Raise LensContainer > objectInAnotherLensContainerSignal if anObject is already contained in another session's container." delayingOperations ifTrue: [| gd | ((gd := object globalDescriptor) notNil and: [gd objectIsPendingRemoval]) ifTrue: [gd resetPendingRemoval. gd objectHasUnpostedUpdates ifFalse: [self removePendingOperation: object]] ifFalse: [self addPendingOperation: object]. ^self]. self resetCascadedAdds. [^(self containerFor: object) add: object] ensure: [self resetCascadedAdds]
addAll: aCollection "Include all the elements of aCollection as the receiver's elements. Answer aCollection." aCollection do: [:each | self add: each]. ^aCollection
remove: anObject "Make anObject temporary if it is persistent." ^self remove: anObject ifAbsent: [Object notFoundSignal raise]
remove: anObject ifAbsent: exceptionBlock "Remove anObject as one of the receiver's elements. If anObject isn't in the receiver, answer the result of evaluating anExceptionBlock. Otherwise, answer anObject." | gd | gd := anObject globalDescriptor. delayingOperations ifTrue: [^gd == nil ifTrue: [self pendingOperationsRemove: anObject ifAbsent: exceptionBlock] ifFalse: [gd objectIsPendingRemoval ifTrue: [exceptionBlock value] ifFalse: [self addPendingOperation: anObject. gd markPendingRemoval. (savingLastCommitedVersions and: [gd lastCommitedVersion isNil]) ifTrue: [gd saveLastCommitedVersionOf: anObject]. anObject]]]. ^gd == nil ifFalse: [gd lensContainer remove: anObject ifAbsent: exceptionBlock] ifTrue: [exceptionBlock value]
</methods> <methods> Lens.LensSession <category>initialize-release</category>
initialize "Initialize the receiver." self initializeContainers. self resetCascadedAdds. self resetRemovedObjects. self resetPendingOperations. self resetPostponedOperations. self resetPendingLocks. self resetKeyChanges
</methods> <methods> Lens.LensSession <category>tracing</category>
traceFrom: aTracer aTracer raiseInvalidTraceSignalOn: self
</methods> <methods> Lens.LensSession <category>private-testing</category>
canAdd: object "Answer whether receiver will allow adding object." self class cannotStoreTypeOfObjectSignal handle: [:ex | ^false] do: [self containerFor: object]. ^true
hasDatabaseConnection "Answer whether receiver is connected to database." ^connection notNil and: [connection isConnected]
isDataModelChecked "Check if the Data Model was checked against the database. It may be dangerous to run an unchecked model" self dataModel isInstalled ifFalse: [self class inappropriateOperationSignal raiseWith: (Array with: self dataModel) errorPattern: (#notCompletelyChecked << #lens >> '<1p><n>Has not been completely checked against the database')]
</methods> <methods> Lens.LensSession <category>printing</category>
printNameOn: stream "Print the receiver's name on stream." | sessionId | self dataModel printNameOn: stream. stream nextPut: $:. (sessionId := OpenLensSessions indexOf: self) == 0 ifTrue: [stream nextPutAll: (#closed << #lensRuntime >> 'closed') asString] ifFalse: [sessionId printOn: stream]
printOn: stream "Briefly print the receiver on stream." super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensSession <category>private-transaction management</category>
resetTransactionState: inTransaction "initialize the transaction state to either the start of a transaction or the end of a transaction" isActive := false. delayingOperations := inTransaction and: [lensTransactionPolicy delayUpdatesUntilCommit]. savingLastCommitedVersions := lensTransactionPolicy verifyAtPostPolicy ~~ #never.
runTerminateTransactionDialog "Run the standard terminateTransaction dialog." | str | str := (str := self printString) copyFrom: 3 to: str size. (Dialog choose: ((#isActiveCommitOrRollback << #lens >> '<1s> has an active transaction. Commit the transaction or roll it back?') expandMacrosWith: str) labels: (Array with: (#Commit << #lens >> 'Commit') with: (#Rollback << #lens >> 'Rollback')) values: #(commit rollback) default: #commit) == #commit ifTrue: [self commit] ifFalse: [self rollback]
terminateTransaction "If receiver's transaction is active, notify dependent in the hopes that they will terminate the transaction cleanly and not be surprised by anything we do here. If the transaction is not terminated, we deal with it here. It is not acceptable to exit this method in transaction mode." "Punch out right away if not in transaction." self isInTransaction ifFalse: [ ^self ]. "Give dependents a chance." self changed: #terminateTransaction. "If any uncommitted changes remain; give user the choice." self isActive ifTrue: [ self runTerminateTransactionDialog ]. "If we're still in transaction mode, we need out but it doesn't matter how." self isInTransaction ifTrue: [ self rollback ]
</methods> <methods> Lens.LensSession <category>transaction management</category>
begin "Begin a transaction." self isInTransaction ifTrue: [LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#alreadyInTransaction << #lens >> 'Attempting to begin a transaction when already in one.')]. ExternalDatabaseConnection traceLevel > 0 ifTrue: [ExternalDatabaseConnection trace: ((#x1sTransactionBegun << #lensRuntime >> '<1s> transaction begun.') expandMacrosWith: self printString)]. self changed: #preBegin. self resetTransactionState: true. delayingOperations ifFalse: [connection begin]. self checkSerializable. self changed: #postBegin
commit "Commit the current transaction." self isInTransaction ifFalse: [ LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#errCommitNotInTransaction << #lens >> 'Attempting to commit when not in a transaction')]. self changed: #preCommit. "Get all changes recorded in the database." self postPendingOperations. self activateDelayedTransaction. [self hasPostponedOperations] whileTrue: [self retryPostponedOperations]. "Do this early so that if there are any problems we retain all of the other state." connection commit. "We've lost interest (they're permanent now)." self resetKeyChanges. "For each removed object, get it out of the registry to complete the removal." LensGlobalDescriptor removeAll: removedObjects. self resetRemovedObjects. "Go through each container." containers do: [:cont | cont commit]. self resetTransactionState: false. ExternalDatabaseConnection traceLevel > 0 ifTrue: [ExternalDatabaseConnection trace: ((#x1sTransactionCommitted << #lensRuntime >> '<1s> transaction committed.') expandMacrosWith: self printString)]. self checkSerializable. self changed: #postCommit
rollback "Rollback the current transaction." self isInTransaction ifFalse: [ LensSession inappropriateOperationSignal raiseWith: (Array with: self) errorPattern: (#errRollbackWhenNotInTransaction << #lens >> 'Attempting to rollback when not in a transaction')]. self changed: #preRollback. "Do this early so that if there are any problems we retain all of the other state." connection rollback. "Remove any added objects that would be clobbered by reregistering a removed row." self keyChanges copy keysAndValuesDo: [ :gd :oldId | | conflict | (conflict := gd lensContainer privateCache at: oldId ifAbsent: [nil]) notNil ifTrue: [ "If the object was added in this transaction, it needs to go away." conflict objectIsAdded ifTrue: [ conflict unregister ] ] ]. "Reset the key of any object which changed in this transaction." self keyChanges keysAndValuesDo: [ :gd :oldId | "The key of gd was changed in this transaction, set it back to the original value. We don't need to do anything to the object itself as it will shortly be reverted to a proxy." gd externalId: oldId ]. self resetKeyChanges. "Return any removed objects to the caches." self removedObjects do: [ :gd | gd lensContainer register: gd at: gd externalId ]. self resetRemovedObjects. "Go through each container." containers do: [:cont | cont rollback]. "All of these objects have been reverted to proxies so we don't need this any more." self resetPendingOperations. self resetPostponedOperations. self resetTransactionState: false. ExternalDatabaseConnection traceLevel > 0 ifTrue: [ExternalDatabaseConnection trace: ((#x1sTransactionRolledBack << #lensRuntime >> '<1s> transaction rolled back.') expandMacrosWith: self printString)]. self checkSerializable. self changed: #postRollback
</methods> <methods> Lens.LensSession <category>utilities</category>
exceptionFrom: doBlock "Evaluate doBlock, which is expected to take no arguments but which will engage in commerce with the ObjectLens. If either an unhandled externalDatabaseInformationSignal happens or any other externalDatabaseErrorSignal happens evaluate return the exception; otherwise return nil." ^Signal noHandlerSignal handle: [:ex | (ex parameter signal inheritsFrom: connection class externalDatabaseInformationSignal) ifTrue: [ex returnWith: ex parameter]. ex reject] do: [connection class externalDatabaseErrorSignal handle: [:ex | (ex signal inheritsFrom: ExternalDatabaseConnection externalDatabaseInformationSignal) ifTrue: [ex reject]. ex returnWith: ex] do: [doBlock value. nil]]
</methods> <methods> Lens.LensSession class <category>signal access</category>
cannotChangePolicyWhileConnectedSignal "Answer the signal used to complain about changing policy while connected." ^CannotChangePolicyWhileConnected
cannotQueryLocalVariableSignal ^LensContainer cannotQueryLocalVariableSignal
cannotStoreTypeOfObjectSignal "Answer the signal used to indicate that a container cannot be found." ^CannotStoreTypeOfObject
cannotUpdateSignal "Answer the signal raised when attempting to perform an illegal update." ^LensContainer cannotUpdateSignal
doNotProceedSignal "Answer the signal employed for user abort of current operations." ^DoNotProceed
errorWhilePostingSignal "Answer the signal used to complain about errors while posting." ^ErrorWhilePosting
inappropriateOperationSignal "Answer a signal that is raised when an inappropriate operation is requested." ^InappropriateOperation
invalidAggregateFunctionSignal "Answer the signal indicating invoking an undefined aggregate function." ^LensContainer invalidAggregateFunctionSignal
invalidPredicateSignal ^LensContainer invalidPredicateSignal
objectInAnotherLensContainerSignal ^LensContainer objectInAnotherLensContainerSignal
objectNotPersistentSignal ^LensContainer objectNotPersistentSignal
objectNotUniquelyIdentifiedSignal "Answer the signal indicating a second row/object has been discovered with the same identity as another row. The only way to maintain integrity is to rollback the transaction and check the table to ensure that it is enforcing uniqueness of the primary key." ^LensContainer objectNotUniquelyIdentifiedSignal
optimisticConflictDetectedSignal "Answer a signal that is raised when an optimistic lock conflict is detected." ^OptimisticConflictDetected
overlappingVariablesValueConflictSignal "Answer the signal used to indicate that overlapping variables have been set to conflicting values." ^OverlappingVariablesValueConflict
queryErrorSignal ^LensContainer queryErrorSignal
rowForObjectNotFoundSignal "Answer the signal used to indicate that an object or proxy does not have a corresponding row in the database." ^RowForObjectNotFound
serialNumberRequestSignal "Answer the proceedable signal raised if a serial number needs to be generated and the data model for the receiver is for a dialect which does not include serial number generation and the LensSession does not have a serialNumberGeneratorBlock. The signal's parameter has an array with 4 entries (class name <Symbol>, variable <String>, qualified table name <String>, and the column name <String>) and must proceedWith: an appropriate value." ^SerialNumberRequest
sessionIsDisconnectedSignal "Answer a signal that is raised when an operation is requested and the session is disconnected." ^LensSessionIsDisconnected
sessionIsPausedSignal "Answer a signal that is raised when an operation is requested that requires a connection, the session is paused, and the policy doesn't specify auto-resume." ^LensSessionIsPaused
triggeringWhenNotOpenSignal "Answer a signal that is raised when attempting to trigger a proxy and the session is closed or disconnected." ^TriggeringWhenNotOpen
typeViolationSignal ^LensType typeViolationSignal
unhandledCircularReferenceSignal "Answer a signal that is raised when trying to insert objects with circular references that include notNil references" ^UnhandledCircularReference
untransactedOperationSignal "Answer a signal that is raised when an operation is requested that should be done inside a transaction, the session isn't in a transaction, and the policy doesn't specify auto-begin." ^UntransactedOperation
</methods> <methods> Lens.LensSession class <category>user interaction</category>
complain: message "Open a simple notifier box dialog with the message, terminating the current operation when the user acknowledges. Sent from methods on classes within the Lens proper (from the tool layer, the same message is sent to DatabaseApplicationModel)." Dialog warn: message. self doNotProceedSignal raise
complain: message proceed: shouldProceed "Open a simple notifier box dialog with the message. If shouldProceed is false, terminate the current operation when the user acknowledges." Dialog warn: message. shouldProceed ifFalse: [ self doNotProceedSignal raise ]
</methods> <methods> Lens.LensSession class <category>private</category>
isVisualStartable "Used by UIFinder to divine that the application will respond to Start" ^false
privateOn: aDataModel "This variation exists for a specialized use which guarantees that the new instance of the receiver will NEVER be asked to connect." | ls | ls := self basicNew initialize. ls setDataModel: aDataModel. ^ls
</methods> <methods> Lens.LensSession class <category>class initialization</category>
initialize "LensSession initialize" OpenLensSessions := LensWeakCollection new. ExternalDatabaseConnection removeDependent: self. ExternalDatabaseConnection addDependent: self. self initializeExceptionClasses. "force reinitialization of lens policy so will pick up latest signals" LensPolicy initialize.
initializeAllSignals self initializeExceptionClasses. LensContainer initializeExceptionClasses. LensType initializeExceptionClasses
initializeExceptionClasses "Initialize related exception classes." "initialize non-proceedable exception classes" CannotStoreTypeOfObject notifierString: (#cannotStoreThisType << #lens >> 'Cannot store objects of this type'); nameClass: self message: #cannotStoreTypeOfObjectSignal. OverlappingVariablesValueConflict notifierString: (#overlappingVariablesValueConflict << #lens >> 'Overlapping variables have been set to conflicting values.'); nameClass: self message: #overlappingVariablesValueConflictSignal. TriggeringWhenNotOpen notifierString: (#triggeringWhenNotOpen << #lens >> 'Attempting to trigger proxy when not open'); nameClass: self message: #triggeringWhenNotOpenSignal. RowForObjectNotFound notifierString: (#rowForObjectNotFound << #lens >> 'Row for object or proxy was deleted, or its key changed.'); nameClass: self message: #rowForObjectNotFoundSignal. OptimisticConflictDetected notifierString: (#optimisticConflictDetectedSignal << #lens >> 'Row for object has been modified by another process.'); nameClass: self message: #optimisticConflictDetectedSignal. "initialize proceedable signals" InappropriateOperation notifierString: (#inappropriateOperation << #lens >> 'Operation is unnecessary or inappropriate.'); nameClass: self message: #inappropriateOperationSignal. LensSessionIsDisconnected notifierString: (#lensSessionIsDisconnected << #lens >> 'Attempting operation when session is disconnected'); nameClass: self message: #lensSessionIsDisconnectedSignal. ErrorWhilePosting notifierString: (#errorWhilePosting << #lens >> 'An error occured while posting updates'); nameClass: self message: #errorWhilePostingSignal. LensSessionIsPaused notifierString: (#LensSessionIsPaused << #lens >> 'Attempting operation when session is paused'); nameClass: self message: #lensSessionIsPausedSignal. SerialNumberRequest notifierString: (#serialNumberRequested << #lens >> 'The next number in the sequence named in the parameter is needed.'); nameClass: self message: #serialNumberRequestSignal. UntransactedOperation notifierString: (#untransactedOperation << #lens >> 'Attempting operation when not in transaction'); nameClass: self message: #untransactedOperationSignal. CannotChangePolicyWhileConnected notifierString: (#cannotChangePolicyWhileConnected << #lens >> 'Cannot change policy while connected'); nameClass: self message: #cannotChangePolicyWhileConnectedSignal. UnhandledCircularReference notifierString: (#unhandledCicularReference << #lens >> 'Cannot handle circular references with ''notNil'' references'); nameClass: self message: #unhandledCircularReferenceSignal. DoNotProceed notifierString: (#doNotProceed << #lens >> 'Do not proceed operation'); nameClass: self message: #doNotProceedSignal
obsolete "Receiver is being removed from the system." ExternalDatabaseConnection removeDependent: self. super obsolete
</methods> <methods> Lens.LensSession class <category>updating</category>
update: reason with: aParameter from: aSender "LensSessions may not be in a transaction when the image snapshots or quits. The terminateTransaction message guarantees that this is the case. When an image is restarted, each LensSession is notified." aSender == ExternalDatabaseConnection ifTrue: [ (reason == #aboutToSnapshot or: [reason == #aboutToQuit]) ifTrue: [ OpenLensSessions values do: [ :session | session terminateTransaction ] ]. reason == #returnFromSnapshot ifTrue: [ OpenLensSessions values do: [ :session | session install ] ] ]
</methods> <methods> Lens.LensSession class <category>instance creation</category>
on: aDataModel | ls | aDataModel databaseContext class connectionClass == nil ifTrue: [ Dialog warn: (#requiredDatabaseKit << #lens >> 'The required Database Connect Kit must be present in the image.'). ^nil ]. ls := self basicNew initialize. ls dataModel: aDataModel. ls username: aDataModel databaseContext username. ls environment: aDataModel databaseContext environment. ls resetTransactionState: false. ^ls
</methods> <methods> Lens.LensDatabaseContext <category>accessing</category>
catalogDataModel "Answer a data model for accessing the receiver's database's catalog." "Make a shallow copy of the receiver's global catalog data model so that we can replace the context to be that of the receiver. Use setDatabaseContext: since no specialized initialization is required (or permissible)." ^self class catalogDataModel copy setDatabaseContext: self
copyParametersFrom: dbc2 "Copy only the editable parameters of the context. Subclasses may want to rededfine and enhance this method" self username: dbc2 username. self environment: dbc2 environment
environment "Answer the environment to use when connecting to the SQL-environment." ^environment
environment: aString "Set the environment to use when connecting to the SQL-environment. An empty string should be used to specify the 'default' environment. If the environment is nil, the driver will raise a proceedable exception (requiredEnvironmentSignal on a connection class) when connecting." environment := aString
name ^self printString
username "Answer the receiver's username." ^username
username: newUsername "Set the receiver's username to newUsername." username := newUsername
</methods> <methods> Lens.LensDatabaseContext <category>data dictionary manipulation</category>
addIndex: index onTableFor: type in: aLensSession "Add the index on the table for type in aLensSession." | definition | definition := WriteStream on: String new. definition nextPutAll: 'create '. index isUnique ifTrue: [ definition nextPutAll: 'unique ' ]. definition nextPutAll: 'index '; nextPutAll: index name; nextPutAll: ' on '. type tableNameOn: definition. definition nextPutAll: ' ('. index indexedVariables do: [ :var | definition nextPutAll: var column name; nextPut: $,; cr]. definition skip: -2. definition nextPut: $). aLensSession connection class duplicateIndexesErrorSignal handle: [:ex | ex return] do: [aLensSession connection doCommandString: definition contents].
checkDataModelColumn: dataModelCol withDatabaseColumn: dbCol of: type in: session "Check consistency of existing data model column with database column. Engage user in dialog to fix any discrepancies." | dataModelColType dbColType choice dataModel connection colName dataModelColWidth dbColWidth table variable message | dataModel := session dataModel. connection := session connection. table := type table. colName := ((#x1s2s << #lensRuntime >> '<1s>.<2s>') expandMacrosWith: table name with: dataModelCol name). "check for datatype agreement" dataModelColType := dataModelCol dataType. dbColType := dbCol dataType. (self isColumnType: dataModelColType compatibleWith: dbColType) ifFalse: [message := ((#columnDatatypes << #lens >> 'Column <1s> has datatype <2p> in the data model, and datatype <3p> in the database.') expandMacrosWith: colName with: dataModelColType with: dbColType). choice := self getChoiceFor: message. choice == #alterDataModel ifTrue: [ type dataModel saved: false. dataModelCol dataType: dbColType]. choice == #alterDb ifTrue: [ connection doCommandString: ( table alterColumnCommand: dataModelCol operation: #alterType)]]. "check for width agreement" dataModelColWidth := dataModelCol maxColumnConstraint. dbColWidth := dbCol maxColumnConstraint. variable := type variableMappedTo: dataModelCol. "Do the checking only if the column is mapped to a variable" variable notNil ifTrue: [ (variable hasLongType or: [dataModelColWidth = dbColWidth]) ifFalse: [ message := ((#columnWidth << #lens >> 'Column <1s> has width <2p> in the data model, and width <3p> in the database.') expandMacrosWith: colName with: dataModelColWidth with: dbColWidth). choice := self getChoiceFor: message. choice == #alterDataModel ifTrue: [ type dataModel saved: false. dataModelCol maxColumnConstraint: dbColWidth. variable valueType: (dataModel fieldTypeForColumn: dataModelCol)]. choice == #alterDb ifTrue: [ connection doCommandString: ( table alterColumnCommand: dataModelCol operation: #alterType)]]]. "check for nullability agreement" dataModelCol isNotNil = dbCol isNotNil ifFalse: [ message := ((#columnIsNullable << #lens >> 'Column <1s> is <2?not :>nullable in the data model and <2?:not >nullable in the database.') expandMacrosWith: colName with: dataModelCol isNotNil). choice := self getChoiceFor: message. choice == #alterDataModel ifTrue: [ type dataModel saved: false. dataModelCol isNotNil: dbCol isNotNil]. choice == #alterDb ifTrue: [ connection doCommandString: ( table alterColumnCommand: dataModelCol operation: #alterNullness)]].
createTableFor: type in: aLensSession "Add the table for type in aLensSession. It's OK if it already exists." | definition | definition := WriteStream on: String new. definition nextPutAll: 'create table ', type table qualifiedName , ' ('. type variables do: [:var | | col | (col := var column) isNil ifFalse: [col putDefinitionOn: definition. definition nextPut: $,]]. definition skip: -1. definition nextPut: $). aLensSession connection doCommandString: definition contents.
defaultTableNameFor: type "Answer a default table name for the type. The resulting name has final vowels removed to conform to the associated logon's name length constraint." | tabName | tabName := type name asString. tabName at: 1 put: tabName first asLowercase. tabName = type name asString ifTrue: [tabName := tabName, '_']. (self class reservedWords includes: tabName) ifTrue: [tabName := tabName , '_']. [tabName size > self class maxNameSize] whileTrue: [ tabName := tabName dropVowels: 1]. ^tabName
defineForeignKeysFor: type in: aLensSession "Define the foreign keys for type in aLensSession. It's OK if it already exists." ^self "Not implemented"
definePrimaryKeyFor: type in: aLensSession "Define the primary key for type in aLensSession. It's OK if it already exists." | definition idv | definition := WriteStream on: String new. definition nextPutAll: 'alter table ', type table qualifiedName , ' add primary key ('. idv := type idVariable. idv forLeavesDo: [:v | definition nextPutAll: v column name. definition nextPutAll: ', ']. definition skip: -2. definition nextPutAll: ')'. aLensSession connection doCommandString: definition contents.
getTableNamed: tableName in: session "Answer the table named tableName from the data dictionary." ^self subclassResponsibility
listTablesLike: aPattern in: aLens "Answer a collection of tables which are accessible using aLens. If aPattern is not nil, limit the search to only those tables with names matching." ^self subclassResponsibility
synchronizeDataDictionaryFor: dataModel in: aLensSession "Synchronize data dictionary for the dataModel's mapped types." "install or update table definitions" dataModel mappedTypesDo: [:type | self synchronizeDataDictionaryForType: type in: aLensSession ]. "install or update foreign keys" dataModel mappedTypesDo: [:type | self defineForeignKeysFor: type in: aLensSession ]. "mark the dataModel installed" dataModel makeInstalled
synchronizeDataDictionaryForType: type in: session "Synchronize the data dictionary for type, by adding new or modifying existing database resources." "synchronize table" self synchronizeTableForType: type in: session. "add indexes" type indexes do: [:index | self addIndex: index onTableFor: type in: session]
synchronizeTableForType: type in: aLensSession "Synchronize table in aLensSession." | dbTable dataModelColumns dbColumns connection table | table := type table. connection := aLensSession connection. dbTable := self getTableNamed: table qualifiedName in: aLensSession. dbTable isNil ifTrue: [ (Dialog confirm: ((#tableNotInDB << #lens >> 'Table <1s> not in database. Add it?') expandMacrosWith: table qualifiedName)) ifFalse: [ LensSession doNotProceedSignal raise ]. self createTableFor: type in: aLensSession. self definePrimaryKeyFor: type in: aLensSession. ^self ]. "add or alter columns as required" dataModelColumns := table columns asSet. dbColumns := dbTable columns asSet. dataModelColumns copy do: [ :dmCol | | dbCol choice | dbCol := dbColumns detect: [:c | self isColumn: c theSameAs: dmCol ] ifNone: [nil]. dbCol == nil ifFalse: [ self checkDataModelColumn: dmCol withDatabaseColumn: dbCol of: type in: aLensSession] ifTrue: [ choice := Dialog choose: ((#tableMissingColumn << #lens >> 'Database table <1s> is missing column <2s>') expandMacrosWith: table qualifiedName with: dmCol name) labels: (Array with: (#addColumb << #lens >> 'Add column to table') with: (#quitChecking << #lens >> 'Quit Checking')) values: #(add quit) default: #add. choice == #quit ifTrue: [ LensSession doNotProceedSignal raise]. connection doCommandString: ( table alterColumnCommand: dmCol operation: #add). dbTable columns: nil "flush to force refreshing"]]. dbTable columns: nil "flush columns to force refreshing"
</methods> <methods> Lens.LensDatabaseContext <category>private</category>
getChoiceFor: prompt | choice | choice := Dialog choose: prompt labels: (Array with: (#AlterColumnInDataModel << #lens >> 'Alter column in data model') with:(#AlterColumnInDatabase << #lens >> 'Alter column in database') with: (#quitChecking << #lens >> 'Quit Checking' )) values: #(#alterDataModel #alterDb #quit ) default: #alterDataModel. choice == #quit ifTrue: [LensSession doNotProceedSignal raise] ifFalse: [^choice].
isColumn: c1 theSameAs: c2 ^c1 name sameAs: c2 name
isColumnType: dataModelColType compatibleWith: databaseColType "Answer whether the data model and database column types are compatible." ^dataModelColType sameAs: databaseColType
migrateObject: anObject toClass: aClass "Mutate anObject to be an instance of aClass." | newObject index | anObject class == aClass ifTrue: [^anObject]. newObject := aClass new. Object messageNotUnderstoodSignal handle: [:ex | ex return] do: [newObject initialize]. index := (anObject class commonSuperclass: aClass) instSize. [index > 0] whileTrue: [ newObject instVarAt: index put: (anObject instVarAt: index). index := index - 1]. anObject become: newObject. ^anObject
migrateType: type "Migrate the mapped type's table and columns to the format expected by the receiver." | table tabName | self migrateObject: (table := type table) toClass: self class tableClass. type allRecordVariables do: [ :var | self migrateVariable: var]. tabName := table name copyWithout: $_. (self class reservedWords includes: tabName) ifTrue: [ tabName := tabName , '_']. [tabName size > self class maxNameSize] whileTrue: [ tabName := tabName dropVowels: 1]. table name: tabName
migrateVariable: variable "Migrate the variable and its columns representation." | column fieldType mapping colName | (column := variable column) isNil ifTrue: [^self]. self migrateObject: column toClass: self class tableColumnClass. fieldType := variable valueType computeFieldType. "at most one column may be serial numbered" (fieldType isSerialNumber and: [variable isId not]) ifTrue: [ fieldType := variable fieldType]. mapping := variable dataModel mappingForFieldType: fieldType. column dataType: mapping columnType; maxColumnConstraint: (mapping isLongType ifTrue: [nil] ifFalse: [fieldType maxColumnConstraint]). colName := column name copyWithout: $_. (self class reservedWords includes: colName) ifTrue: [ colName := colName , '_']. [colName size > self class maxNameSize] whileTrue: [ colName := colName dropVowels: 1]. column name: colName
separateNameQualification: aTableName "Answer a collection of elements of a (perhaps) qualified table name. Each element represents a level in the naming hierarchy for tables. If only one element is found, it is assumed to be an unqualified table name/pattern." | elems patStream | elems := OrderedCollection new. aTableName notNil ifTrue: [ patStream := aTableName readStream. [ patStream atEnd ] whileFalse: [ elems add: (patStream upTo: $.) ] ]. ^elems reverse
</methods> <methods> Lens.LensDatabaseContext <category>connection</category>
postConnectIn: aLensSession "Give the LensDatabaseContext a chance to get control after the connect but before any database access is performed." ^self "Default to do nothing."
</methods> <methods> Lens.LensDatabaseContext <category>testing</category>
isOracle6 "Answer whether receiver is an Oracle6 context." ^false
isOracle7 "Answer whether receiver is an Oracle7 context." ^false
isSybase "Answer whether receiver is an Sybase logon." ^false
</methods> <methods> Lens.LensDatabaseContext <category>initialize-release</category>
initialize username := ''. environment := ''.
</methods> <methods> Lens.LensDatabaseContext class <category>private</category>
addBasicType: type "Add or replace type in basicTypes collection." basicTypes at: type name put: type
bindingsForInstance: aContext "Returns a dictionary whose keys are symbols and values are valueModels. This Dictionary will be used to populate a bindings dictionary when aContext is edited in some ui (probably a dialog)" | bin | bin := IdentityDictionary new. bin at: #username put: ((AspectAdaptor forAspect: #username) subject: aContext). bin at: #environment put: ((AspectAdaptor forAspect: #environment) subject: aContext). ^bin
encodedAspects ^#(#username #environment)
isVisualStartable "Disable the Start button in the Application Finder for this class." ^false
mapFieldOf: fieldClassName to: columnType ^dataTypeMappings add: ( DatabaseTypeMapping new fieldType: (self typeNamed: fieldClassName); columnType: columnType)
typeNamed: typeName "Answer the basic type with the given name." ^basicTypes at: typeName
</methods> <methods> Lens.LensDatabaseContext class <category>accessing</category>
basicTypes "Answer the set of basic types." ^basicTypes
catalogDataModel "Answer a data model instance for accessing the receiver's database catalog." ^catalogDataModel
connectionClass "Answer the class of connections opened by instances of self." ^self subclassResponsibility
dataTypeMappings ^dataTypeMappings
maxColumnSize "Answer the maximum size of database columns." ^maxColumnSize
maxNameSize "Answer the maximum size of database entity names." ^maxNameSize
reservedWords "Answer reservedWords." ^reservedWords
tableClass "Answer the class of tables for the receiver." ^LensDatabaseTable
tableColumnClass "Answer the class of table columns in receiver's data dictionary." ^LensDatabaseTableColumn
transactionPolicies "Answer transactionPolicies." ^transactionPolicies
transporterClass "Answer the class of transporters via which to dynamically access the receiver's associated database." ^LensSQLTransporter
</methods> <methods> Lens.LensDatabaseContext class <category>defaults</category>
defaultTransactionPolicy "return the default transaction policy for this context." ^#PessimisticRR
</methods> <methods> Lens.LensDatabaseContext class <category>verification</category>
getDatabaseEntityNameFrom: aName "returns something that complies with all the rules and is as similar to aName as possible" | newName | aName size <= maxNameSize ifTrue: [newName := aName copy] ifFalse: [newName := aName copyFrom: 1 to: maxNameSize]. (reservedWords includes: newName asLowercase) ifTrue: [newName := newName,'_']. ^newName
verifyConstraintsOnType: type "Verify entity for runtime operation. Check size constraints." | columnSize fieldType | "check column size constraints" type allRecordVariables do: [ :var | (var isReference not and: [(fieldType := var fieldType) isVariableSize]) ifTrue: [ "Check to make sure that variable length entries are within legal bounds." columnSize := fieldType maxColumnConstraint. (columnSize isNil) ifTrue: [ type dataModel dataDefinitionWarningWith: (Array with: type dataModel displayString with: var name asString with: type name asString with: var column defaultBLOBSize) errorPattern: (#errDataDefinitionNeedsMaxLength << #lens >> '<1p> <n>Data definition error:<n>Variable <2p> of Entity <3p><n>should have a maximum length defined.<n>Press OK to accept the default value (<4p>).'). var column maxColumnLength: var column defaultBLOBSize. var resetFieldTypeMax. var isId ifTrue: [var objectType idVariable resetFieldType] ] ifFalse: [ (columnSize asInteger > maxColumnSize) ifTrue: [ type dataModel dataDefinitionWarningWith: (Array with: type dataModel displayString with: var name asString with: type name asString with: maxColumnSize) errorPattern: (#errDataDefinitionTooLong << #lens >> '<1p> <n>Data definition error:<n>Variable <2p> of Entity <3p><n>is too long.<n>Press OK to accept the maximum size (<4p>).'). var column maxColumnLength: maxColumnSize. var resetFieldTypeMax. var isId ifTrue: [var objectType idVariable resetFieldType ] ] ] ] ]
</methods> <methods> Lens.LensDatabaseContext class <category>class initialization</category>
initialize "Initialize the class instance variables." "LensDatabaseContext initialize" self initializeBasicTypes
initializeBasicTypes "Initialize basicTypes" basicTypes := IdentityDictionary new. #(Object Integer Float Double ByteArray String Timestamp Symbol Boolean FixedPoint) do: [ :className | self addBasicType: ((LensDataType new) name: className; memberClass: (className asQualifiedReference valueOrDo: [nil])) ]. self addBasicType: (LensDataType new memberClass: Integer; name: #RowVersion); addBasicType: (LensDataType new memberClass: Integer; name: #SerialNumber); addBasicType: (LensEncodedType new memberClass: Date; name: #Date; fieldType: (self typeNamed: #Timestamp); encodeSelector: #asTimestamp; decodeSelector: #asDate). self addBasicType: (LensEncodedType new memberClass: Time; name: #Time; fieldType: (self typeNamed: #Timestamp); encodeSelector: #asTimestamp; decodeSelector: #asTime). "self addBasicType: (LensEncodedType new memberClass: Time; name: #TimeInterval; fieldType: (self typeNamed: #Timestamp); encodeSelector: #asTimestamp; decodeSelector: #asTime)"
initializeCatalogDataModel "Initialize the catalog data model." catalogDataModel := LensDataModel readFromClass: self methodName: #catalogDataModelSpec. catalogDataModel compile.
</methods> <methods> Lens.LensDatabaseContext class <category>converting</category>
internalNameFor: externalName "Answer an internal name derived from externalName." | stream char makeLowercase makeNextUppercase | stream := (String new:20) writeStream. makeLowercase := (externalName detect: [:c | c isLetter and: [c isLowercase]] ifNone: [nil]) isNil. makeNextUppercase := false. 1 to: externalName size do: [:i | char := externalName at: i. (char = $ ) ifFalse: [ (char isLetter or: [char isDigit]) ifTrue: [makeNextUppercase ifTrue: [ makeNextUppercase := false. stream nextPut: char asUppercase] ifFalse: [makeLowercase ifTrue: [stream nextPut: char asLowercase] ifFalse: [stream nextPut: char]]] ifFalse: [makeNextUppercase := true]]]. ^stream contents
</methods> <methods> Lens.LensDatabaseContext class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensDatabaseContext class <category>fileIn/Out</category>
prerequisitesForLoading "Subclasses of LensDatabaseContext require the classes in their catalogDataModelSpec to be initialized before themselves being initialized, since the catalogDataModel is compiled on initilaization in initializeCatalogDataModel. This also requires the class's corresponding transporter class." | prerequisites class additionalPrereqs | prerequisites := super prerequisitesForLoading. class := self class whichClassIncludesSelector: #catalogDataModelSpec. nil == class ifTrue: [^prerequisites]. additionalPrereqs := IdentitySet new. (class compiledMethodAt: #catalogDataModelSpec) allLiteralsDo: [:lit| | sym obj | "Pick up the first symbol literal that is a class name in every Array literal." (lit class == Array and: [lit size > 0 and: [((sym := lit at: 1) isSymbol or: [sym class == BindingReference]) and: [(obj := sym asQualifiedReference value) isBehavior]]]) ifTrue: [additionalPrereqs add: obj]]. "Exclude the class itself." additionalPrereqs remove: self ifAbsent: []. "Add the relevant Transporter class." additionalPrereqs add: (self environment at: (self name copyReplaceAll: 'Context' with: 'Transporter') asSymbol). "Add LensSession" additionalPrereqs add: LensSession. "Add LensTransactionPolicy" additionalPrereqs add: LensTransactionPolicy. "Add LensGlobalDescriptor" additionalPrereqs add: LensGlobalDescriptor. prerequisites addAll: additionalPrereqs. ^prerequisites "Oracle7Context prerequisitesForLoading"
</methods> <methods> Lens.LensSQLTransporter <category>command initialization</category>
initAddCommand "Initialize command to add objects to container." | recordVariables | self startCommand. "compute all field attributes for this type" recordVariables := type allRecordVariables. "build command body" commandStream nextPutAll: 'INSERT INTO '. type tableNameOn: commandStream. commandStream nextPutAll: ' ('. self generateNamesForVariables: recordVariables inTableNamed: nil forSelect: false. commandStream nextPutAll: ') VALUES ('. 1 to: recordVariables size do: [:i | (recordVariables at: i) isCanonicalVariable ifTrue: [commandStream nextPutAll: self nextVariableName; nextPut: $,]]. commandStream skip: -1; nextPut: $). "build bind template" command bindTemplate: (type recordTemplateForUpdate: true withUpdateMask: nil). addCommand := command commandString: commandStream contents
initFetchCommand "Initialize single-object proxy-fetch command." | idTemplate | self startCommand. idTemplate := type idVariable fieldTemplate. fetchCommand := self queryFor: ( lensContainer selectWhere: [:x | x externalId = idTemplate]) operation
initForQueries "Initialize receiver for performing queries." | containers valueContainer | "initialize selectFieldList" commandStream := WriteStream on: (String new: 2048). self generateNamesForVariables: type allRecordVariables inTableNamed: type tableName forSelect: true. selectFieldList := commandStream contents. "initialize resultTemplate" resultTemplate := type recordTemplate. "compute object surrogates and item surrogate" containers := lensContainer components. objectSurrogates := Array new: containers size. 1 to: containers size do: [ :index | | cont | cont := containers at: index. objectSurrogates at: index put: (LensObjectSurrogate new type: cont type lensContainer: cont) ]. (type isLensCollectionType and: [type isMapped not]) ifTrue: [ valueContainer := LensSession cannotStoreTypeOfObjectSignal handle: [:ex | ex returnWith: nil] do: [session containerOf: type]. valueContainer notNil ifTrue: [ "create surrogate for collection items" itemSurrogate := LensObjectSurrogate new type: type lensContainer: valueContainer. objectSurrogates := objectSurrogates , (Array with: itemSurrogate) ] ].
initLockCommand "Initialize command to verify an optimisticaly locked object." | blockTemplate idTemplate | self startCommand. idTemplate := type idVariable fieldTemplate. blockTemplate := [:c | c externalId = idTemplate]. "build command body" commandStream nextPutAll: 'SELECT COUNT(*) FROM '; nextPutAll: type tableName; nextPutAll: (self generateWhereClause: ( blockTemplate valueWithArguments: objectSurrogates)). self addOptimisticConflictCheckOn: command against: nil andMask: 0. "build result template?" lockCommand := command commandString: commandStream contents.
initUpdateCommand "Initialize command template for updating objects in container." | blockTemplate idTemplate bindTemplate | self startCommand. idTemplate := type idVariable fieldTemplate. blockTemplate := [:c | c externalId = idTemplate]. commandStream nextPutAll: ( self generateWhereClause: ( blockTemplate valueWithArguments: objectSurrogates)). command commandString: commandStream contents. bindTemplate := command bindObject. command bindTemplate: ( bindTemplate size > 1 ifTrue: [OrderedCollection with: bindTemplate asArray] ifFalse: [bindTemplate asOrderedCollection]). command bindObject: nil. "reset the bindObject" updateCommand := command. numberOfIdVariables := variableIndex.
</methods> <methods> Lens.LensSQLTransporter <category>parse graph processing</category>
collectResultsIn: surrogate into: attSet "Collect concatenated projection results rooted in surrogate, putting them into attSet." (surrogate IsQS and: [ surrogate IsOperationSurrogate and: [ surrogate Operator == #,]]) ifTrue: [ self collectResultsIn: surrogate Left into: attSet. self collectResultsIn: surrogate Right into: attSet] ifFalse: [ attSet add: surrogate]. ^attSet
findJoinLinksIn: surrogate "Find all join links and add to joinLinks set." surrogate IsQS ifFalse: [^self]. surrogate IsVariableSurrogate ifTrue: [ | attribute | attribute := surrogate Attribute. attribute isReference ifTrue: [ joinLinks add: surrogate]. self findJoinLinksIn: surrogate Predecessor]. surrogate IsOperationSurrogate ifTrue: [ | left op right | left := surrogate Left. right := surrogate Right. op := surrogate Operator. "if operation is of form <objectSurrogate> = <path>, swap operands" (op == #= and: [left IsObjectSurrogate and: [right IsQS]]) ifTrue: [ | temp | temp := left. left := right. right := temp]. left IsVariableSurrogate ifTrue: [ left := left Predecessor]. (right IsQS and: [right IsVariableSurrogate]) ifTrue: [ right := right Predecessor]. self findJoinLinksIn: left. self findJoinLinksIn: right]. surrogate IsRealFunctionSurrogate ifTrue: [ surrogate args do: [:argument | argument IsQS ifTrue: [argument IsVariableSurrogate ifTrue: [self findJoinLinksIn: argument Predecessor] ifFalse: [self findJoinLinksIn: argument ] ] ]].
flip: operator "Answer the operator whose arguments are the reverse of the given operator's." operator == #> ifTrue: [^#<]. operator == #< ifTrue: [^#>]. operator == #>= ifTrue: [^#<=]. operator == #<= ifTrue: [^#>=]. ^operator
mapReferencesIn: surrogate "Map references in surrogate to externalIds." surrogate IsQS ifFalse: [^surrogate]. surrogate IsOperationSurrogate ifTrue: [ | op left right newLeft | op := surrogate Operator. left := surrogate Left. right := surrogate Right. "if matching sibling identities, don't map" (op == #= and: [ left IsVariableSurrogate and: [ right IsQS and: [ right IsVariableSurrogate and: [ right Attribute == left Attribute]]]]) ifTrue: [ ^surrogate]. newLeft := self mapReferencesIn: left. (left IsQS and: [left IsObjectSurrogate and: [right IsQS not]]) ifTrue: [ "The left side is an object surrogate. In this case we check the right side. If it is an instance of a mapped class then we use its externalId for the comparison" | sCl | sCl := right class. (session containers detect: [:cont | cont type memberClass == sCl] ifNone: [nil]) isNil ifFalse: [ right := right externalId]] ifFalse: [ right := self mapReferencesIn: right]. ^(surrogate class new left: newLeft operator: op right: right) Type: surrogate Type]. surrogate IsObjectSurrogate ifTrue: [ referencedObjectSurrogates add: surrogate. ^surrogate externalId]. surrogate IsVariableSurrogate ifTrue: [ surrogate Source Type isMapped ifTrue: [ referencedObjectSurrogates add: surrogate Source]. ^surrogate]. surrogate IsRealFunctionSurrogate ifTrue: [ ^surrogate class name: surrogate name args: (surrogate args collect: [ :sur | self mapReferencesIn: sur]) type: surrogate Type]. ^surrogate
transform: surrogate variable: variable "Transform surrogate: - bind literals and replace them with variable surrogates - explode packed variable structures" | var | surrogate == nil ifTrue: [ ^nil ]. surrogate IsQS ifFalse: [ | value varName | value := (surrogate isKindOf: ValueHolder) ifTrue: [surrogate value] ifFalse: [surrogate]. varName := variableBindings at: surrogate ifAbsent: [(variable isReference and: [value isTransient]) ifTrue: [LensSession objectNotPersistentSignal raiseWith: (Array with: value)]. command addBinding: (variable encode: value in: session). variableBindings at: surrogate put: self nextVariableName]. ^LensCommandVariable new name: varName type: variable valueType]. surrogate IsAggregateSurrogate ifTrue: [ ^surrogate ]. surrogate IsOperationSurrogate ifTrue: [ | op left right | op := surrogate Operator. left := surrogate Left. right := surrogate Right. op == #= ifTrue: [ ^self transformEquals: surrogate left: left right: right ]. op == #in: ifTrue: [ ^self transformIn: surrogate left: left right: right ]. (op == #isNil or: [op == #notNil]) ifTrue: [ ^self transformNullOp: op left: left ]. var := left Attribute. left := self transform: left variable: var. right := self transform: right variable: var. "because of idiot SQL restrictions that subqueries must occur on the right of comparison expressions, flip the operation" left IsContainerSurrogate ifTrue: [ | temp | temp := left. left := right. right := temp. op := self flip: op]. ^surrogate class new left: left operator: op right: right]. surrogate IsRealFunctionSurrogate ifTrue: [ ^surrogate class name: surrogate name args: (surrogate args collect: [ :sur | self transform: sur variable: variable]) type: surrogate Type]. ^surrogate
transformCondition: surrogate "Transform a condition surrogate, by transforming Boolean-valued expressions into equalities with the appropriate Boolean constant." surrogate IsQS ifTrue: [ (surrogate IsOperationSurrogate and: [surrogate IsLogical]) ifTrue: [ | left right op | left := surrogate Left. right := surrogate Right. op := surrogate Operator. ^(surrogate Operator == #not and: [left IsVariableSurrogate]) ifTrue: [ self transformCondition: (LensOperationSurrogate new left: left operator: #= right: false)] ifFalse: [ LensOperationSurrogate new left: (self transformCondition: left) operator: op right: (self transformCondition: right)]]. surrogate IsVariableSurrogate ifTrue: [ ^self transformCondition: (LensOperationSurrogate new left: surrogate operator: #= right: true)]]. ^self transform: surrogate variable: nil.
transformEquals: surrogate left: left right: right "Transform an `=` expression. Check that the left side of the expression is legal, legal operands are querySurrogates, variable surrogates, operation surrogates and function surrogates" | leftIsPackedVar rightIsPackedVar variable | (left IsQS and: [left IsVariableSurrogate or: [left IsOperationSurrogate or: [left IsRealFunctionSurrogate]]]) ifFalse: [ self error: (#errIllegalLeftHandSide << #lens >> 'illegal left-hand side of ''='' expression') ]. variable := left Attribute. leftIsPackedVar := variable isCompound. rightIsPackedVar := right IsQS and: [right IsVariableSurrogate and: [right Attribute isCompound]]. ^leftIsPackedVar ifTrue: [ rightIsPackedVar ifTrue: [self transformPackedVar: surrogate left: left equalsPackedVarRight: right] ifFalse: [self transformPackedVar: left equals: right] ] ifFalse: [ rightIsPackedVar ifTrue: [self transformPackedVar: right equals: left] ifFalse: [ surrogate class new left: (self transform: left variable: variable) operator: surrogate Operator right: (self transform: right variable: variable) ] ]
transformIn: surrogate left: left right: right "Transform an 'in:' expression." | nameStream collection variable attribute | attribute := left Attribute. (right IsQS and: [right IsContainerSurrogate]) ifTrue: [ "if right's selection is Boolean, answer the Boolean" (right Condition isKindOf: Boolean) ifTrue: [ ^right Condition]. "if left is an externalId and right has no result block, project on externalId" ^(left IsQS and: [ left IsVariableSurrogate and: [ attribute isReference and: [ right AnswerBlock == nil]]]) ifTrue: [ (surrogate class new left: left operator: #in: right: (self transform: (right answer: [:x | x externalId]) variable: attribute)) Type: surrogate Type] ifFalse: [surrogate]]. nameStream := WriteStream on: (String new: 128). collection := right asArray. nameStream nextPutAll: ' ('. collection size timesRepeat: [ nameStream nextPutAll: self nextVariableName; nextPut: $,]. command addBinding: collection. nameStream skip: -1; nextPut: $). variable := LensCommandVariable new name: nameStream contents type: left Type. ^(surrogate class new left: left operator: #in: right: variable) Type: surrogate Type
transformNullOp: op left: left "Transform an #isNil or #notNil expression. If left is a packed variable, explode the operation into a tree of terms on the subvariables." | variable variables newOp subVar source subVarSurrogate subOp | variable := left Attribute. variable isCompound ifFalse: [ ^left perform: op] ifTrue: [ variables := variable fieldType variables. source := left Source. newOp := nil. 1 to: variables size do: [:i | subVar := variables at: i. "if subvariable is a reference and also part of the externalId, convert it to a pure data variable" (subVar isReference and: [subVar isId]) ifTrue: [ subVar := subVar shallowCopy setValueType: subVar fieldType]. subVarSurrogate := LensVariableSurrogate new source: source via: subVar. subOp := subVarSurrogate perform: op. newOp := i == 1 ifTrue: [subOp] ifFalse: [op == #isNil ifTrue: [subOp | newOp] ifFalse: [subOp & newOp]]]. ^newOp]
transformPackedVar: left equals: right "Transform an `=` expression where left is a packed variable and right is a literal, by exploding it into a tree of equalities on the subvariables." | source variable subOp variables newOp subVarSurrogate value encodedVars count | right IsQS ifTrue: [ self error: (#errSurrogateValues << #lens >> 'do not know how to deal with packed surrogate values') ]. source := left Source. newOp := nil. value := right isPersistent ifTrue: [right externalId] ifFalse: [right]. variables := left Attribute fieldType variables. encodedVars := OrderedCollection new. count := 0. variables do: [:firstLevelVar | firstLevelVar forLeavesDo: [ :subVar | | confirmedSubVar | count := count + 1. "if subvariable is a reference and also part of the externalId, convert it to a pure data variable" (subVar isReference and: [subVar isId]) ifTrue: [ confirmedSubVar := subVar shallowCopy setValueType: subVar fieldType] ifFalse: [ confirmedSubVar := subVar ]. subVarSurrogate := LensVariableSurrogate new source: source via: confirmedSubVar. variable := LensCommandVariable new name: self nextVariableName type: subVarSurrogate Type. confirmedSubVar encodeSelector notNil ifTrue: [ "encode data if any encoding" encodedVars add: confirmedSubVar]. subOp := subVarSurrogate = variable. newOp := count == 1 ifTrue: [subOp] ifFalse: [newOp & subOp]]]. encodedVars size > 0 ifTrue: [ | isArray | isArray := value isKindOf: Array. value := value shallowCopy. encodedVars do: [ :var | | i | i := var instVarIndex. isArray ifTrue: [value at: i put: (var encode: (value at: i) in: session)] ifFalse: [value instVarAt: i put: (var encode: (value instVarAt: i) in: session)]]]. command addBinding: value. ^newOp
transformPackedVar: left equalsPackedVar: right "Transform an `=` expression when both surrogates are packed variables, by exploding it into a tree of equalities on the subvariables." | leftVars rightVars leftSource rightSource leftSubVar rightSubVar subOp newOp | leftVars := left Attribute fieldType variables. rightVars := right Attribute fieldType variables. leftVars size == rightVars size ifFalse: [ self error: (#errPackedAttributesDifferentSizes << #lens >> 'packed attributes of different sizes') ]. leftSource := left Source. rightSource := right Source. newOp := nil. 1 to: leftVars size do: [:i | leftSubVar := LensVariableSurrogate new source: leftSource via: (leftVars at: i). rightSubVar := LensVariableSurrogate new source: rightSource via: (rightVars at: i). subOp := leftSubVar = rightSubVar. newOp := i == 1 ifTrue: [subOp] ifFalse: [subOp & newOp]]. ^newOp
transformPackedVar: surrogate left: left equalsPackedVarRight: right "Transform an `=` expression when both surrogates are packed variables, by exploding it into a tree of equalities on the subvariables." | leftVars rightVars leftSource rightSource leftSubVar rightSubVar subOp newOp | leftVars := left Attribute fieldType variables. rightVars := right Attribute fieldType variables. leftVars size == rightVars size ifFalse: [ self error: (#errPackedAttributesDifferentSizes << #lens >> 'packed attributes of different sizes') ]. leftSource := left Source. rightSource := right Source. newOp := nil. 1 to: leftVars size do: [:i | leftSubVar := LensVariableSurrogate new source: leftSource via: (leftVars at: i). rightSubVar := LensVariableSurrogate new source: rightSource via: (rightVars at: i). subOp := self transformEquals: surrogate left: leftSubVar right: rightSubVar. newOp := i == 1 ifTrue: [subOp] ifFalse: [LensOperationSurrogate new left: subOp operator: #& right: newOp]]. ^newOp
transformRemove: surrogate "Transform a remove condition: surrogate att1 att2 ... relOp value ==> surrogate att1 in: (cont selectWhere: [:x | x att2 ... relOp value])" surrogate IsQS ifFalse: [ ^surrogate]. surrogate IsOperationSurrogate ifTrue: [ | op left right | op := surrogate Operator. left := surrogate Left. right := surrogate Right. op == #= ifTrue: [ | mySurrogate referent collectionSurrogate q | mySurrogate := objectSurrogates first. q := nil. [left Source == mySurrogate] whileFalse: [ q := left. left := left Predecessor]. q == nil ifTrue: [^surrogate]. referent := q Source. q Predecessor: referent. collectionSurrogate := LensSubquerySurrogate new type: type objectSurrogate: referent. collectionSurrogate Condition: surrogate; answer: [:x | x externalId]. ^(LensOperationSurrogate new left: left operator: #in: right: collectionSurrogate) Type: Boolean type] ifFalse: [ ^(LensOperationSurrogate new left: (self transformRemove: left) operator: surrogate Operator right: (self transformRemove: right)) Type: surrogate Type]]. ^surrogate
</methods> <methods> Lens.LensSQLTransporter <category>initialize-release</category>
startCommand "Start command generation." super startCommand. command := DatabaseCommand new. commandStream := WriteStream on: (String new: 2048). joinLinks := IdentitySet new. variableIndex := 0. variableBindings := IdentityDictionary new. objectSurrogateIndices := IdentityDictionary new. "Make sure the table indices are assigned now for the objectSurrogates so their numbers in the generated SQL match the numbers in the source query" objectSurrogates do: [:os | self tableIndexFor: os]
</methods> <methods> Lens.LensSQLTransporter <category>clause generation</category>
bindVariable: variable tableName: tableName "Put binding variable name(s) on the commandStream for variable, flattening the names if variable is packed." variable isCompound ifTrue: [ variable fieldType variables do: [ :var | self bindVariable: var tableName: tableName. commandStream nextPut: $,]. commandStream skip: -1] ifFalse: [ tableName notNil ifTrue: [ commandStream nextPutAll: tableName; nextPut: $.]. commandStream nextPutAll: variable column name; nextPut: $=; nextPutAll: self nextVariableName]
bindVariable: variable tableName: tableName withUpdateMask: updatedInstVarsMask "Put binding variable name(s) on the commandStream for variable, flattening the names if variable is packed. Returns true if if any variables needed binding" variable isCompound ifTrue: [| needsBinding | needsBinding := false. variable fieldType variables do: [:var | (self bindVariable: var tableName: tableName withUpdateMask: updatedInstVarsMask) ifTrue: [needsBinding := true. commandStream nextPut: $,]]. needsBinding ifTrue: [commandStream skip: -1]. ^needsBinding] ifFalse: [(variable needsUpdate: updatedInstVarsMask) ifTrue: [tableName notNil ifTrue: [commandStream nextPutAll: tableName; nextPut: $.]. commandStream nextPutAll: variable column name; nextPut: $=; nextPutAll: self nextVariableName. ^true] ifFalse: [^false]]
generateExpressionFor: surrogate "Generate an SQL expression for condition, and put it on commandStream." surrogate IsQS ifFalse: [ ^surrogate printOn: commandStream]. surrogate IsVariableSurrogate ifTrue: [ ^self generateNameForVariableSurrogate: surrogate]. surrogate IsRealFunctionSurrogate ifTrue: [ | nm | surrogate isArbitraryFunctionSurrogate ifTrue: [ nm := surrogate name ] ifFalse: [ nm := self class functionNameFor: surrogate name. nm isNil ifTrue: [ self error: ((#errUnknownFunction << #lens >> 'The function <1s> is unknown. Use arbitrary functions to access unsupported functions') expandMacrosWith: surrogate name)]. ]. commandStream nextPutAll: nm; space; nextPut: $(. surrogate args do: [:arg | self generateExpressionFor: arg. commandStream nextPut: $,]. commandStream skip: -1. ^commandStream nextPut: $)]. surrogate IsOperationSurrogate ifTrue: [ | op left right operator | op := surrogate Operator. operator := OperatorTable at: op ifAbsent: [op]. left := surrogate Left. right := surrogate Right. surrogate IsAggregateSurrogate ifTrue: [ commandStream nextPutAll: operator; space; nextPut: $(. op == #Count ifTrue: [commandStream nextPut: $*] ifFalse: [self generateExpressionFor: left]. ^commandStream nextPut: $)] ifFalse: [ commandStream nextPut: $(. right == nil ifTrue: [op == #not ifTrue: [ commandStream nextPutAll: operator; space. self generateExpressionFor: left] ifFalse: [ self generateExpressionFor: left. commandStream space; nextPutAll: operator]] ifFalse: [ self generateExpressionFor: left. commandStream nextPutAll: operator. self generateExpressionFor: right]. ^commandStream nextPut: $)]]. surrogate IsCommandVariableSurrogate ifTrue: [ ^commandStream nextPutAll: surrogate name]. surrogate IsContainerSurrogate ifTrue: [ ^self generateSubSelectionFor: surrogate]. surrogate IsObjectSurrogate ifTrue: [ self generateSelectFieldListFor: surrogate. ^commandStream skip: -1].
generateFromClauseLocking: flag "Generate the FROM clause. If there is more than one referenced table then emit aliases for the tables" | useAlias | useAlias := referencedObjectSurrogates size > 1. commandStream nextPutAll: ' FROM '. referencedObjectSurrogates do: [ :surrog | "Emit the table name" surrog Type tableNameOn: commandStream. useAlias ifTrue: [ "emit the alias for the table" commandStream nextPut: Character space. self tableNameFor: surrog on: commandStream ]. commandStream nextPut: $, ]. commandStream skip: -1.
generateNameForVariableSurrogate: variableSurrogate "Generate a name for variableSurrogate." | variable source | variable := variableSurrogate Attribute. source := variableSurrogate PathSource. variable isCompound ifTrue: [ variable forLeavesDo: [:var | self tableNameFor: source on: commandStream. commandStream nextPut: $.; nextPutAll: var column name; nextPutAll: ', ' ]. commandStream skip: -2 ] ifFalse: [ self tableNameFor: source on: commandStream. commandStream nextPut: $.; nextPutAll: variable column name ]. variableSurrogate Source IsOuterJoin ifTrue: [ commandStream nextPutAll: '(+)' ]
generateNamesForVariables: variables inTableNamed: tableName "Generate the field names of variables, prefixing them with tableName if non-nil." variables do: [ :var | tableName notNil ifTrue: [ commandStream nextPutAll: tableName; nextPut: $. ]. commandStream nextPutAll: var column name; nextPut: $, ]. "//A.R. The following code will cause the list to include only unique column references rather than one for each reference. This violates assumptions which are fundamental to result templates and decoder blocks. | alreadyEmitted | alreadyEmitted := IdentitySet new: variables size. 1 to: variables size do: [ :index | | var col | var := variables at: index. (alreadyEmitted includes: (col := var column)) ifFalse: [ alreadyEmitted add: col. tableName notNil ifTrue: [ commandStream nextPutAll: tableName; nextPut: $. ]. commandStream nextPutAll: col name; nextPut: $, ] ]." "remove the extra/trailing comma" commandStream skip: -1.
generateNamesForVariables: variables inTableNamed: tableName forSelect: isSelect "Generate the field names of variables, prefixing them with tableName if non-nil." variables do: [:var | (isSelect or: [var isCanonicalVariable]) ifTrue: [tableName notNil ifTrue: [commandStream nextPutAll: tableName; nextPut: $.]. commandStream nextPutAll: var column name; nextPut: $,]]. "remove the extra/trailing comma" commandStream skip: -1
generateOrderByClauseFor: primaryOrdering "Answer an orderBy clause for the container." | savedCommandStream orderByClause internalOrdering | savedCommandStream := commandStream. commandStream := WriteStream on: (String new: 100). "force elements of collections to be be grouped together; do this only if not in the process of initializing a fetch command, since fetch commands always fetch just one collection, hence elements are trivially grouped, so we can avoid the sorting overhead" (type isLensCollectionType and: [fetchCommand ~~ nil]) ifTrue: [ internalOrdering := objectSurrogates first id]. (internalOrdering ~~ nil or: [primaryOrdering ~~ nil]) ifTrue: [ commandStream nextPutAll: ' ORDER BY '. self generateOrderByExpressionFor: internalOrdering. self generateOrderByExpressionFor: primaryOrdering. commandStream skip: -1]. orderByClause := commandStream contents. commandStream := savedCommandStream. ^orderByClause
generateOrderByExpressionFor: surrogate "Generate an SQL expression for surrogate." surrogate == nil ifTrue: [ ^self]. surrogate IsQS ifFalse: [ self error: (#errIllegalSurrogateType << #lens >> 'illegal surrogate type')]. surrogate IsVariableSurrogate ifTrue: [ self generateNameForVariableSurrogate: surrogate. surrogate IsAscending ifFalse: [ commandStream nextPutAll: ' DESC ']. commandStream nextPut: $,. ^self]. (surrogate IsOperationSurrogate and: [ surrogate Operator == #,]) ifTrue: [ self generateOrderByExpressionFor: surrogate Left. ^self generateOrderByExpressionFor: surrogate Right]. surrogate IsExpressionSurrogate ifTrue: [ self generateExpressionFor: surrogate. surrogate IsAscending ifFalse: [ commandStream nextPutAll: ' DESC ']. commandStream nextPut: $,. ^self]. self error: (#errIllegalSurrogateType << #lens >> 'illegal surrogate type')
generateSelectFieldList "Generate select fields into command. If the query references more than one table then generate the appropriate field list. If it references only one then emit the simple pre-computed field list" referencedObjectSurrogates size > 1 ifFalse: [ commandStream nextPutAll: selectFieldList] ifTrue: [ objectSurrogates do: [:surrog | self generateSelectFieldListFor: surrog]. commandStream skip: -1].
generateSelectFieldListFor: objectSurrogate "Generate the select field list for objectSurrogate." self generateNamesForVariables: objectSurrogate Type allRecordVariables inTableNamed: (self tableNameFor: objectSurrogate) forSelect: true. commandStream nextPut: $,
generateSubSelectionFor: containerSurrogate "Generate an SQL expression for the nested selection on the containerSurrogate." | resultBlock objectSurrogate whereClause savedReferencedObjectSurrogates condition savedWhereCondition | resultBlock := containerSurrogate AnswerBlock. objectSurrogate := containerSurrogate ObjectSurrogate. joinLinks := IdentitySet new. "generate the WHERE clause (and set aside)" savedReferencedObjectSurrogates := referencedObjectSurrogates. savedWhereCondition := whereCondition. referencedObjectSurrogates := IdentitySet new. (condition := containerSurrogate Condition) == nil ifFalse: [ whereClause := self generateWhereClause: condition]. "subtract surrogates referenced in outer selection" savedReferencedObjectSurrogates do: [:surrog | referencedObjectSurrogates remove: surrog ifAbsent: []]. "generate the SELECT clause" commandStream nextPutAll: '(SELECT '. "generate the selected fields and build result template" resultBlock == nil ifTrue: [ commandStream nextPut: $*] ifFalse: [ | size results | results := self collectResultsIn: (resultBlock value: objectSurrogate) into: OrderedCollection new. (size := results size) == 0 ifTrue: [ self error: (#errNoAttributesSelected << #lens >> 'no attributes selected')]. "assemble result description from selected fields" 1 to: size do: [:i | | result | result := results at: i. self generateExpressionFor: result. commandStream nextPut: $,]. commandStream skip: -1]. "generate FROM clause" self generateFromClauseLocking: false. "restore state" referencedObjectSurrogates := savedReferencedObjectSurrogates. whereCondition := savedWhereCondition. "put the whereClause" condition == nil ifFalse: [commandStream nextPutAll: whereClause]. commandStream nextPut: $)
generateWhereClause: condition "Answer a where clause expression from condition, using filter conditions only if filterFlag is true." | savedCommandStream whereClause | whereCondition := condition. savedCommandStream := commandStream. commandStream := WriteStream on: (String new: 2048). (whereCondition == true or: [whereCondition == false or: [whereCondition Type memberClass == Boolean]]) ifFalse: [ LensContainer queryErrorWith: (Array with: whereCondition printString) errorPattern: (#blockMustYieldBoolean << #lens >> 'Query error: Query block must yield boolean, returns <1p> instead')]. self findJoinLinksIn: whereCondition. joinLinks do: [:link | whereCondition := whereCondition & link JoinCondition]. whereCondition := self mapReferencesIn: whereCondition. (whereCondition == true or: [whereCondition == false]) ifFalse: [ whereCondition := self transformCondition: whereCondition]. (whereCondition == true or: [whereCondition == false]) ifTrue: [ whereCondition ifFalse: [ commandStream nextPutAll: ' WHERE 1 <> 1']] ifFalse: [ commandStream nextPutAll: ' WHERE '. self generateExpressionFor: whereCondition]. whereClause := commandStream contents. commandStream := savedCommandStream. ^whereClause
tableNameFor: objectSurrogate "Answer a table name for objectSurrogate. " | strm | strm := WriteStream on: (String new: 64). self tableNameFor: objectSurrogate on: strm. ^strm contents
tableNameFor: objectSurrogate on: aStream "Put a table name for objectSurrogate on aStream. If there is more than one table accessed then compute an alias for the table name based on its base name and index." referencedObjectSurrogates add: objectSurrogate. referencedObjectSurrogates size > 1 ifTrue: [ aStream nextPutAll: objectSurrogate Type table name; print: (self tableIndexFor: objectSurrogate) ] ifFalse: [ objectSurrogate Type tableNameOn: aStream ]
</methods> <methods> Lens.LensSQLTransporter <category>registration</category>
tableIndexFor: objectSurrogate "Answer the table index for objectSurrogate, assigning one when first requested." ^objectSurrogateIndices at: objectSurrogate ifAbsent: [ | tableName n | tableName := objectSurrogate TableName. n := 0. "get the highest index among all synonymous objectSurrogates" objectSurrogateIndices associationsDo: [:assoc | assoc key TableName = tableName ifTrue: [ n := n max: assoc value]]. objectSurrogateIndices at: objectSurrogate put: n + 1]
</methods> <methods> Lens.LensSQLTransporter <category>accessing</category>
selectFieldList "Answer the select field list for fetches." ^selectFieldList
</methods> <methods> Lens.LensSQLTransporter <category>data manipulation</category>
checkForReferencesOfVar: variable toId: id "Make sure that there are no references to this object." | condition idSurrogate whereClause cursor answer noRefs | self startCommand. "compute the fetch action" condition := (objectSurrogates first perform: variable accessorSelector) externalId = id. "Generate the fetch command" idSurrogate := objectSurrogates first externalId. whereClause := self generateWhereClause: condition. commandStream nextPutAll: 'select '. self generateNameForVariableSurrogate: idSurrogate. self generateFromClauseLocking: false. commandStream nextPutAll: whereClause. command queryString: commandStream contents; resultTemplate: type idVariable fieldTemplate. "Attempt to fetch a referencing row." cursor := session connection getSession. cursor blockFactor: 2. cursor doCommand: command. answer := cursor answerAfterCommand. noRefs := answer atEnd. answer close. noRefs ifFalse: [ "Sorry, mutation not allowed due to references in the database." session connection class rowIsReferencedErrorSignal raise ]
removeDataWhere: selectBlock "Remove all records satisfying selectBlock, without enforcing any referential integrity constraints." | condition transformedCondition | self startCommand. condition := selectBlock value: objectSurrogates first. transformedCondition := self transformRemove: condition. commandStream nextPutAll: 'DELETE FROM '. type tableNameOn: commandStream. commandStream nextPutAll: (self generateWhereClause: transformedCondition). command commandString: commandStream contents. (self doCommand: command) answerAfterCommand
removeObject: object checkingAgainst: oldObject "Delete the row identified by object. If oldObject notNil check for optimistic lock conflicts using oldObject as the reference." | condition whereClause dbSession rc| self startCommand. "compute the mutation condition" condition := objectSurrogates first externalId = object externalId. "compute the whereClause" condition := self transformRemove: condition. whereClause := self generateWhereClause: condition. "generate and attach a mutation command to the action" condition := self transformRemove: condition. commandStream nextPutAll: 'DELETE FROM '. type tableNameOn: commandStream. commandStream nextPutAll: whereClause. oldObject notNil ifTrue: [self addOptimisticConflictCheckOn: command against: oldObject andMask: 0]. command commandString: commandStream contents. (dbSession := self doCommand: command) answerAfterCommand. (rc := dbSession rowCount) == 0 ifTrue: [ oldObject notNil ifTrue: [LensSession optimisticConflictDetectedSignal raise ] ifFalse: [LensSession rowForObjectNotFoundSignal raise ] ]. rc > 1 ifTrue: [ LensSession objectNotUniquelyIdentifiedSignal raise ]
restoreTransporterStateFrom: anArray updateCommand := anArray at: 1. commandStream := anArray at: 2. command := anArray at: 3. variableIndex := anArray at: 4. numberOfIdVariables := anArray at: 5. ^anArray
update: object withId: externalId andMask: updatedInstVarsMask withOldObject: oldObject "Update the record associated with object with externalId. If oldObject notNil check for optimistic lock conflicts using oldObject as the reference." "Caution: This method can be called within a recursion. Therefore it is necessary to save some of the original values and restore them after the work is done" | dbSession rc cmd cmdStream saveState | saveState := self saveTransporterState. updateCommand == nil ifTrue: [self initUpdateCommand]. self startCommand. cmd := updateCommand copy. "copy the command as template" cmdStream := commandStream. variableIndex := numberOfIdVariables. cmdStream nextPutAll: 'UPDATE '. type tableNameOn: cmdStream. cmdStream nextPutAll: ' SET '. cmd addBinding: externalId. type mappedVariablesDo: [:var | | index value modified | index := var instVarIndex. modified := (updatedInstVarsMask bitAnd: (1 bitShift: index - 1)) > 0. "Check for versionNumber field. If this is one and it has not been modified - increment it." (var valueType isRowVersion and: [modified not]) ifTrue: [object globalDescriptor update: object instVarAt: index put: (object instVarAt: index) + 1. modified := true]. modified ifTrue: [value := object instVarAt: index. var checkShallowIncludes: value. (self bindVariable: var tableName: nil withUpdateMask: updatedInstVarsMask) ifTrue: [cmd addTemplate: (var fieldTemplateForUpdate: true withUpdateMask: updatedInstVarsMask); addBinding: (var encodeVariableOf: object in: session withUpdateMask: updatedInstVarsMask). cmdStream nextPut: $,]]]. cmdStream skip: -1. cmdStream nextPutAll: cmd body. "append where clause" oldObject notNil ifTrue: [self addOptimisticConflictCheckOn: cmd against: oldObject andMask: updatedInstVarsMask]. cmd commandString: cmdStream contents. (dbSession := self doCommand: cmd) answerAfterCommand. (rc := dbSession rowCount) == 0 ifTrue: [oldObject notNil ifTrue: [LensSession optimisticConflictDetectedSignal raise] ifFalse: [LensSession rowForObjectNotFoundSignal raise]]. rc > 1 ifTrue: [LensSession objectNotUniquelyIdentifiedSignal raise]. self restoreTransporterStateFrom: saveState
</methods> <methods> Lens.LensSQLTransporter <category>command manipulation</category>
addOptimisticConflictCheckOn: cmd against: object andMask: updatedInstVarsMask "Add clauses to make query only operate on an object if it is in the state that we beleive it to be. If object is nil we are generating a template so we shouldn't add bindings." type mappedVariablesDo: [:var | | index | index := var instVarIndex. (var checkAlways or: [var checkIfModified and: [updatedInstVarsMask bitAnd: (1 bitShift: index - 1) > 0]]) ifTrue: [commandStream nextPutAll: ' AND '. self bindVariable: var tableName: nil. cmd bindTemplate notNil ifTrue: [cmd addTemplate: var fieldTemplate]. object notNil ifTrue: [cmd addBinding: (var encode: (object instVarAt: index) in: session)]]]
</methods> <methods> Lens.LensSQLTransporter <category>As yet unclassified</category>
saveTransporterState ^(Array new: 5) at: 1 put: updateCommand; at: 2 put: commandStream; at: 3 put: command; at: 4 put: variableIndex; at: 5 put: numberOfIdVariables; yourself
</methods> <methods> Lens.LensSQLTransporter <category>querying</category>
queryFor: operation "Answer a query command for operation." | condition whereClause orderByClause newResultTemplate elementDecoders groupByBlock groupByVars bindings primaryOrdering saveState | "initialize transporter" self startCommand. "bind operation arguments" (bindings := operation argumentBindings) == nil ifFalse: [ bindings do: [ :binding | | variable name | variable := binding value. name := self nextVariableName. command addBinding: variable Type recordTemplate. variableBindings at: variable put: name. variable name: name ] ]. "evaluate selectBlock; a side-effect of this is to establish referenced and fetched domains" saveState := self saveTransporterState. condition := operation selectBlock valueWithArguments: objectSurrogates. self restoreTransporterStateFrom: saveState. "if the query is over a collectionType, join a query for its items" itemSurrogate == nil ifFalse: [ condition := condition & (objectSurrogates first value = itemSurrogate outerJoin) ]. "generate the groupBy and orderBy clauses (do so now to compute table references)" (groupByBlock := operation groupByBlock) == nil ifFalse: [ groupByVars := self collectResultsIn: (groupByBlock valueWithArguments: objectSurrogates) into: OrderedCollection new ]. operation orderByBlock notNil ifTrue: [primaryOrdering := self mapReferencesIn: (operation orderByBlock valueWithArguments: objectSurrogates). self findJoinLinksIn: primaryOrdering]. "evaluate answerBlock, yielding answerSurrogate" operation answerBlock == nil ifFalse: [ answerSurrogate := self collectResultsIn: (operation answerBlock valueWithArguments: objectSurrogates) into: OrderedCollection new. "find all joins due to navigations in result terms, and determine if query returns a single result" answerSurrogate do: [ :result | self findJoinLinksIn: result ] ]. "generate the WHERE clause (do it now to compute table references)" whereClause := self generateWhereClause: condition. "generate the SELECT [DISTINCT] clauses" commandStream nextPutAll: 'SELECT '. operation isDistinct ifTrue: [ commandStream nextPutAll: 'DISTINCT ' ]. "generate the selected fields and build result template" answerSurrogate == nil ifTrue: [ | size | newResultTemplate := resultTemplate. "generate the select field list" self generateSelectFieldList. "generate the result template" ((size := objectSurrogates size) > 1 and: [lensContainer isComposite or: [fetchCommand == nil]]) ifTrue: [ newResultTemplate := Array new: size. elementDecoders := Array new: size. 1 to: size do: [ :i | | typ | typ := (objectSurrogates at: i) Type. newResultTemplate at: i put: (session containerOf: typ) transporter resultTemplate. elementDecoders at: i put: typ decoder ]. decoder := lensContainer decoderFrom: elementDecoders andContainers: (objectSurrogates collect: [:s | s Container]) ] ] ifFalse: [ | size containers | (size := answerSurrogate size) == 0 ifTrue: [ LensContainer queryErrorWith: (Array with: operation) errorPattern: (#answerBlockEmpty << #lens >> 'Query error: Answer block is empty') ]. newResultTemplate := Array new: size. elementDecoders := Array new: size. containers := Array new: size. "assemble result description from selected fields" 1 to: size do: [ :j | | result | result := answerSurrogate at: j. result IsQS ifFalse: [self error: (#errIllegalAnswer << #lens >> 'illegal answer expression')]. result IsVariableSurrogate ifTrue: [ | var | var := result Attribute. newResultTemplate at: j put: var fieldTemplate. elementDecoders at: j put: var decoder. containers at: j put: (session containers at: var valueType ifAbsent: [])] ifFalse: [ (result IsOperationSurrogate or: [result IsObjectSurrogate or: [result IsRealFunctionSurrogate]]) ifTrue: [ | typ cont tmpl | typ := result Type. cont := session containers at: typ ifAbsent: []. tmpl := cont notNil ifTrue: [cont transporter resultTemplate] ifFalse: [typ recordTemplate]. newResultTemplate at: j put: tmpl. elementDecoders at: j put: typ decoder. result IsOperationSurrogate ifTrue: [ result := self transform: result variable: nil]. result IsObjectSurrogate ifTrue: [ containers at: j put: result Container]] ifFalse: [ self error: (#errIllegalProjectionResult << #lens >> 'illegal projection result') ] ]. self generateExpressionFor: result. commandStream nextPut: $, ]. commandStream skip: -1. decoder := lensContainer decoderFrom: elementDecoders andContainers: containers. size == 1 ifTrue: [ newResultTemplate := newResultTemplate first ] ]. command resultTemplate: newResultTemplate. orderByClause := self generateOrderByClauseFor: primaryOrdering. self generateFromClauseLocking: operation isLocking. "put the where clause" commandStream nextPutAll: whereClause. "put the groupBy clause" groupByBlock == nil ifFalse: [ commandStream nextPutAll: ' GROUP BY '. groupByVars do: [ :var | (var IsQS and: [var IsVariableSurrogate]) ifFalse: [ LensContainer queryErrorWith: (Array with: var) errorPattern: (#errIllegalGroupBy << #lens >> 'Query error: Illegal groupBy term' )]. self generateNameForVariableSurrogate: var. commandStream nextPut: $,]. commandStream skip: -1; space ]. "put the orderBy clause" commandStream nextPutAll: orderByClause. "set the decoder block if not already set" decoder == nil ifTrue: [ decoder := type decoder]. "build and return the command" ^command queryString: commandStream contents; resultTemplate: newResultTemplate; decoder: decoder
</methods> <methods> Lens.LensSQLTransporter class <category>private-runtime generation</category>
decoderForMappedType: type using: g "Generate decoder for directly-mapped type." | idVar record container temps args g1 ifPresentBlock ifAbsentBlock rcvr | g reset. idVar := type idVariable. "define variables" rcvr := g variable: 'SELF'. record := g variable: 'RECORD'. container := g variable: 'CONTAINER'. temps := OrderedCollection new. args := OrderedCollection new. args add: record. idVar setFieldType. (idVar fieldType isLensStructureType and: [idVar isReference not]) ifFalse: [ "if simple variable, just pass it" args add: (idVar fetchFrom: record using: g)] ifTrue: [ | idVars i id | idVars := idVar fieldType variables. "if compound, must create an id" id := g variable: 'ID'. temps add: id. i := 0. g addStatement: (g assign: id value: (g to: (g variable: 'Array') send: #new: withArg: (g literal: idVars size))). idVars do: [ :var | g addStatement: (g to: id send: #at:put: withArgs: (Array with: (g literal: (i := i + 1)) with: (var fetchFrom: record using: g)))]. args add: id]. "generate ifPresent decoder body" g1 := g fork. "generate decoding for reference and encoded variables" type mappedVariablesDo: [ :var | var decodingStatementInPlace: false using: g1]. "generate post-fetch initialization send" g1 addStatement: (g1 to: g1 forSelf send: #postFetchInitialize: withArg: (g1 literal: false)). g1 addStatement: g1 forSelf. ifPresentBlock := g1 generateBlockWithArgs: (Array with: rcvr with: record with: container) temps: #(). "generate ifAbsent decoder body" g1 := g fork. "generate decoding for reference and encoded attributes" type mappedVariablesDo: [ :var | var decodingStatementInPlace: true using: g1]. "generate decoding for all other local variables" type variables do: [ :var | var isMapped not ifTrue: [ var decodingStatementInPlace: true using: g1]]. "generate post-fetch initialization send" g1 addStatement: (g1 to: g1 forSelf send: #postFetchInitialize: withArg: (g1 literal: true)). g1 addStatement: g1 forSelf. ifAbsentBlock := g1 generateBlockWithArgs: (Array with: rcvr with: container) temps: #(). "emit the registration send" args add: (g literal: ifPresentBlock). args add: (g literal: ifAbsentBlock). g addStatement: (g to: container send: #register:withId:ifPresent:ifAbsent: withArgs: args asArray). ^g generateBlockWithArgs: (Array with: rcvr with: record with: container) temps: temps asArray
decoderForPackedType: type using: g "Generate decoder for directly-mapped type." | container rcvr | g reset. rcvr := g variable: 'SELF'. container := g variable: 'CONTAINER'. "generate decoding for variables" type variables do: [ :var | var decodingStatementInPlace: true using: g]. g addStatement: g forSelf. ^g generateBlockWithArgs: (Array with: rcvr with: container) temps: #()
decoderForType: type using: g "Generate decoder for directly-mapped type." ^type isMapped ifTrue: [self decoderForMappedType: type using: g] ifFalse: [self decoderForPackedType: type using: g]
encoderForType: type using: g "Generate encoder for directly-mapped type." | session object encodingIsTrivial rcvr | g reset. rcvr := g variable: 'SELF'. object := g variable: 'OBJECT'. session := g variable: 'SESSION'. encodingIsTrivial := type isMapped not. type mappedVariablesDo: [ :var | var encodingStatementUsing: g ifNonTrivial: [encodingIsTrivial := false]]. g addStatement: g forSelf. ^"(encodingIsTrivial and: [type isMapped])" encodingIsTrivial ifTrue: [nil] ifFalse: [ g generateBlockWithArgs: (Array with: rcvr with: object with: session) temps: #() ]
externalIdClosureFor: type using: g "Generate externalId closure for type." | idVariable idVariables session rcvr | g reset. idVariable := type idVariable. rcvr := g variable: 'SELF'. session := g variable: 'SESSION'. ^(idVariables := type idVariables) size > 1 ifFalse: [ "if simple variable, just return it or its external id" g addStatement: (idVariable isReference ifTrue: [ g to: (g variable: idVariable name) send: #externalId ] ifFalse: [ g variable: idVariable name ]). g generateBlockWithArgs: (Array with: rcvr with: session) temps: #()] ifTrue: [ | id i | "otherwise, must create id array" i := 0. id := g variable: 'ID'. g addStatement: (g assign: id value: (g to: (g variable: 'Array') send: #new: withArg: (g literal: idVariables size))). idVariables do: [ :var | | extIdValue | extIdValue := g variable: var name. var isReference ifTrue: [ extIdValue := g to: session send: #externalIdOf:inContainerOf: withArgs: (Array with: extIdValue with: (g literal: var valueType)) ]. g addStatement: (g to: id send: #at:put: withArgs: (Array with: (g literal: (i := i + 1)) with: (extIdValue))) ]. g addStatement: id. g generateBlockWithArgs: (Array with: rcvr with: session) temps: (Array with: id) ]
</methods> <methods> Lens.LensSQLTransporter class <category>accessing</category>
functionNameFor: aSymbol "Looks into the functions dictionaries to find the name associated with the given symbol. Note that since each class holds it's own functions dictionary, different names can be used for different transporters" functions do: [:dict | | nm | nm := dict at: aSymbol ifAbsent: [nil]. nm notNil ifTrue: [^nm]]. ^nil
functionsDictionaries "This access method is here, breaking encapsulation, to allow the QueryEditor to use the dictionary to create a menu with all the entries" ^functions
</methods> <methods> Lens.LensSQLTransporter class <category>class initialization</category>
initialize "LensSQLTransporter initialize" OperatorTable := IdentityDictionary new. OperatorTable at: #Count put: 'COUNT'. OperatorTable at: #Min put: 'MIN'. OperatorTable at: #Max put: 'MAX'. OperatorTable at: #Average put: 'AVG'. OperatorTable at: #Sum put: 'SUM'. OperatorTable at: #StandardDeviation put: 'STDDEV'. OperatorTable at: #Variance put: 'VARIANCE'. OperatorTable at: #isLike: put: ' LIKE '. OperatorTable at: #~= put: '!='. OperatorTable at: #in: put: ' IN '. OperatorTable at: #isNil put: ' IS NULL '. OperatorTable at: #notNil put: ' IS NOT NULL '. OperatorTable at: #& put: ' AND '. OperatorTable at: #| put: ' OR '. self initializeFunctionsTable
initializeFunctionsTable "The functions table is a class instance variable, hence all my sub-classes should call this method when initializing if they want to inherit parts of the table." "LensSQLTransporter initializeFunctionsTable" | dict | functions := IdentityDictionary new. functions at: #Number put: (dict := IdentityDictionary new). dict at: #round put: 'ROUND'. dict at: #trunc put: 'TRUNC'. functions at: #Character put: (dict := IdentityDictionary new). dict at: #length put: 'LENGTH'. functions at: #Conversion put: (dict := IdentityDictionary new). functions at: #Date put: (dict := IdentityDictionary new).
</methods> <methods> Lens.LensStreamList <category>private-collection accessing</category>
moveDown: anAmount fromIndex: anIndex self tryGettingAt: anIndex. ^super moveDown: anAmount fromIndex: anIndex
moveElementsFrom: aCollection ofSize: cSize toMyCollectionStartingAt: anIndex self tryGettingAt: anIndex + cSize. ^super moveElementsFrom: aCollection ofSize: cSize toMyCollectionStartingAt: anIndex
privateAddLast: anObject self retrieveAll. ^super privateAddLast: anObject
privateAt: anIndex self tryGettingAt: anIndex. ^super privateAt: anIndex
privateAt: anIndex put: anObject self tryGettingAt: anIndex. ^super privateAt: anIndex put: anObject
privateIndexOf: anElement ifAbsent: exceptionBlock "Answer the index of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the exceptionBlock." "The loop is implemented with a whileTrue: message because each time we send the message tryGettingAt: the limit may be changing. 'tryGettingAt: i' assures that the limit will be at least i if there are any elements left to retrieve from the stream" | i | i := 1. [i <= limit] whileTrue: [self tryGettingAt: i. (collection at: i) = anElement ifTrue: [^i] ifFalse: [i := i + 1]]. ^exceptionBlock value
privateInsertObject: anObject beforeIndex: anIndex self tryGettingAt: anIndex. ^super privateInsertObject: anObject beforeIndex: anIndex
privateRemoveIndex: anIndex self tryGettingAt: anIndex. ^super privateRemoveIndex: anIndex
privateRemoveIndex: start to: stop returnElements: returnBoolean self tryGettingAt: stop. ^super privateRemoveIndex: start to: stop returnElements: returnBoolean
</methods> <methods> Lens.LensStreamList <category>removing</category>
removeAllSuchThat: aBlock "First retrieve them all" self retrieveAll. ^super removeAllSuchThat: aBlock
removeAtIndex: anIndex "First try to make sure we retrieved the object at the given index" self tryGettingAt: anIndex. ^super removeAtIndex: anIndex
removeFirst: numElements self tryGettingAt: numElements. ^super removeFirst: numElements
removeFrom: start to: stop returnElements: returnBoolean self tryGettingAt: stop. ^super removeFrom: start to: stop returnElements: returnBoolean
removeLast "It should be noted that add: is no longer equivalent to addLast:, therefore 'add: anObject, removeLast' is not a NOOP" self retrieveAll. ^super removeLast
removeLast: numElements self retrieveAll. super removeLast: numElements
</methods> <methods> Lens.LensStreamList <category>copying</category>
postCopy "first retrieve them all, then let List copy the collection. This could be implemented differently but it would be wrong to share the stream or share the colection" self retrieveAll. ^super postCopy
</methods> <methods> Lens.LensStreamList <category>enumerating</category>
do: aBlock "Since a do: loop could potentially terminate before going through all the elements, in some cases retrieving all the objects is an overkill, but in any case the behavior will be correct" self retrieveAll. ^super do: aBlock
reverseDo: aBlock self retrieveAll. ^super reverseDo: aBlock
select: aBlock self retrieveAll. ^super select: aBlock
</methods> <methods> Lens.LensStreamList <category>private</category>
getNextChunk "Get the next chunk of objects from the stream and put them into the collection. Note that the 'add:' message is used, so the changes in the collection are notified to any dependents" | i | i := 0. [i < self chunkSize and: [stream atEnd not]] whileTrue: [self add: stream next. i := i + 1]
insertCollection: aCollection before: anIndex self tryGettingAt: anIndex. ^super insertCollection: aCollection before: anIndex
retrieveAll "Get all the elements until the stream is empty. This may take some time..." [stream atEnd] whileFalse: [self getNextChunk]
tryGettingAt: anIndex "To make the ilusion of having all the elements here more realistic, we try to retrieve a few (2) objects after the last one we are asked for, this way applications that behave differently on the last element or the element just before last will still work correctly. Applications that count 2 or more before the last may be affected. This problem is caused by the impelmentation of the 'size' method, which returns the current size of the collection (the real size can not be known unless all the objects are retrieved)" [anIndex + 2 >= limit and: [stream atEnd not]] whileTrue: [self getNextChunk]
</methods> <methods> Lens.LensStreamList <category>adding</category>
add: anObject "Note that we are calling 'super privateAddLast: anObject' and not 'super add: anObject'. This is done because we are changing the meaning of add:, for List it is equivalent to addLast:, here we want it to add anObject to the end of the currently fetched objects" limit = collectionSize ifTrue: [self growCollection]. ^super privateAddLast: anObject
add: anObject beforeIndex: anIndex "try getting to anIndex before proceeding" self tryGettingAt: anIndex. ^super add: anObject beforeIndex: anIndex
addAll: aCollection beforeIndex: anIndex "try getting to anIndex before proceeding" self tryGettingAt: anIndex. ^super addAll: aCollection beforeIndex: anIndex
addAllLast: aCollection self retrieveAll. ^super addAllLast: aCollection
addLast: anObject self retrieveAll. ^super addLast: anObject
changeSizeTo: anInteger "It is clear that the behavior implemented here is not the only one acceptable, we try to get from the stream objects to fill the collection to at least the size given before proceeding" self tryGettingAt: anInteger. ^super changeSizeTo: anInteger
</methods> <methods> Lens.LensStreamList <category>accessing</category>
at: anIndex "Answer the element at index anIndex." ^self privateAt: anIndex
capacity ^collection size
chunkSize "We set the default to be 6, which gives a small sliding window ahead of the last accessed element" chunkSize isNil ifTrue: [chunkSize := 6]. ^chunkSize
chunkSize: aNumber "Note that the chunkSize can be changed even after some objects have been retrieved from the stream, allowing for this list to be used in an adaptable fashion, for example, fetching bigger and bigger chunks as the collection grows (or smaller and smaller)" chunkSize := aNumber
last "Answer the last element. In this case we have to retrieve all from the stream" self retrieveAll. ^super last
replaceFrom: start to: stop with: replacement startingAt: repStart "Try getting at least as many elements as needed to get to stop position" self tryGettingAt: stop. ^super replaceFrom: start to: stop with: replacement startingAt: repStart
stream: aStream stream := aStream. stream atEnd ifFalse: [self getNextChunk]
</methods> <methods> Lens.LensStreamList class <category>instance creation</category>
new "Answer a new empty instance of the receiver." ^self new: 5
new: sizeInteger "Answer a new empty instance of the receiver. The size is determined by the actual number of stored elements. Creating an instance using new: results in an empty collection, regardless of the size declared." ^super basicNew setCollection: (Array new: sizeInteger) limit: 0
new: size withAll: value "Answer a new instance of the receiver whose every element is equal to the argument, value." ^super new setCollection: (Array new: size withAll: value ) limit: size
withSize: size "Override, because this class distinguishes between size and capacity." ^(self new: size) changeSizeTo: size
</methods> <methods> Lens.LensDataManager <category>accessing</category>
baseQuery "Return the basic query for the receiver. Automatically generated versions of this method return all rows of the appropriate type." ^self ownQuery
isCreating "Say whether or not the receiver is currently in the process of creating a new row." ^isCreating isNil ifTrue: [isCreating := false] ifFalse: [isCreating]
isCreating: aBoolean "Establish that the receiver is or is not in the process of creating a new row, according to aBoolean." isCreating := aBoolean. self changed: #applicationState with: (isCreating ifTrue: [#creating] ifFalse: [#browsing])
isDirty "Say whether the receiver's user interface has sustained any changes that need to be sent through to the underlying persistent object(s) in its row." ^isDirty isNil ifTrue: [isDirty := false] ifFalse: [isDirty]
isDirty: aBoolean "Establish that the receiver's user interface has or has not yet sustained any changes that need to be sent through to the underlying persistent object(s) in its row." isDirty := aBoolean. self changed: #applicationState with: (isDirty ifTrue: [#dirty] ifFalse: [#clean])
isEditing "Say whether or not the receiver is currently in the process of editing an existing row." ^isEditing isNil ifTrue: [isEditing := false] ifFalse: [isEditing]
isEditing: aBoolean "Establish that the receiver is or is not in the process of editing an existing row, according to aBoolean." isEditing := aBoolean. self changed: #applicationState with: (isEditing ifTrue: [#editing] ifFalse: [#browsing])
lockPolicy "The lock policy says whether locks will be set for updates at the point where editing begins or at the point where changes are accepted. The lock policy is either the lock policy of the parent or the inherent lock policy of the receiver's class." ^lockPolicy isNil ifTrue: [lockPolicy := self getLockPolicy] ifFalse: [lockPolicy]
lockPolicy: aSymbol "Establish the lock policy of the receiver. This says whether locks will be set for updates at the point where editing begins or at the point where changes are accepted." lockPolicy := aSymbol
ownQuery "This method should be redefined by subclasses. It should return a QueryOperation. Typically this method will be edited using the QueryEditor rather than a browser." self subclassResponsibility
rowType "Return a LensType or Array of LensTypes generically describing the row of the receiver." ^self class rowType
trigger "The ValueModel used to trigger the BufferedValueHolders underlying the columns or fields of the user interface." ^trigger
</methods> <methods> Lens.LensDataManager <category>rows</category>
initializeRow: newRow "The default is that no initialization is needed for a newly created row. This method should be redefined in subclasses that require row initialization (e.g. installation) that is over and above what can be provided by the row's own initialization method (e.g. the row is an Array resulting from a joined query, or contains computed information)." ^newRow
newRow "Create and return a new row. If the receiver's rowType refers to a non-existent class, a signal will result." | ocls rw | ocls := self rowType collect: [:type | self class environment at: type referredName]. ocls size > 1 ifTrue: [rw := Array new: ocls size. 1 to: ocls size do: [:i | rw at: i put: (ocls at: i) new]] ifFalse: [rw := ocls first new]. ^rw
noMoreRows Dialog warn: (#noMoreRows << #lens >> 'No more rows') for: builder window
noPreviousRow Dialog warn: (#firstRowIsShown << #lens >> 'First row is shown') for: builder window
</methods> <methods> Lens.LensDataManager <category>actions</category>
accept "Properly terminate any current editing or creating process in the receiver." self isCreating ifTrue: [self endCreating]. self isEditing ifTrue: [self endEditing]
addRow "Make sure we have a lensSession. Put a new row into rows (but do not yet do an insertion into the database). Create an empty initialized row, add it to the list and make sure it is selected." self session notNil ifTrue: [| nr | self isCreating ifTrue: [^self]. self isCreating: true. nr := self newRow. self initializeRow: nr. self rows list add: nr. self rows selectionIndex: self rows list size. self isDirty: true. self setEnablement]
cancel "Cancel any current editing or creating process in the receiver, undoing its effects as much as possible. Since no explicit copy of the receiver's row is made prior to editing, cancellation of an edit requires refreshing the row from the database." | win failed temp | builder notNil ifTrue: [win := builder window]. failed := false. self isEditing ifTrue: [self handleLens: [:exc | exc return. failed := true] do: [LensSession rowForObjectNotFoundSignal handle: [:exc | Dialog warn: (#rowNoLongerExistsInDatabase << #lens >> 'The row being edited no longer exists in the database.') for: win. self unbufferEdits: false. self removePhantom. self isEditing: false. exc return] do: [self refreshRow. self unbufferEdits: false. self isEditing: false]]] ifFalse: [self isCreating ifTrue: [self isCreating: false. self unbufferEdits: false. self rows list remove: self row value ifAbsent: []. self rows selectionIndex: self rows list size] ifFalse: [^self]]. failed ifTrue: [^self]. (builder notNil and: [(temp := builder keyboardProcessor) notNil and: [(temp := temp currentConsumerChannel value) ~= 0 ]]) ifTrue: [temp deactivate]. self setEnablement
clearRows "Clear both internal state and display, forgetting all the rows that have been fetched to this point." self cancel. self rowsList: Array new
firstRow "Select the first row" rows selectionIndex: 1.
lastRow "Select the last row" rows selectionIndex: rows list size.
nextPageRow "Move the selection 'pageSize' forward." | wanted | wanted := rows selectionIndex + self pageSize. wanted > rows list size ifTrue: [rows selectionIndex: rows list size] ifFalse: [rows selectionIndex: wanted]
nextRow "Select the next row, if the selected is the last one then popUp a warning" | wanted | wanted := rows selectionIndex + 1. wanted > rows list size ifTrue: [self noMoreRows] ifFalse: [rows selectionIndex: wanted].
performQuery "Executing the query returns a List, hence it's contents are given as the list in the rows (which is a SelectionInList instance)" self handleLens: [:ex | ex return] do: [self session notNil ifTrue: [Cursor database showWhile: [self rowsList: (self baseQuery session: self session) values]. self setEnablement]]
performQueryWithParent "Get the parent to do our query, combining it with its own restricting query." self parent isNil ifTrue: [self performQuery] ifFalse: [self handleLens: [:ex | ex return] do: [parent fetchFor: self]]
prevPageRow "Move the selection 'pageSize' backwards." | wanted | wanted := rows selectionIndex - self pageSize. wanted <= 0 ifTrue: [rows selectionIndex: 1] ifFalse: [rows selectionIndex: wanted].
prevRow "Select the previous row. If there isn't one, popup a warning" | wanted | wanted := rows selectionIndex - 1. wanted <= 0 ifTrue: [self noPreviousRow] ifFalse: [rows selectionIndex: wanted].
removeRow "Remove the receiver's current row from the database. Start the transaction explicitly, since the Mixed LensPolicy will otherwise immediately commit the removal." | oldIndex oldRow failed | failed := false. oldIndex := self rowIndex value. oldRow := self row value. Cursor database showWhile: [self handleLens: [:ex | failed := true] do: [self ensureTransaction. LensSession rowForObjectNotFoundSignal handle: [:exc | self removePhantom. exc return] do: [self lockRow. self rowType size > 1 ifTrue: [oldRow do: [:elt | self existingSession remove: elt ifAbsent: []]] ifFalse: [self existingSession remove: oldRow ifAbsent: []]]]]. failed ifFalse: [self rows list remove: oldRow ifAbsent: []. self rowIndex value: (self rows list size min: oldIndex)]
startEditing "Start the process of editing the receiver's current row. Setting isEditing to true will enable focus entry." | failed | failed := false. self isEditing ifTrue: [^self]. self lockPolicy == #lockOnEdit ifTrue: [self handleLens: [:exc | failed := true] do: [self lockRow. self refreshRow]]. failed ifFalse: [self isEditing: true. self setEnablement]
stopEditing "Absolutely stop any current editing or creating process in the receiver, forcing the user to make a choice as to whether to accept or commit any unaccepted changes. Resorted to when the parent's row changes and the (synchronized) receiver must change state." | window | (builder isNil or: [(window := builder window) isNil]) ifTrue: [^self]. (self isEditing or: [self isCreating]) ifTrue: [self isDirty ifTrue: [(Dialog choose: (#rowAltered << #lens >> 'The current row has been altered. Accept the changes or cancel them?') labels: (Array with: (#Accept << #lens >> 'Accept') with: (#Cancel << #lens >> 'Cancel')) values: #(true false) default: false for: window) ifTrue: [self accept] ifFalse: [self cancel]] ifFalse: [self cancel]]. self isDirty ifTrue: ["Accept has failed. If we are here because of a row change in our parent, there will be no handler above us, no way to stop the change, and we must make do." Signal noHandlerSignal handle: [:ex | ex parameter signal == LensSession doNotProceedSignal ifTrue: [self isDirty: false; isEditing: false; isCreating: false. self setEnablement. ex return]] do: [LensSession doNotProceedSignal raise]]
</methods> <methods> Lens.LensDataManager <category>aspects</category>
editing "A Model (e.g. suitable for a check box) that both indicates and controls entry to and exit from edit mode." ^(PluggableAdaptor on: self) getBlock: [:m | m isEditing] putBlock: [:m :v | v ifTrue: [m startEditing] ifFalse: [m stopEditing]] updateBlock: [:m :a :p | a == #isEditing]
row "Returns the valueHolder used as subjectChannel by AspectAdaptors that access database columns. This value holder is synchronized with the selectionIndexHolder of the receiver's 'rows' SelectionInList selectionIndexHolder, so that it always holds the currently selected row." ^row
rowCount "Return a PluggableAdaptor whose value is the number of rows currently contained by rows. Make the addaptor a dependent on the current list of rows so that the count will be properly updated when the size changes." rowCount isNil ifTrue: [rowCount := (PluggableAdaptor on: rows listHolder) getBlock: [:m | m value size] putBlock: [:m :v | ] updateBlock: [:m :a :p | true]. rows list notNil ifTrue: [rows list addDependent: rowCount]]. ^rowCount
rowIndex "Returns a valueModel holding the index of the currently selected row." ^rows selectionIndexHolder
rows "rows is the SelectionInList that contains the row objects being managed." ^rows
rowsList: aCollectionOrNil "Used to set the value of the rows model, e.g. when performing a fetch. Changing the value of our rows model may cause the row model to change, and the rows and/or row models of any children to change also, causing them in turn to stopEditing. If aCollectionOrNil is not a List, it is put into one so we get the updates for any changes in the list." | rowCounter | (builder isNil or: [builder window isNil]) ifTrue: [^self]. self stopEditing. (rowCounter := self builder componentAt: #rowCount) notNil ifTrue: [rows list removeDependent: rowCounter widget]. aCollectionOrNil isNil ifTrue: [self rows listHolder value: List new] ifFalse: [self rows listHolder value: ((aCollectionOrNil isKindOf: List) ifTrue: [aCollectionOrNil] ifFalse: [(List withAll: aCollectionOrNil)]). aCollectionOrNil size > 0 ifTrue: [self rows selectionIndexHolder value: 1]]. rowCounter notNil ifTrue: [rows list addDependent: rowCounter widget]. self setEnablement
rowValue: aRow "Used to set the value of the row model from outside the receiver, e.g. when the parent's row changes." | rowCounter | self cancel. self builder notNil ifTrue: [rowCounter := self builder componentAt: #rowCounter]. rowCounter notNil ifTrue: [self rows list removeDependent: rowCounter widget]. self rows listHolder setValue: (aRow isNil ifTrue: [List new] ifFalse: [List with: aRow]). self rows selectionIndexHolder setValue: 1. aRow isNil ifTrue: [self rowIndex value: 0. self rowCount value: 0] ifFalse: [self rowIndex value: 1. self rowCount value: 1]. self selectionChanged. rowCounter notNil ifTrue: [self rows list addDependent: rowCounter widget]
</methods> <methods> Lens.LensDataManager <category>private</category>
autoFetchFor: aChild "Sent by the child to its parent to cause the parent to perform a fetch for it, using the parent's restricting query for that child, when the child's window is opened. The message is always sent when the window opens. Whether the fetch occurs or not depends on the child's autoFetch property. This method is usually generated automatically by UIDefiner." self subclassResponsibility
confirmDiscardAlteredRow | window | builder notNil ifTrue: [window := builder window]. ^Dialog confirm: (#rowAlteredDiscardChanges << #lens >> 'The current row has been altered. Do you wish to discard those changes?') for: window
endCreating "Setting isCreating to true will enable focus entry." self isCreating ifFalse: [^self]. self isDirty ifTrue: [Cursor database showWhile: [self handleLens: [:exc | exc return] do: [[self ensureTransaction. self unbufferEdits: true. self ensureRowIsPersistent. self isCreating: false. self setEnablement] ifCurtailed: [self isDirty: true. self existingSession remove: row value ifAbsent: []]]]]
endEditing "An orderly end to the editing process. Used by the accept method." self isEditing ifFalse: [^self]. self isDirty ifTrue: [self handleLens: [:exc | exc return] do: [[self ensureTransaction. self lockPolicy == #lockOnAccept ifTrue: ["The database will lock the row soon anyway. Lock here explicitly so that if the row is already locked we will get a signal rather than waiting for it to free." self lockRow]. self unbufferEdits: true. self postUpdatesInRow. self isEditing: false. self setEnablement] ifCurtailed: [self isDirty: true]]] ifFalse: [self isEditing: false. self setEnablement]
ensureRowIsPersistent row value notNil ifTrue: [self rowType size > 1 ifTrue: [row value do: [:obj | self existingSession add: obj]] ifFalse: [self existingSession add: row value]]
fetchFor: aChild "Sent by the child to its parent to cause the parent to perform a fetch for it, using the parent's restricting query for that child. This method is usually generated automatically by UIDefiner." self subclassResponsibility
getLockPolicy "The lock policy is either the lock policy of the parent or the inherent lock policy of the receiver's class." ^self parent isNil ifTrue: [self class lockPolicy] ifFalse: [self parent lockPolicy]
indexForTag: tag "tag is a symbol that is the name of the container reference. Returns the index of that object in the rowType, if the rowType size is larger than 1" | rt | rt := self rowType. rt size > 1 ifTrue: [| i | i := 0. rt do: [:r | i := i + 1. r name == tag ifTrue: [^i]]]. ^0
lockRow "Lock the database row(s) underlying the receiver's current row." Cursor database showWhile: [self rowType size == 1 ifTrue: [self row value lock] ifFalse: [self row value do: [:elt | elt lock]]]. self refreshDisplay
openTemporaryLauncher "Open a small ersatz launcher to support independent debugging of DataForms." | dsg cl sel main preferredDisplayBox | dsg := self class temporaryMainDesignator. ((cl := (self class environment at: (dsg at: 1) ifAbsent: [])) isNil or: [sel := dsg at: 2. (Object messageNotUnderstoodSignal handle: [:ex | ex parameter selector == sel ifTrue: [ex return: nil] ifFalse: [ex reject]] do: [cl perform: sel]) isNil]) ifTrue: [cl := LensTemporaryMain. sel := #windowSpec]. (main := cl new) allButOpenInterface: sel. preferredDisplayBox := Rectangle origin: self builder window globalOrigin - (0 @ (main builder window height + 44)) extent: main builder window width @ main builder window height. "Position the launcher on the same monitor as the main window so that it is entirely on the monitor." preferredDisplayBox := preferredDisplayBox translatedBy: (preferredDisplayBox amountToTranslateWithin: (self builder window graphicsDevice preferredRectangleToConstrain: self builder window displayBox)). main finallyOpenIn: preferredDisplayBox withType: #normal. self parent: main
pageSize "This method returns the number of rows to jump when moving the selection a page at a time. Redefine on subclasses as desired." ^3
postUpdatesInRow "Make sure any changes made to the persistent object(s) underlying the receiver's current row are posted to the database." Cursor database showWhile: [row value notNil ifTrue: [self rowType size > 1 ifTrue: [row value do: [:obj | obj postUpdates]] ifFalse: [row value postUpdates]]]
raiseIfChanging "Raise/expand a collapsed window when inquiring what to do about untransacted changes." (builder window notNil and: [self isEditing or: [self isCreating]]) ifTrue: [builder window isCollapsed ifTrue: [builder window expand] ifFalse: [builder window raise]]
refreshDisplay "The underlying object has probably changed internally due to the actions of the ObjectLens, but there was of course no dependency alert. We must now jiggle the handles to get the user interface to notice the change. DataSetViews require special handling." self row value: self row value. self rows list changed: #value with: #reset
refreshRow "Refresh the persistent object(s) underlying the receiver's current row from the database." Cursor database showWhile: [self rowType size == 1 ifTrue: [self existingSession refresh: row value] ifFalse: [self row value do: [:elt | self existingSession refresh: elt]]]. self refreshDisplay
removeChild: aChild "Remove anApplication from the receiver's set of children. Be sure to undo whatever dependency the child nmay have had on our row holder" super removeChild: aChild. row removeDependentsFor: aChild
removePhantom "The current row is no longer present in the database, and the appropriate thing to do is to drop the references we are aware of, revert it (so that future attempts to reach it from other references will cause errors) and remove its unposted changes from the session." | oldIndex oldRow | oldIndex := self rowIndex value. oldRow := self row value. oldRow isNil ifTrue: [^self]. self rowType size > 1 ifTrue: [oldRow do: [:elt | self existingSession revertDiscardingUnpostedUpdates: elt]] ifFalse: [self existingSession revertDiscardingUnpostedUpdates: oldRow]. self rows list remove: oldRow ifAbsent: []. self rowIndex value: (self rows list size min: oldIndex).
setEnablement "Enable or disable the buttons in the receiver's user interface according to its current state." | sz sel | self builder isNil ifTrue: [^self]. sz := rows list size. sel := rows selectionIndex. (self isEditing or: [self isCreating]) ifTrue: [self enable: true group: #(#accept #cancel ). self enable: false group: #(#removeRow #startEditing #addRow #performQuery #firstRow #nextRow #nextPageRow #lastRow #prevRow #prevPageRow). ^self]. self enable: sel < sz group: #(#nextRow #nextPageRow #lastRow ). self enable: sel > 1 group: #(#prevRow #prevPageRow #firstRow). self enable: sel ~~ 0 group: #(#removeRow #startEditing). self enable: true group: #(#addRow #performQuery). self enable: false group: #(#accept #cancel).
unbufferEdits: accepting "If accepting then flush the buffers into their subjects, otherwise reset the buffers from their subjects." self trigger value: accepting. self isDirty: false.
</methods> <methods> Lens.LensDataManager <category>events</category>
confirmationOfCommit "The current transaction has been committed, so cancel any unaccepted changes, unless commits with unaccepted changes are allowed, in which case cancel the changes only if the row was locked for being edited, as we will have lost the lock when the commit happened." (self patriarch allowPartialCommit not or: [self isEditing and: [lockPolicy == #lockOnEdit]]) ifTrue: [self cancel]
confirmationOfRollback "The current transaction has been rolled back. Clear both the receiver's display and internal state. This is the default because of rollback's greater potential for causing staleness. The correct response is generally application dependent." self clearRows
explicitFocusInRequest "Used to implement the 'If Told' edit policy. Say whether input focus can be allowed to enter input fields or columns used to edit the receiver's current row." ^self isCreating | self isEditing
focusInRequest "Used to implement the 'If Touched' edit policy. Permits focus to enter the fields or columns used to edit the receiver's current row providing only that there is a current row. Starts the editing process." self isCreating | self isEditing ifTrue: [^true]. self row value isNil ifTrue: [^false]. self startEditing. ^true
localRequestForWindowClose "Permit the closure if the widgets and buffers contain no changes." ^self builder notNil and: [self builder keyboardProcessor notNil and: [self builder keyboardProcessor requestGlobalAutoAccept and: [self isDirty not]]]
noticeOfWindowClose: aWindow "Our window has closed. Shut down any temporary launcher." | par | par := self parent. super noticeOfWindowClose: aWindow. (par isKindOf: LensTemporaryMain) ifTrue: [par closeRequest]
requestForCommit "Permit a commit only if we are not actively editing or creating. If commits with unaccepted changes are allowed, permit the commit only if a locked row is not being edited." ^(self isCreating not and: [self isEditing not]) or: [self patriarch allowPartialCommit and: [self isEditing not or: [(self lockPolicy == #lockOnEdit) not]]]
requestForLogout "Permit logging out if the widgets and buffers contain no changes" ^self builder notNil and: [self builder keyboardProcessor notNil and: [self builder keyboardProcessor requestGlobalAutoAccept and: [self isDirty not]]]
requestForRollback "Permit the rollback only if the buffers contain no changes" (self builder notNil and: [self builder keyboardProcessor notNil]) ifTrue: [self builder keyboardProcessor requestGlobalAutoAccept]. ^self isDirty not
rowChangeRequest "The user would like to select a new row. Provide for orderly termination if editing or creating the receiver's current row." ((self isEditing and: [self isDirty]) or: [self isCreating]) ifTrue: [self confirmDiscardAlteredRow ifTrue: [self cancel. ^true] ifFalse: [^false]] ifFalse: [self isEditing ifTrue: [self cancel]. ^true]
selectionChanged "The selection within rows has changed. Change the row model to match." self row value ~~ self rows selection ifTrue: [self row value: self rows selection. self setEnablement]
valueChanged "Changes have been accepted into the buffers underlying the receiver's user interface (but they have not yet been passed through into the persistent object(s) underlying the receiver's current row." (self isEditing or: [self isCreating]) ifTrue: [self isDirty: true] ifFalse: [self unbufferEdits: false]
</methods> <methods> Lens.LensDataManager <category>interface opening</category>
openDialogWithSpec: aSpecName "Opens the interface specified by aSpecName as a dialog with the OK and Cancel buttons. Returns true if the user pressed OK and False if the user pressed Cancel." | sd spec dialogSpec | sd := SimpleDialog new. sd builder aspectAt: #dialogSubCanvasClient put: self. sd builder subCanvasAt: nil at: #dialogSubCanvas put: (spec := self class interfaceSpecFor: aSpecName). dialogSpec := self class interfaceSpecFor: #dialogSpec. dialogSpec window label: spec window label. sd allButOpenFrom: dialogSpec. sd builder openDialogWithExtent: spec window bounds extent + (0 @ 30). ^sd accept value
postBuildWith: aBuilder "Get the parent to synchronize the receiver and do 'Fetch on Open' for the receiver. Check for the existence of the parent, in case the receiver is opened as if it were a top-level application." super postBuildWith: aBuilder. self parent notNil ifTrue: [self parent synchronize: self. self handleLens: [:exc | exc return] do: [self parent autoFetchFor: self]]
postOpenWith: aBuilder "The receiver is just a DataForm. Open a temporary launcher in order to provide controls for session and transaction management." self parent isNil ifTrue: [self openTemporaryLauncher]. super postOpenWith: aBuilder
</methods> <methods> Lens.LensDataManager <category>initialize-release</category>
initialize "Initialize the receiver." super initialize. row := LensRowHolder new. trigger := nil asValue. rows := SelectionInList new. rows selectionIndexHolder compute: [self selectionChanged]
</methods> <methods> Lens.LensDataManager class <category>binding</category>
aspectPathClass "Answer a class for parsing and interpreting compound aspects." ^LensAspectPath
</methods> <methods> Lens.LensDataManager class <category>accessing</category>
editPolicy "This method is overridden by automatically generated accessors on subclasses of DataManager." self subclassResponsibility
lockPolicy "This method is overridden by automatically generated accessors on subclasses of DataManager." ^#lockOnAccept
rowType "Returns a collection of UIDataReferences that relate the LensTypes describing the rows of the application. This method will generally be overridden by automatically generated accessors on subclasses of LensDataManager." self subclassResponsibility
</methods> <methods> Lens.LensDataManager class <category>private</category>
excludedBindings "Return a list of those models (including actions) already inherited by subclasses of this class, which should not be generated for them by UIDefiner." ^super excludedBindings , #(#rows #row #rowCount #rowIndex #trigger #removeRow #addRow #clearRows #performQuery #firstRow #lastRow #nextRow #prevRow #accept #cancel #editing #startEditing)
generateFormSpecFrom: anApplicationSpec usingTemplate: specName "This method generates canvases from templates based on InputFields." | replicator fullSpec cellDimensions cellDimensionsSpec maxAperture cellTemplate fiducial elements newComponents | replicator := self specReplicator. replicator editPolicy: anApplicationSpec editPolicy. (fullSpec := self interfaceSpecFor: specName) isNil ifTrue: [^nil]. cellDimensions := (cellDimensionsSpec := fullSpec component collection detect: [:elt | elt name == #cellBounds] ifNone: [^nil]) layout. maxAperture := fullSpec window bounds extent. cellTemplate := fullSpec component collection detect: [:elt | ((elt isKindOf: CompositeSpecCollection) and: [elt compositeSpec name == #cellContents])] ifNone: [^nil]. fiducial := (0 - cellDimensions extent x) @ 0. elements := anApplicationSpec fields collect: [:field | | result | fiducial := fiducial + (cellDimensions extent x @ 0). (fiducial x + cellDimensions extent x) > maxAperture x ifTrue: [fiducial x: 0. fiducial y: fiducial y + cellDimensions extent y]. (replicator offset: fiducial + cellTemplate compositeSpec layout origin; fieldSpec: field) doSpec: (result := cellTemplate copy). result]. newComponents := OrderedCollection new. elements do: [:csc | csc collection do: [:spec | newComponents add: spec]]. fullSpec component collection: (fullSpec component collection select: [:spec | spec ~~ cellDimensionsSpec and: [spec ~~ cellTemplate]]), newComponents. fullSpec window label: self name asString. ^fullSpec
generateFullSpecFrom: anApplicationSpec usingTemplate: specName "This method generates canvases for subclasses of LensDataManager." | fullSpec | fullSpec := FullSpec new fromLiteralArrayEncoding: (self perform: specName). ^(fullSpec component collection detect: [:spec | spec isKindOf: DataSetSpec] ifNone: []) notNil ifTrue: [self generateTabularSpecFrom: anApplicationSpec usingTemplate: specName] ifFalse: [self generateFormSpecFrom: anApplicationSpec usingTemplate: specName]
generateTabularSpecFrom: anApplicationSpec usingTemplate: specName "This method generates canvases from templates based on DataSetViews." | replicator fullSpec tableSpec columnSpec elements ri | replicator := self specReplicator. replicator editPolicy: anApplicationSpec editPolicy. (fullSpec := self interfaceSpecFor: specName) isNil ifTrue: [^nil]. tableSpec := fullSpec component collection detect: [:elt | elt isKindOf: DataSetSpec] copy. ri := tableSpec rowIndicator. tableSpec rowIndicator: false. columnSpec := tableSpec columns detect: [:col | col label = '*']. elements := tableSpec. elements := anApplicationSpec fields collect: [:field | | result | (replicator fieldSpec: field) doSpec: (result := columnSpec copy). result]. tableSpec columns: elements. tableSpec rowIndicator: ri. tableSpec callbacksSpec requestValueChangeSelector: #rowChangeRequest. fullSpec window label: self name asString. ^fullSpec
rowType: anCollectionOrNil "Establish the LensTypes of the persistent objects underlying the receiver's rows." rowType := anCollectionOrNil
specReplicator ^LensSpecReplicator new
temporaryMainDesignator "This method can be overridden on subclasses in order to cause a different kind of temporary launcher to be provided." ^Array with: #LensTemporaryMain with: #windowSpec
writeEssentialsFor: anApplicationSpec using: definer into: codeStream definer writeDataManagerClassSideAccessors: anApplicationSpec on: codeStream. definer writeOwnQueryMethod: anApplicationSpec on: codeStream.
</methods> <methods> Lens.LensVariableReference <category>relationships</category>
elementLabel: hints ((hints includes: #simple) or: ["((referred valueType respondsTo: #isLensStructureType) and: [referred valueType isLensStructureType]) or: ["application isNil"]"]) ifTrue: [^super elementLabel: hints] ifFalse: [| chb | chb := CheckBoxSpec new. chb label: self name. chb model: ((PluggableAdaptor on: self) getBlock: [:c | application isSelected: cascade] putBlock: [:c :v | v ifTrue: [application selected: cascade] ifFalse: [application deselected: cascade]] updateBlock: [:b :a :p | true]). chb layout: LayoutOrigin new. ^Array with: chb]
relatedBy: token token == #containsColumnRel ifTrue: [children isNil ifTrue: [children := Set new. ((referred valueType respondsTo: #isLensStructureType) and: [referred valueType isLensStructureType]) ifTrue: [referred valueType mappedVariablesDo: [:st | | c | c := LensVariableReference on: st named: nil. c application: application. c cascade: cascade copy. application notNil ifTrue: [application addVarRef: c]. children add: c]]]. ^children]
sortKey referred notNil ifTrue: [^referred sortKey] ifFalse: [^'']
</methods> <methods> Lens.LensObjectRegistry <category>removing</category>
removeAll: aCollection "Remove each global descriptor in aCollection from the receiver. If successful for each, answer aCollection." aCollection isEmpty ifTrue: [ ^aCollection ]. accessLock critical: [aCollection do: [:gd | | obj index | (obj := gd object) isProxy ifTrue: [obj lensContainer: nil]. tally := tally - 1. keyArray at: (index := gd objectRegistryIndex) put: nil. self basicAt: index put: nil]. self rehash]. ^aCollection
removeObjectsIn: objectLens "Remove global descriptors for all objects in objectLens." | startingTally | startingTally := tally. self descriptorsIn: objectLens do: [:gd | | obj index | (obj := gd object) isProxy ifTrue: [obj lensContainer: nil]. tally := tally - 1. keyArray at: (index := gd objectRegistryIndex) put: nil. self basicAt: index put: nil]. tally == startingTally ifFalse: [ self rehash ]
</methods> <methods> Lens.LensObjectRegistry <category>enumerating</category>
descriptorsIn: objectLens do: aBlock "Invoke aBlock with each registry entry which belongs to objectLens." self keysAndValuesDo: [ :ignoredObject :gd | gd lensContainer lensSession == objectLens ifTrue: [ aBlock value: gd ] ]
</methods> <methods> Lens.LensObjectRegistry <category>accessing</category>
keyAtIndex: index "Answer the key at index or nil" index isNil ifTrue: [^nil]. ^accessLock critical: [keyArray at: index]
removeAtIndex: index "Remove the object and global descriptor at the given index." accessLock critical: [self removeAndCleanUpAtIndex: index]
</methods> <methods> Lens.LensObjectRegistry <category>private</category>
basicAt: index put: globalDescriptor "Store globalDescriptor in the indexable field of the receiver indexed by index. Overridden to maintain the objectRegistryIndex in the global descriptor." globalDescriptor isNil ifTrue: [ | gd | (gd := self basicAt: index) notNil ifTrue: [ gd objectRegistryIndex: nil ] ]. super basicAt: index put: globalDescriptor. globalDescriptor notNil ifTrue: [ globalDescriptor objectRegistryIndex: index ]. ^globalDescriptor
</methods> <methods> Lens.LensCollectionProxy <category>accessing</category>
class "Answer the class of the object represented by the receiver." ^IdentitySet
</methods> <methods> Lens.LensCollectionProxy <category>initialize-release</category>
query: aQuery lensContainer: aLensContainer parent: aParent "Initialize receiver's state." query := aQuery. lensContainer := aLensContainer. parent := aParent
</methods> <methods> Lens.LensCollectionProxy <category>private-ObjectLens</category>
isPersistent "Answer if receiver is persistent." ^false
</methods> <methods> Lens.LensCollectionProxy <category>printing</category>
printOn: stream "Append to stream a sequence of characters that identifies the receiver." super printOn: stream. stream nextPutAll: ' (parent='; print: parent; nextPut: $)
</methods> <methods> Lens.LensCollectionProxy <category>error handling</category>
doesNotUnderstand: aMessage "Trap the message, load and become the referenced object, then retry sending the message." | children | lensContainer isNil ifTrue: [ LensSession triggeringWhenNotOpenSignal raiseErrorString: (#proxyNotAssociatedWithSession << #lens >> 'Attempting to use a proxy which is not associated with any LensSession.') ]. LensSession sessionIsPausedSignal handle: [ :ex | LensSession triggeringWhenNotOpenSignal raiseErrorString: (#expandChildCollectionWhilePaused << #lens >> 'Attempting to expand a child collection via a LensSession that has been paused.') ] do: [ children := lensContainer transporter collectionFor: query withParent: parent. self become: children. ^self perform: aMessage selector withArguments: aMessage arguments ]
</methods> <methods> Lens.LensCollectionProxy class <category>instance creation</category>
query: query lensContainer: aContainer parent: parent "Answer new collection proxy that will issue the query on aContainer when triggered." ^self new query: query lensContainer: aContainer parent: parent
</methods> <methods> Lens.QueryStream <category>accessing</category>
next "Answer the next object, which may be cached in the peekBuffer." ^peekBuffer isNil ifTrue: [ decoder decodeFrom: super next lensContainer: lensContainer ] ifFalse: [ | tmp | tmp := peekBuffer. peekBuffer := nil. tmp ]
peek "Answer what would be returned with a self next, without changing position. If the receiver is at the end, answer nil." peekBuffer isNil ifTrue: [ super peek isNil ifTrue: [ ^nil ]. peekBuffer := decoder decodeFrom: super next lensContainer: lensContainer ]. ^peekBuffer
upToEnd "Answer a collection consisting of all the elements from the current position to the end of stream. NB: this method is necessary only because WriteStream>nextPut: fails when the collection is an instance of OrderedCollection or Set." | collection | collection := self contentsSpecies new: 64. [self atEnd] whileFalse: [collection add: self next]. ^collection
</methods> <methods> Lens.QueryStream <category>private-accessing</category>
contentsSpecies ^OrderedCollection
decoder: aDecoder decoder := aDecoder
lensContainer: aContainer lensContainer := aContainer
</methods> <methods> Lens.QueryStream <category>testing</category>
atEnd ^peekBuffer notNil ifTrue: [ false ] ifFalse: [ super atEnd ]
</methods> <methods> Lens.LensPolicy <category>accessing</category>
name "Answer the receiver's name." ^name
name: newName "Set the receiver's name to newName." name := newName
onUnconnectedOperation "Answer the receiver's onUnconnectedOperation." ^onUnconnectedOperation
onUnconnectedOperation: newOnUnconnectedOperation "Set the receiver's onUnconnectedOperation to newOnUnconnectedOperation." onUnconnectedOperation := newOnUnconnectedOperation
onUntransactedChange "Answer the receiver's onUntransactedChange." ^onUntransactedChange
onUntransactedChange: newOnUntransactedChange "Set the receiver's onUntransactedChange to newOnUntransactedChange." onUntransactedChange := newOnUntransactedChange
onUntransactedRead "Answer the receiver's onUntransactedRead." ^onUntransactedRead
onUntransactedRead: newOnUntransactedRead "Set the receiver's onUntransactedRead to newOnUntransactedRead." onUntransactedRead := newOnUntransactedRead
revertPersistentObjectsOnDisconnect "Answer the receiver's revertPersistentObjectsOnDisconnect." ^revertPersistentObjectsOnDisconnect
revertPersistentObjectsOnDisconnect: flag "Set the receiver's revertPersistentObjectsOnDisconnect." revertPersistentObjectsOnDisconnect := flag
transactionsAreSerializable "Answer the receiver's transactionsAreSerializable." ^transactionsAreSerializable
transactionsAreSerializable: newTransactionsAreSerializable "Set the receiver's transactionsAreSerializable to newTransactionsAreSerializable." transactionsAreSerializable := newTransactionsAreSerializable
</methods> <methods> Lens.LensPolicy <category>registration</category>
register "Register the receiver." PolicyRegistry at: name put: self
unregister "Unregister the receiver." (PolicyRegistry includes: self) ifTrue: [ PolicyRegistry removeKey: name]
</methods> <methods> Lens.LensPolicy <category>printing</category>
printOn: stream super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensPolicy <category>initialize-release</category>
initialize transactionsAreSerializable := false. onUntransactedRead := #beginTransaction. onUntransactedChange := #beginTransaction. onUnconnectedOperation := #resume. revertPersistentObjectsOnDisconnect := false
</methods> <methods> Lens.LensPolicy <category>copying</category>
postCopy name := ((#CopyOf1s << #lensRuntime >> 'Copy of <1s>') expandMacrosWith: name)
</methods> <methods> Lens.LensPolicy <category>private</category>
printNameOn: stream | nm | stream nextPutAll: (((nm := self name) == nil or: [nm isEmpty]) ifFalse: [nm] ifTrue: [(#unnamed << #lensRuntime >> 'unnamed')]) asString
</methods> <methods> Lens.LensPolicy class <category>class initialization</category>
initialize "LensPolicy initialize" PolicyRegistry := Dictionary new. "define standard policies" "self new name: #AutoStart; transactionsAreSerializable: false; onUntransactedRead: #readWithoutLocking; onUntransactedChange: #beginTransaction; register." "self new name: #SerializableAutoStart; transactionsAreSerializable: true; onUntransactedRead: #beginTransaction; onUntransactedChange: #beginTransaction; register." "self new name: #Serializable; transactionsAreSerializable: true; onUntransactedRead: #complain; onUntransactedChange: #complain; register." self new name: #Mixed; transactionsAreSerializable: false; onUntransactedRead: #readWithoutLocking; onUntransactedChange: #singlyTransact; register. "self new name: #BrowseUpdate; transactionsAreSerializable: false; onUntransactedRead: #readWithoutLocking; onUntransactedChange: #complain; register."
</methods> <methods> Lens.LensPolicy class <category>dialogs</category>
menu "Prompt user for schema from registry, answer item or nil if none selected.." | policies | policies := PolicyRegistry asArray. ^Menu labelList: (Array with: (policies collect: [:p | p name asText allBold])) values: policies
</methods> <methods> Lens.LensPolicy class <category>registration</category>
named: policyName "Answer the named policy." ^PolicyRegistry at: policyName
registry "Answer the registry of all policies." ^PolicyRegistry
</methods> <methods> Lens.LensPolicy class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensTransactionPolicy <category>accessing</category>
delayUpdatesUntilCommit: newFlag "Set whether it is the receiver's policy to delay updates until commit time." delayUpdatesUntilCommit := newFlag
name "Answer the receiver's name." ^name
name: newName "Set the receiver's name to newName." name := newName
presentedIsolationLevel "Return the policy for the receiver's presented isolation level." ^presentedIsolationLevel
presentedIsolationLevel: newIsolationLevel "Set the policy for the receiver's presented isolation level to newIsolationLevel." presentedIsolationLevel := newIsolationLevel
underlyingIsolationLevel "Return the policy for the receiver's underlying isolation level." ^underlyingIsolationLevel
underlyingIsolationLevel: newIsolationLevel "Set the policy for the receiver's underlying isolation level to newIsolationLevel." underlyingIsolationLevel := newIsolationLevel
verifyAtPostPolicy "Return the policy for how the receiver indicates to verify at post time that no conflict has occured." ^verifyAtPostPolicy
verifyAtPostPolicy: newPolicy "Set the policy for how the receiver indicates to verify at post time that no conflict has occured." verifyAtPostPolicy := newPolicy
</methods> <methods> Lens.LensTransactionPolicy <category>testing</category>
delayUpdatesUntilCommit "Return whether it is the receiver's policy to delay updates until commit time." ^delayUpdatesUntilCommit
</methods> <methods> Lens.LensTransactionPolicy <category>registration</category>
register "Register the receiver." PolicyRegistry at: name put: self
unregister "Unregister the receiver." PolicyRegistry removeKey: name ifAbsent: []
</methods> <methods> Lens.LensTransactionPolicy <category>printing</category>
printOn: stream super printOn: stream. stream nextPutAll: ' ('. self printNameOn: stream. stream nextPut: $)
</methods> <methods> Lens.LensTransactionPolicy <category>initialize-release</category>
initialize
</methods> <methods> Lens.LensTransactionPolicy <category>private</category>
printNameOn: stream | nm | stream nextPutAll: (((nm := self name) == nil or: [nm isEmpty]) ifFalse: [nm] ifTrue: [(#unnamed << #lensRuntime >> 'unnamed')]) asString
</methods> <methods> Lens.LensTransactionPolicy class <category>class initialization</category>
initialize "LensTransactionPolicy initialize" PolicyRegistry := IdentityDictionary new. "define standard policies" self new name: #PessimisticRR; presentedIsolationLevel: #RR; underlyingIsolationLevel: #RR; delayUpdatesUntilCommit: false; verifyAtPostPolicy: #never; register. self new name: #OptimisticRRCS; presentedIsolationLevel: #RR; underlyingIsolationLevel: #CS; delayUpdatesUntilCommit: true; verifyAtPostPolicy: #asSpecifiedInDataModel; register. self new name: #OptimisticRR; presentedIsolationLevel: #RR; underlyingIsolationLevel: #RR; delayUpdatesUntilCommit: true; verifyAtPostPolicy: #asSpecifiedInDataModel; register.
</methods> <methods> Lens.LensTransactionPolicy class <category>registration</category>
named: policyName "Answer the named policy." ^PolicyRegistry at: policyName
registry "Answer the registry of all policies." ^PolicyRegistry
</methods> <methods> Lens.LensTransactionPolicy class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LensAggregateSurrogate <category>testing</category>
IsAggregateSurrogate ^true
</methods> <methods> Lens.LensAggregateSurrogate <category>initialize-release</category>
apply: op to: surrogate of: aType "Answer an aggregate surrogate for the application of op to surrogate." | variable | left := surrogate. operator := op. type := aType. surrogate == nil ifFalse: [variable := surrogate Attribute]. op == #Count ifFalse: [ | mc | mc := variable valueType memberClass. ((mc inheritsFrom: Number) or: [mc == Date or: [mc == Time or: [mc == Timestamp]]]) ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: variable name with: variable objectType) errorPattern: (#errVariableNonArithmetic << #lens >> 'Variable <1p> of <2p> is non-arithmetic')]]
</methods> <methods> Lens.LensAggregateSurrogate <category>accessing</category>
Attribute "Answer the left attribute surrogate's attribute (used by aggregate ops)." | att | att := left == nil ifFalse: [left Attribute copy] ifTrue: [LensStructureVariable new]. att fieldAndValueType: type. att name: (#noName << #lensRuntime >> '<no name>') asString. ^att
</methods> <methods> Lens.LensAggregateSurrogate class <category>instance creation</category>
apply: op to: surrogate of: aType "Answer a new aggregate surrogate performing the op on the surrogate." ^self new apply: op to: surrogate of: aType
</methods> <methods> Core.Fraction class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensStructureType
</methods> <methods> Core.Double class <category>type semantics</category>
isVariableSize "Answer whether the receiver has variable-sized members." ^false
</methods> <methods> Database.ExternalDatabaseAnswerStream <category>private-ObjectLens</category>
addContentsTo: collection "Add receiver's contents to collection, answer the collection." [ self atEnd ] whileFalse: [ collection add: self next ]. ^collection
</methods> <methods> Database.ExternalDatabaseConnection <category>private-ObjectLens</category>
doCommand: command "Execute the command, answering the session." | session | session := self getSession. session doCommand: command. self retainSession: session. ^session
doCommandString: commandString "Execute the commandString on a new session, answering the session." ^self getSession doCommandString: commandString
retainSession: session "Remember a session for reuse via the next getSession" cachedSession isNil ifTrue: [ cachedSession := session ]
</methods> <methods> Kernel.BindingReference <category>printing</category>
asText ^self displayString asText
</methods> <methods> Core.ClassDescription <category>type semantics</category>
checkLensSizeOf: object max: max ^self isVariableSize not or: [max == nil or: [max validateCollectionForLens: object]]
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifFalse: [ (object isKindOf: self) ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>')]]
of: elementTypeOrClass "Answer a collectionType whose members are instances of self, containing elements described by elementTypeOrClass." ^LensCollectionType new memberClass: self; of: elementTypeOrClass
type "Answer a new type describing self." ^LensType newFor: self in: nil
typeClass "Answer the class of types used to describe the receiver's instances." ^LensStructureType
</methods> <methods> UI.ApplicationModel class <category>private</category>
writeEssentialsFor: anApplicationSpec using: definer into: codeStream "There is no method that has to be defined in ApplicationModel subclasses" ^self
</methods> <methods> Core.Array <category>private-ObjectLens</category>
isNilExternalId "Answer whether receiver is considered nil when used as an external ID." self do: [:item | item == nil ifTrue: [^true]]. ^false
</methods> <methods> Core.Object class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^(self isBits or: [self == Object]) ifTrue: [LensDataType] ifFalse: [ self isVariable ifFalse: [ LensStructureType] ifTrue: [ LensType definitionErrorSignal raiseWith: (Array with: self) errorPattern: (#errCreatingTypeForVariable << #lens >> 'Can''t create type for <1p>, which is a variable non-collection')]]
</methods> <methods> Core.Object <category>private-ObjectLens</category>
child: object addedTo: childSet "Note that object was added to childSet. This message can be redefined in subclasses needing notification of changes in their relationships to other objects." ^self
child: object removedFrom: childSet "Note that object was removed from childSet. This message can be redefined on subclasses needing notification of changes in their relationships to other objects." ^self
effectiveClass "Answer the class of the receiver." ^self class
</methods> <methods> Core.Object <category>ObjectLens</category>
externalId "Answer the externalId for anObject, or nil if temporary." | gd | ^(gd := self globalDescriptor) == nil ifTrue: [nil] ifFalse: [gd externalId]
</methods> <methods> Core.Object <category>private-ObjectLens</category>
globalDescriptor "Answer the receiver's global descriptor if it has one." ^LensGlobalDescriptor at: self ifAbsent: [nil]
</methods> <methods> Core.Object <category>ObjectLens</category>
hasUnpostedUpdates "Answer whether object has unposted updates." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectHasUnpostedUpdates]
in: aCollection "Answer whether receiver is included in aCollection." ^aCollection includes: self
</methods> <methods> Core.Object <category>private-ObjectLens</category>
initChildren "Initialize children sets to empty sets. This is typically used to fill in child sets explicitly instead of using proxies." | gd | (gd := self globalDescriptor) == nil ifFalse: [ gd lensContainer type variablesDo: [ :var | var isChildrenPointer ifTrue: [ self instVarAt: var instVarIndex put: IdentitySet new]]]
isAdded "Answer if receiver is added." | gd | ^(gd := self globalDescriptor) ~= nil and: [gd objectIsAdded]
isAnything "Answer whether receiver is a value that matches anything." ^self class == Object
</methods> <methods> Core.Object <category>ObjectLens</category>
isDirtyObject "Answer whether object is persistent and the row has been updated in the current transaction. This does not reflect pending updates which have yet to be posted to the database." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectIsDirty] "THIS METHOD USED TO BE CALLED isDirty. CHANGED SINCE THIS isDirty IS NOT SENT ANYWHERE, AND isDirty IS IMPLEMENTED INCONSISTENTLY WITHIN THE Lens (i.e. LensDataManager isDirty means the UI is not up to date. The only send of isDirty is in LensDataManager and is used to ask if the UI needs updating)."
</methods> <methods> Core.Object <category>private-ObjectLens</category>
isLensType "Answer whether the receiver behaves as a type." ^false
isNilExternalId "Answer whether receiver is considered nil when used as an external ID." ^false
isNothing "Answer whether receiver is a value that represents no specific object." ^self == nil or: [self class == Object or: [self class == BlockClosure]]
</methods> <methods> Core.Object <category>ObjectLens</category>
isPersistent "Answer if receiver is persistent." | gd | ^(gd := self globalDescriptor) notNil and: [gd objectIsPersistent]
</methods> <methods> Core.Object <category>private-ObjectLens</category>
isProxy "Answer whether the receiver is a proxy." ^false
IsQS "Answer whether receiver is a LensQuerySurrogate." ^false
isRemoved "Answer if receiver has been removed." | gd | ^(gd := self globalDescriptor) ~= nil and: [gd objectIsRemoved]
</methods> <methods> Core.Object <category>ObjectLens</category>
isTransient "Answer true if receiver does not correspond to a specific row in a table." ^self isPersistent not
</methods> <methods> Core.Object <category>private-ObjectLens</category>
lensContainer "Answer the container containing receiver, or nil if none can be found." | gd | ^(gd := self globalDescriptor) notNil ifTrue: [gd lensContainer] ifFalse: [nil]
lensEqual: anObject ^self = anObject
</methods> <methods> Core.Object <category>ObjectLens</category>
lensSession "Answer the session containing receiver, or nil if none can be found." | lc | ^(lc := self lensContainer) == nil ifTrue: [nil] ifFalse: [lc lensSession]
lock "Lock the object in the database if it is persistent. The object is not refreshed from the database and pending updates are not posted" | gd | (gd := self globalDescriptor) notNil ifTrue: [ gd lock ]
postFetchInitialize: initialFetch "Initialize receiver after fetching or refreshing. initialFetch is true if this is for the first time data is fetched into the object. Default is to do nothing." ^self
postUpdates "Post any outstanding updates to receiver." | gd | (gd := self globalDescriptor) notNil ifTrue: [gd postUpdateOf: self]
update: instVar to: value "Update instVar of object to value, and update the corresponding field of object's record." | index gd | index := (instVar isInteger) ifTrue: [instVar] ifFalse: [self class instVarIndexFor: instVar]. (gd := self globalDescriptor) == nil ifTrue: [self instVarAt: index put: value] ifFalse: [gd update: self instVarAt: index put: value. gd postOrDeferUpdateOf: self]
</methods> <methods> Core.Object <category>private-ObjectLens</category>
update: instVar to: newValue asChild: childrenSelector "Update instVar of object to newValue, and update the corresponding field of object's record." | index gd currentValue siblings | index := (instVar isInteger) ifTrue: [instVar] ifFalse: [self class instVarIndexFor: instVar]. currentValue := self instVarAt: index. "if value isn't being changed, get out now" newValue == currentValue ifTrue: [^self]. "remove self from current sibling collection, and notify parent" currentValue isNothing ifFalse: [ siblings := currentValue perform: childrenSelector. siblings remove: self. currentValue child: self removedFrom: siblings]. "update the parent pointer" (gd := self globalDescriptor) == nil ifTrue: [ self instVarAt: index put: newValue] ifFalse: [ gd update: self instVarAt: index put: newValue. gd postOrDeferUpdateOf: self]. "add self to new sibling collection, and notify parent" newValue isNothing ifFalse: [ siblings := newValue perform: childrenSelector. siblings add: self. newValue child: self addedTo: siblings].
</methods> <methods> Core.SequenceableCollection <category>private-ObjectLens</category>
lensEqual: otherCollection "Answer whether each of the receiver's elements equal the corresponding element of otherCollection." "Assume: the species of the receiver is the same as otherCollection's species and the receiver's size is the same as otherCollection's size." 1 to: self size do: [:index | ((self at: index) lensEqual: (otherCollection at: index)) ifFalse: [^false]]. ^true
</methods> <methods> Core.Timestamp class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensDataType
</methods> <methods> Core.ByteString class <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^''
</methods> <methods> Core.CharacterArray <category>private-ObjectLens</category>
lensEqual: aString ^self = aString
</methods> <methods> Core.Number class <category>type semantics</category>
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifFalse: [ ((object respondsToArithmetic) and: [object isReal]) ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>') ] ]
</methods> <methods> UI.SubCanvasSpec <category>private</category>
majorKeyFullName "for compatibility with use by LinkedDetailSpec" ^majorKey
</methods> <methods> Database.AdHocQueryTool class <category>class initialization</category>
initialize "AdHocQueryTool initialize" self initializeSettings
initializeSettings "AdHocQueryTool initializeSettings" UISettings addPreferenceSection: #addDatabaseSectionTo:development:runtime:
</methods> <methods> Database.AdHocQueryTool class <category>resources</category>
installedDBConnectsMenu | rawList menu | rawList := (ExternalDatabaseConnection allSubclasses select: [ :cl | cl kind notNil ]) asSortedCollection: [ :a :b | a kind <= b kind ]. menu := Menu new. rawList do: [ :each | menu addItemLabel: each kind value: each fullName ]. ^menu asValue
</methods> <methods> Database.AdHocQueryTool class <category>private</category>
obsolete "Remove the associated settigns and slices from the UISettings." super obsolete. UISettings removePreferenceSection: #addDatabaseSectionTo:development:runtime:
</methods> <methods> Kernel.CompiledMethod <category>lens support</category>
isSafeAsQuery "Answer whether the code can safely be used as a query. This means that it must never access instance variables directly, or send a message to 'super'." | scanner | (InstanceVariableSearch new method: self; searchForType: #readWrite) ifTrue: [^false]. self withAllBlockMethodsDo: [:meth | scanner := InstructionStream on: meth. scanner scanFor: [:x | scanner willSendSuper ifTrue: [^false]. false "keep scanning"]]. ^true
</methods> <methods> Database.ByteFieldDescriptor <category>accessing</category>
effectiveClass ^template class
</methods> <methods> Core.UndefinedObject class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensDataType
</methods> <methods> Core.UndefinedObject <category>persistence</category>
isLike: aString ^false
</methods> <methods> Core.UndefinedObject <category>private-ObjectLens</category>
isNilExternalId "Answer whether receiver is considered nil when used as an external ID." ^true
</methods> <methods> UI.UISpecEnumerator <category>secondary dispatch</category>
doLeafEmbeddedDetail: aSpec self doLeafSubCanvasSpec: aSpec
doLeafLinkedDetail: aSpec self doLeafActionButtonSpec: aSpec
</methods> <methods> Core.Integer class <category>type semantics</category>
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." (object == nil or: [ object isInteger or: [ object respondsToArithmetic and: [object isReal and: [object = object asInteger ]]]]) ifFalse: [ "Nope stop things right here." LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>') ]
</methods> <methods> Core.Integer class <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^0
</methods> <methods> Core.Integer <category>private-ObjectLens</category>
validateCollectionForLens: object ^object size <= self
</methods> <methods> Core.Behavior <category>type semantics</category>
isVariableSize "Answer whether the receiver has variable-sized members." ^self isVariable
</methods> <methods> Core.Boolean class <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^true
</methods> <methods> Core.Boolean class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensDataType
</methods> <methods> Core.String class <category>type semantics</category>
checkShallowIncludes: object "Complain if object isn't a member of the receiver, checking shallowly." object == nil ifFalse: [(object isString) ifFalse: [(object isKindOf: Text) ifFalse: [LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>')]]]
isVariableSize "Answer whether the receiver has variable-sized members." ^true
typeClass "Answer the class of types used to describe the receiver's instances." ^LensDataType
</methods> <methods> Core.String <category>private-ObjectLens</category>
asBoolean "Answer the instance of Boolean named by receiver." self = (#false << #lensRuntime >> 'false') asString ifTrue: [^false]. self = (#true << #lensRuntime >> 'true') asString ifTrue: [^true]. self = (#nil << #lensRuntime >> 'nil') asString ifTrue: [^nil]. self error: (#errUnrecognizedBooleanName << #lens >> 'unrecognized boolean name')
isLike: text "If wildcard * in text, call match with text as receiver" (0 = (text findString: '*' startingAt: 1)) ifTrue: [^self match: text] ifFalse: [^text match: self]
</methods> <methods> Core.Magnitude class <category>template generation</category>
recordTemplate "Answer an object to be used as a database record template." ^self zero
</methods> <methods> Core.Magnitude class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensDataType
</methods> <methods> Kernel.NameSpace <category>team utils</category>
containsClassName: aClassNameSymbol "Smalltalk containsClassName: #String" ^(self allClasses collect: [:e | e name asSymbol]) includes: aClassNameSymbol
</methods> <methods> UI.UISettings class <category>user preferences</category>
addDatabaseSectionTo: aDictionary development: devSpecs runtime: runtimeSpecs "Add the Lens set of preferences and settings slices to the arguments." aDictionary at: #databaseAccept put: [self databaseAccept]; at: #databaseReset put: [self databaseReset]. self ensure: aDictionary hasModelFor: #dbDevUsername editing: #dbDevUsernameEditing default: ''. self ensure: aDictionary hasModelFor: #dbDevPassword editing: #dbDevPasswordEditing default: ''. self ensure: aDictionary hasModelFor: #dbDevEnvironment editing: #dbDevEnvironmentEditing default: ''. self ensure: aDictionary hasModelFor: #dbUserUsername editing: #dbUserUsernameEditing default: ''. self ensure: aDictionary hasModelFor: #dbUserPassword editing: #dbUserPasswordEditing default: ''. devSpecs addLast: (#Database << #database >> 'Database')->#(#databaseSpec #databaseHelp)
</methods> <methods> UI.UISettings class <category>accessing preferences</category>
databaseAccept (self preferenceModelFor: #dbDevUsername) value: (self preferenceFor: #dbDevUsernameEditing). (self preferenceModelFor: #dbDevPassword) value: (self preferenceFor: #dbDevPasswordEditing). (self preferenceModelFor: #dbDevEnvironment) value: (self preferenceFor: #dbDevEnvironmentEditing). (self preferenceModelFor: #dbUserUsername) value: (self preferenceFor: #dbUserUsernameEditing). (self preferenceModelFor: #dbUserPassword) value: (self preferenceFor: #dbUserPasswordEditing).
databaseReset (self preferenceModelFor: #dbDevUsernameEditing) value: (self preferenceFor: #dbDevUsername). (self preferenceModelFor: #dbDevPasswordEditing) value: (self preferenceFor: #dbDevPassword). (self preferenceModelFor: #dbDevEnvironmentEditing) value: (self preferenceFor: #dbDevEnvironment). (self preferenceModelFor: #dbUserUsernameEditing) value: (self preferenceFor: #dbUserUsername). (self preferenceModelFor: #dbUserPasswordEditing) value: (self preferenceFor: #dbUserPassword).
</methods> <methods> Core.Metaclass <category>type checking</category>
checkIncludes: object "Complain if object isn't a member of the receiver, checking for shallow." object == thisClass ifFalse: [ LensType typeViolationSignal raiseWith: (Array with: object with: self) errorPattern: (#notMemberOf << #lens >> '<1p> is not a member of <2p>')]
</methods> <methods> Core.Text <category>private-ObjectLens</category>
lensEqual: anotherText ^string lensEqual: anotherText string
</methods> <methods> Core.Collection class <category>type semantics</category>
maxColumnConstraint: size "Answer a data type for receiver restricted to max." ^LensDataType new memberClass: self; maxColumnConstraint: size
</methods> <methods> Core.Collection class <category>template generation</category>
queryTemplate "Answer a new template for querying members of the receiver." ^self new
</methods> <methods> Core.Collection class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^self isBits ifFalse: [LensCollectionType] ifTrue: [super typeClass]
</methods> <methods> Core.ByteEncodedString <category>private-ObjectLens</category>
lensEqual: aString "Answer whether aString isKindOf: String, and the receiver's size is the same as aString's size, and each of the receiver's elements equals the corresponding element of aString" <primitive: 223> ^super = aString
</methods> <methods> Core.Point class <category>type semantics</category>
typeClass "Answer the class of types used to describe the receiver's instances." ^LensStructureType
</methods> <methods> Core.Float class <category>type semantics</category>
isVariableSize "Answer whether the receiver has variable-sized members." ^false
</methods> <methods> Core.Class <category>template generation</category>
queryTemplate "Answer a new template for querying members of the receiver." | template | template := self basicNew. 1 to: self instSize do: [:i | template instVarAt: i put: Object new]. ^template
recordTemplate "Answer an object to be used as a database record template." ^self new
</methods> <methods> Core.SmallInteger <category>private-ObjectLens</category>
lensEqual: aNumber "Answer whether the receiver is equal to the argument. Fail if the argument is not a SmallInteger. No Lookup." <primitive: 7> ^super = aNumber
</methods> <methods> UI.AspectEnumerator <category>secondary dispatch</category>
doLeafEmbeddedDetail: aSpec | client | (client := aSpec clientKey) == nil ifTrue: [incompletes add: aSpec. ^self]. aSpec majorKey == nil ifTrue: [incompletes add: aSpec. ^self]. aSpec fetchAction == nil ifTrue: [incompletes add: aSpec. ^self]. (aSpec contentKey notNil and: [aSpec sourceType ~~ #query]) ifTrue: [bindings at: aSpec contentKey put: nil asValue]. details at: client put: aSpec
doLeafLinkedDetail: aSpec | client | (client := aSpec clientKey) == nil ifTrue: [incompletes add: aSpec. ^self]. aSpec majorKey == nil ifTrue: [incompletes add: aSpec. ^self]. aSpec fetchAction == nil ifTrue: [incompletes add: aSpec. ^self]. aSpec openAction == nil ifTrue: [incompletes add: aSpec. ^self]. (aSpec contentKey notNil and: [aSpec sourceType ~~ #query]) ifTrue: [bindings at: aSpec contentKey put: nil asValue]. details at: client put: aSpec
</methods> <methods> Database.ExternalDatabaseSession <category>private-ObjectLens</category>
afterOrdinaryAnswerStreamFromCommand "Check to be sure that all results have been handled" self state == #validResults ifFalse: [ ^self ]. [ self moreResultsExternal ] ensure: [ self state: #prepared ]
answerAfterCommand "Answer an instance of LensAnswerStream after a doCommand: has been executed." ^self answerAfterCommandOfClass: (#{LensAnswerStream} valueOrDo: [])
answerAfterCommandOfClass: answerStreamClass "Answer an instance of (a subclass of) ExternalDatabaseAnswerStream after a doCommand: has been executed." ( self hasAnswerSetExternal ) ifTrue: [ "If we already have columnDescriptions, override any opinion about number of columns." columnDescriptions notNil ifTrue: [ self numColumns: columnDescriptions size ]. self getColumnDescriptions. self acquireBuffers. self setupAdaptors. self aboutToAnswer. self answerStream: (answerStreamClass newForSession: self). self state: #fetchingData. ^answerStream ]. "Check to be sure that all results have been handled" [ self moreResultsExternal ] ensure: [ self state: #prepared ]. ^#noMoreAnswers
answerColumnsFromTemplate "Set up columnDescriptions as necessary to allocate buffers" | descStream | descStream := WriteStream on: (Array new: 512). self flattenResultTemplate: resultTemplate onto: descStream. descStream isEmpty ifTrue: [ self columnDescriptions: nil. self numColumns: 0 ] ifFalse: [ self columnDescriptions: descStream contents. self numColumns: columnDescriptions size ]
bindInput: object template: template to: stream ^self subclassResponsibility
bindTemplate: template "Set the bind template" bindTemplate := template
doCommand: command "Execute an instance of DatabaseCommand, and wait until the server has answered." | object template | self prepare: command body. "Bypass the normal output binding mechanism" self bindOutput: nil. "Bind instead from an object, with optional template." object := command bindObject. template := command bindTemplate. ( template == nil ) ifTrue: [ template := object ]. ( template == nil ) ifTrue: [ self bindInput: nil ] ifFalse: [ | bindStream | bindStream := WriteStream on: (Array new: 128). self bindInput: object template: template to: bindStream. self bindInput: bindStream contents ]. "Input objects will be recreated via an object lens template" self resultTemplate: command resultTemplate. [ "Begin unwind protection." self bindExternal. self state: #executing. self executeExternal. "Wait for the server to be ready with results" self delayUntilReady. "Examine the results for errors." self resultsExternal "End unwind protection." ] ifCurtailed: [ self state: #prepared ]
doCommandString: aString "Execute an SQL query. The query is assumed to not return an answer set." self prepare: aString; execute; answer; answer
flattenResultTemplate: template onto: descStream "Flatten an ObjectLens template onto the stream descStream." ^self subclassResponsibility
nextViaArrayTemplate: template "Answer an object reified from the the rowBuffers and the (sub) template. In this case, answer an array created by recursing over each of this template's members." "Assume: template isKindOf: Array" | array size | size := template size. array := template class new: size. 1 to: size do: [ : index | array at: index put: (self nextViaTemplate: (template at: index)) ]. ^array
nextViaCollectionTemplate: template "Answer an object reified from the rowBuffers and the (sub) template" "Assume: template is isKindOf: Collection" | collection size | size := template size. collection := template class basicNew: size. 1 to: size do: [ : index | collection at: index put: (self nextViaTemplate: (template at: index)) ]. ^collection
nextViaEntityTemplate: template "Answer an object reified from the rowBuffers and this (sub) template. In this case, the template represents an entity with instance variables." "Assume: This template represents an entity with instance variables." | entity | entity := template class basicNew. 1 to: template class instSize do: [ : index | entity instVarAt: index put: (self nextViaTemplate: (template instVarAt: index)) ]. ^entity
nextViaTemplate: template "Answer an object constructed via the template" "Any template entry that digests a rowBuffer is responsible for incrementing bufferIndex." ^self subclassResponsibility
resultTemplate: template "Set the result template" resultTemplate := template
</methods> <methods> Lens.LensApplicationModel class <category>private</category>
templatePragma <pragmas: #class> ^#(specLabel:)
</methods> <methods> Lens.LensApplicationModel class <category>interface specs</category>
loginSpec "UIPainter new openOnClass: self andSelector: #loginSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 337 153 ) #max: #(#Point 640 153 ) #bounds: #(#Rectangle 397 327 734 480 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 66 0 0 1 ) #label: #(#{UserMessage} #key: #UserName #catalogID: #lens #defaultString: 'User Name:') ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 96 0 0 1 ) #label: #(#{UserMessage} #key: #Password #catalogID: #lens #defaultString: 'Password:' )) #(#InputFieldSpec #layout: #(#LayoutFrame 118 0 40 0 -10 1 65 0 ) #model: #username ) #(#InputFieldSpec #layout: #(#LayoutFrame 118 0 70 0 -10 1 95 0 ) #model: #pwd #type: #password ) #(#LabelSpec #layout: #(#Point 10 12 ) #label: #(#{UserMessage} #key: #LOGINToDatabase #catalogID: #lens #defaultString: 'LOGIN to Database') ) #(#ActionButtonSpec #layout: #(#LayoutFrame 16 0.5 -35 1 82 0.5 -5 1 ) #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -82 0.5 -35 1 -16 0.5 -5 1 ) #model: #accept #label: #(#{UserMessage} #key: #OK #catalogID: #lens #defaultString: 'OK' ) #isDefault: true ) ) ) )
</methods> <methods> Lens.LensMainApplication class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #ApplicationLauncher #catalogID: #lens #defaultString: 'Application Launcher' ) #bounds: #(#Rectangle 230 304 467 417 ) #flags: 4 #menu: #menuBar ) #component: #(#SpecCollection #collection: #() ) )
</methods> <methods> Lens.LensMainApplication class <category>resources</category>
menuBar "MenuEditor new openOnClass: self andSelector: #menuBar" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Database #defaultString: 'Database' #catalogID: #lens ) #nameKey: #databaseMenu #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Login #defaultString: 'Login' #catalogID: #lens ) #nameKey: #databaseLogin #value: #databaseLogin ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Commit #defaultString: 'Commit' #catalogID: #lens ) #nameKey: #databaseCommit #value: #databaseCommit ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Rollback #defaultString: 'Rollback' #catalogID: #lens ) #nameKey: #databaseRollback #value: #databaseRollback ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Logout #defaultString: 'Logout' #catalogID: #lens ) #nameKey: #databaseLogout #value: #databaseLogout ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Exit #defaultString: 'Exit' #catalogID: #lens ) #value: #closeRequest ) ) #(5 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
</methods> <methods> Lens.LensTemporaryMain class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #TemporaryLauncher #catalogID: #lens #defaultString: 'Temporary Launcher') #min: #(#Point 227 27 ) #max: #(#Point 227 27 ) #bounds: #(#Rectangle 500 326 727 353 ) #flags: 4 #menu: #menuBar ) #component: #(#SpecCollection #collection: #() ) )
</methods> <methods> Lens.LensSession class <category>interface specs</category>
connectSpec "UIPainter new openOnClass: self andSelector: #connectSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 337 164 ) #bounds: #(#Rectangle 68 334 405 498 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#AlignmentOrigin 12 0 89 0 0 1 ) #label: #(#{UserMessage} #key: #UserName #catalogID: #lens #defaultString: 'User Name:' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 13 0 117 0 0 1 ) #label: #(#{UserMessage} #key: #Password #catalogID: #lens #defaultString: 'Password:' ) ) #(#InputFieldSpec #layout: #(#LayoutFrame 115 0 63 0 -10 1 88 0 ) #model: #usernameHolder ) #(#InputFieldSpec #layout: #(#LayoutFrame 115 0 93 0 -10 1 116 0 ) #model: #passwordHolder #type: #password ) #(#ActionButtonSpec #layout: #(#LayoutFrame -82 0.5 -35 1 -16 0.5 -5 1 ) #model: #accept #label: #(#{UserMessage} #key: #OK #catalogID: #lens #defaultString: 'OK' ) #isDefault: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 16 0.5 -35 1 82 0.5 -5 1 ) #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) ) #(#LabelSpec #layout: #(#Point 5 7 ) #label: #(#{UserMessage} #key: #EstablishingConnection #catalogID: #lens #defaultString: 'Establishing Database Connection...' ) ) #(#LabelSpec #layout: #(#Point 5 30 ) #label: #(#{UserMessage} #key: #EnterUserNameAndPassword #catalogID: #lens #defaultString: 'Please enter user name and password:' )) ) ) )
</methods> <methods> Lens.LensDatabaseContext class <category>interface specs</category>
propertiesSpec "UIPainter new openOnClass: self andSelector: #propertiesSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: '' #min: #(#Point 215 76 ) #max: #(#Point 215 76 ) #bounds: #(#Rectangle 266 284 481 360 ) ) #component: #(#SpecCollection #collection: #( #(#InputFieldSpec #layout: #(#LayoutFrame 120 0 9 0 -6 1 34 0 ) #model: #username ) #(#LabelSpec #layout: #(#AlignmentOrigin 8 0 36 0 0 1 ) #label: #(#{UserMessage} #key: #UserNameC #catalogID: #lens #defaultString: 'User name:') ) #(#LabelSpec #layout: #(#AlignmentOrigin 8 0 68 0 0 1 ) #label: #(#{UserMessage} #key: #EnvironmentC #catalogID: #lens #defaultString: 'Environment:' ) ) #(#InputFieldSpec #layout: #(#LayoutFrame 120 0 41 0 -6 1 66 0 ) #model: #environment ) ) ) )
</methods> <methods> Lens.LensDataManager class <category>resources</category>
firstRowImage "UIMaskEditor new openOnClass: self andSelector: #firstRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 48 132 0 0 49 140 0 0 51 156 0 0 55 188 0 0 63 252 0 0 63 252 0 0 55 188 0 0 51 156 0 0 49 140 0 0 48 132 0 0 0 0 0 0 0 0 0 0 ] pad: 32
lastRowImage "UIMaskEditor new openOnClass: self andSelector: #lastRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 33 12 0 0 49 140 0 0 57 204 0 0 61 236 0 0 63 252 0 0 63 252 0 0 61 236 0 0 57 204 0 0 49 140 0 0 33 12 0 0 0 0 0 0 0 0 0 0 ] pad: 32
minusImage "UIMaskEditor new openOnClass: self andSelector: #minusImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 31 240 0 0 31 240 0 0 31 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] pad: 32
nextPageRowImage "UIMaskEditor new openOnClass: self andSelector: #nextPageRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 16 128 0 0 24 192 0 0 28 224 0 0 30 240 0 0 31 248 0 0 31 248 0 0 30 240 0 0 28 224 0 0 24 192 0 0 16 128 0 0 0 0 0 0 0 0 0 0 ] pad: 32
nextRowImage "UIMaskEditor new openOnClass: self andSelector: #nextRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 6 0 0 0 7 0 0 0 7 128 0 0 7 192 0 0 7 192 0 0 7 128 0 0 7 0 0 0 6 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 ] pad: 32
plusImage "UIMaskEditor new openOnClass: self andSelector: #plusImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 3 128 0 0 3 128 0 0 3 128 0 0 3 128 0 0 63 248 0 0 63 248 0 0 63 248 0 0 3 128 0 0 3 128 0 0 3 128 0 0 3 128 0 0 0 0 0 0 0 0 0 0 ] pad: 32
prevPageRowImage "UIMaskEditor new openOnClass: self andSelector: #prevPageRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 1 8 0 0 3 24 0 0 7 56 0 0 15 120 0 0 31 248 0 0 31 248 0 0 15 120 0 0 7 56 0 0 3 24 0 0 1 8 0 0 0 0 0 0 0 0 0 0 ] pad: 32
prevRowImage "UIMaskEditor new openOnClass: self andSelector: #prevRowImage" <resource: #image> ^Image extent: 16@15 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 192 0 0 1 192 0 0 3 192 0 0 7 192 0 0 7 192 0 0 3 192 0 0 1 192 0 0 0 192 0 0 0 64 0 0 0 0 0 0 0 0 0 0 ] pad: 32
</methods> <methods> Lens.LensDataManager class <category>interface specs</category>
boxes "UIPainter new openOnClass: self andSelector: #boxes" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #lens #defaultString: 'Unlabeled Canvas' ) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 233 319 587 704 ) ) #component: #(#SpecCollection #collection: #( #(#GroupBoxSpec #layout: #(#Rectangle 9 3 334 40 ) ) #(#InputFieldSpec #layout: #(#Rectangle 226 10 261 33 ) #name: #rowIndex #model: #rowIndex #tabable: false #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 179 0 35 0 0 1 ) #label: #(#{UserMessage} #key: #Num #catalogID: #lens #defaultString: 'Num:' ) ) #(#InputFieldSpec #layout: #(#Rectangle 291 10 326 33 ) #name: #rowCount #model: #rowCount #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 265 0 35 0 0 1 ) #label: #(#{UserMessage} #key: #of #catalogID: #lens #defaultString: 'of:' )) #(#RegionSpec #layout: #(#Rectangle 9 78 241 136 ) #name: #cellBounds #lineWidth: 1 ) #(#ActionButtonSpec #layout: #(#Rectangle 16 9 71 34 ) #name: #performQuery #model: #performQuery #label: #(#{UserMessage} #key: #Fetch #catalogID: #lens #defaultString: 'Fetch' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 74 9 100 34 ) #name: #firstRow #flags: 40 #isOpaque: true #model: #firstRow #label: #firstRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 100 9 126 34 ) #name: #prevRow #flags: 40 #isOpaque: true #model: #prevRow #label: #prevRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 126 9 152 34 ) #name: #nextRow #flags: 40 #isOpaque: true #model: #nextRow #label: #nextRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 152 9 178 34 ) #name: #lastRow #flags: 40 #isOpaque: true #model: #lastRow #label: #lastRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 9 46 74 74 ) #name: #addRow #isOpaque: true #model: #addRow #label: #(#{UserMessage} #key: #New #catalogID: #lens #defaultString: 'New' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 74 46 139 74 ) #name: #removeRow #flags: 40 #isOpaque: true #model: #removeRow #label: #(#{UserMessage} #key: #Delete #catalogID: #lens #defaultString: 'Delete' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 139 46 204 74 ) #name: #startEditing #flags: 40 #isOpaque: true #model: #startEditing #label: #(#{UserMessage} #key: #Edit #catalogID: #lens #defaultString: 'Edit' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 204 46 269 74 ) #name: #accept #flags: 40 #isOpaque: true #model: #accept #label: #(#{UserMessage} #key: #Accept #catalogID: #lens #defaultString: 'Accept' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 269 46 334 74 ) #name: #cancel #flags: 40 #isOpaque: true #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #isDefault: false ) #(#CompositeSpecCollection #collection: #( #(#InputFieldSpec #layout: #(#Rectangle 60 16 209 41 ) #name: #'*Field' #model: #'row * | trigger' ) #(#GroupBoxSpec #layout: #(#Rectangle 0 0 214 46 ) #name: #'*Field' #label: '*' ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 19 83 240 131 ) #name: #cellContents ) ) ) ) )
dialogSpec "UIPainter new openOnClass: self andSelector: #dialogSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 20 20 ) #bounds: #(#Rectangle 668 191 895 408 ) ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 2 0 2 0 -2 1 -40 1 ) #minorKey: #dialogSubCanvas #clientKey: #dialogSubCanvasClient ) #(#ActionButtonSpec #layout: #(#LayoutFrame -82 0.5 -35 1 -16 0.5 -5 1 ) #model: #accept #label: #(#{UserMessage} #key: #OK #catalogID: #lens #defaultString: 'OK' ) #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 16 0.5 -35 1 82 0.5 -5 1 ) #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #defaultable: true ) ) ) )
editAndExistenceControl "UIPainter new openOnClass: self andSelector: #editAndExistenceControl" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #EditExistingControls #catalogID: #lens #defaultString: 'Edit And Existence Controls' ) #min: #(#Point 40 20 ) #bounds: #(#Rectangle 129 542 478 592 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 4 4 69 29 ) #name: #addRow #isOpaque: true #model: #addRow #label: #(#{UserMessage} #key: #New #catalogID: #lens #defaultString: 'New' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 69 4 134 29 ) #name: #removeRow #flags: 40 #isOpaque: true #model: #removeRow #label: #(#{UserMessage} #key: #Delete #catalogID: #lens #defaultString: 'Delete' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 264 4 329 29 ) #name: #cancel #flags: 40 #isOpaque: true #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 134 4 199 29 ) #name: #startEditing #flags: 40 #isOpaque: true #model: #startEditing #label: #(#{UserMessage} #key: #Edit #catalogID: #lens #defaultString: 'Edit' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 199 4 264 29 ) #name: #accept #flags: 40 #isOpaque: true #model: #accept #label: #(#{UserMessage} #key: #Accept #catalogID: #lens #defaultString: 'Accept' ) #isDefault: false ) ) ) )
editControl "UIPainter new openOnClass: self andSelector: #editControl" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #EditControls #catalogID: #lens #defaultString: 'Edit Controls' ) #min: #(#Point 40 20 ) #bounds: #(#Rectangle 156 577 365 614 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 134 4 199 29 ) #name: #cancel #flags: 40 #isOpaque: true #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 4 4 69 29 ) #name: #startEditing #flags: 40 #isOpaque: true #model: #startEditing #label: #(#{UserMessage} #key: #Edit #catalogID: #lens #defaultString: 'Edit' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 69 4 134 29 ) #name: #accept #flags: 40 #isOpaque: true #model: #accept #label: #(#{UserMessage} #key: #Accept #catalogID: #lens #defaultString: 'Accept' ) #isDefault: false ) ) ) )
fetchControl "UIPainter new openOnClass: self andSelector: #fetchControl" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #FetchControl #catalogID: #lens #defaultString: 'Fetch Control' ) #min: #(#Point 40 20 ) #bounds: #(#Rectangle 10 354 324 405 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 5 4 64 29 ) #name: #performQuery #model: #performQuery #label: #(#{UserMessage} #key: #Fetch #catalogID: #lens #defaultString: 'Fetch' ) #isDefault: false ) ) ) )
multipleRowEditorTemplate "UIPainter new openOnClass: self andSelector: #multipleRowEditorTemplate" <specLabel: #(#MultipleRowEditor #lensRuntime 'Multiple Row Editor')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #lens #defaultString: 'Unlabeled Canvas' ) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 86 40 440 425 ) ) #component: #(#SpecCollection #collection: #( #(#RegionSpec #layout: #(#Rectangle 5 78 332 110 ) #name: #cellBounds #lineWidth: 1 ) #(#SubCanvasSpec #layout: #(#Rectangle 2 2 332 41 ) #name: #transportControls #minorKey: #transportAndFetchControl ) #(#SubCanvasSpec #layout: #(#Rectangle 3 39 345 73 ) #name: #editControls #flags: 0 #minorKey: #editAndExistenceControl ) #(#CompositeSpecCollection #collection: #( #(#InputFieldSpec #layout: #(#Rectangle 169 0 318 25 ) #name: #'*Field' #model: #'row * | trigger' ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0 25 0 0 1 ) #name: #'*Label' #label: '*' ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 11 82 329 107 ) #name: #cellContents ) ) ) ) )
multipleRowViewerTemplate "UIPainter new openOnClass: self andSelector: #multipleRowViewerTemplate" <specLabel: #(#MultipleRowViewer #lensRuntime 'Multiple Row Viewer')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #lens #defaultString: 'Unlabeled Canvas' ) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 4 59 358 444 ) ) #component: #(#SpecCollection #collection: #( #(#RegionSpec #layout: #(#Rectangle 4 44 344 77 ) #name: #cellBounds #lineWidth: 1 ) #(#SubCanvasSpec #layout: #(#Rectangle 2 2 343 39 ) #name: #transportControls #minorKey: #transportAndFetchControl ) #(#CompositeSpecCollection #collection: #( #(#InputFieldSpec #layout: #(#Rectangle 181 0 330 25 ) #name: #'*Field' #model: #'row * | trigger' ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0 25 0 0 1 ) #name: #'*Label' #label: '*' ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 10 48 340 73 ) #name: #cellContents ) ) ) ) )
reusableComponents "UIPainter new openOnClass: self andSelector: #reusableComponents" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #ReuseableDataForm #catalogID: #lens #defaultString: 'Reusable Data Form Components' ) #min: #(#Point 40 20 ) #bounds: #(#Rectangle 69 334 477 753 ) ) #component: #(#SpecCollection #collection: #( #(#GroupBoxSpec #layout: #(#Rectangle 5 0 396 58 ) #label: #(#{UserMessage} #key: #Navigation #catalogID: #lens #defaultString: 'Navigation' ) ) #(#LabelSpec #layout: #(#Point 13 195 ) #label: #(#{UserMessage} #key: #MenuButton #catalogID: #lens #defaultString: 'Menu Button') ) #(#LabelSpec #layout: #(#Point 135 195 ) #label: #(#{UserMessage} #key: #TextField #catalogID: #lens #defaultString: 'Text Field' ) ) #(#GroupBoxSpec #layout: #(#Rectangle 6 65 396 159 ) #label: #(#{UserMessage} #key: #Editing #catalogID: #lens #defaultString: 'Editing' ) ) #(#GroupBoxSpec #layout: #(#Rectangle 6 173 396 260 ) #label: #(#{UserMessage} #key: #FieldsForPolicy #catalogID: #lens #defaultString: 'Fields - For ''If Touched'' edit policy' ) ) #(#LabelSpec #layout: #(#Point 228 195 ) #label: #(#{UserMessage} #key: #InputField #catalogID: #lens #defaultString: 'Input Field' ) ) #(#ActionButtonSpec #layout: #(#Rectangle 14 22 73 47 ) #name: #performQuery #model: #performQuery #label: #(#{UserMessage} #key: #Fetch #catalogID: #lens #defaultString: 'Fetch' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 82 22 108 47 ) #name: #firstRow #flags: 40 #isOpaque: true #model: #firstRow #label: #firstRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 108 22 134 47 ) #name: #prevPageRow #flags: 40 #isOpaque: true #model: #prevPageRow #label: #prevPageRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 134 22 160 47 ) #name: #prevRow #flags: 40 #isOpaque: true #model: #prevRow #label: #prevRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 160 22 186 47 ) #name: #nextRow #flags: 40 #isOpaque: true #model: #nextRow #label: #nextRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 186 22 212 47 ) #name: #nextPageRow #flags: 40 #isOpaque: true #model: #nextPageRow #label: #nextPageRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 212 22 238 47 ) #name: #lastRow #flags: 40 #isOpaque: true #model: #lastRow #label: #lastRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 11 90 76 118 ) #name: #cancel #flags: 40 #isOpaque: true #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #lens #defaultString: 'Cancel' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 87 90 152 118 ) #name: #accept #flags: 40 #isOpaque: true #model: #accept #label: #(#{UserMessage} #key: #Accept #catalogID: #lens #defaultString: 'Accept' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 162 90 227 118 ) #name: #startEditing #flags: 40 #isOpaque: true #model: #startEditing #label: #(#{UserMessage} #key: #Edit #catalogID: #lens #defaultString: 'Edit' ) #isDefault: false ) #(#CheckBoxSpec #layout: #(#Point 244 129 ) #name: #editing #flags: 32 #model: #editing #label: #(#{UserMessage} #key: #Edit #catalogID: #lens #defaultString: 'Edit' ) ) #(#ActionButtonSpec #layout: #(#Rectangle 12 125 56 150 ) #name: #addRow #isOpaque: true #model: #addRow #label: #(#{UserMessage} #key: #New #catalogID: #lens #defaultString: 'New' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 59 125 84 150 ) #name: #addRow #isOpaque: true #model: #addRow #label: #plusImage #hasCharacterOrientedLabel: false #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 102 126 146 151 ) #name: #removeRow #flags: 40 #isOpaque: true #model: #removeRow #label: #(#{UserMessage} #key: #Del #catalogID: #lens #defaultString: 'Del' ) #isDefault: false ) #(#ActionButtonSpec #layout: #(#Rectangle 149 126 174 151 ) #name: #removeRow #flags: 40 #isOpaque: true #model: #removeRow #label: #minusImage #hasCharacterOrientedLabel: false #isDefault: false ) #(#MenuButtonSpec #layout: #(#Rectangle 14 219 114 244 ) #model: #'row @ | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestValueChangeSelector: #focusInRequest ) ) #(#TextEditorSpec #layout: #(#Rectangle 136 219 215 249 ) #model: #'row @ | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestFocusInSelector: #focusInRequest ) ) #(#InputFieldSpec #layout: #(#Rectangle 232 220 340 245 ) #name: #'*Field' #model: #'row * | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestFocusInSelector: #focusInRequest ) ) #(#ActionButtonSpec #layout: #(#Rectangle 239 90 304 118 ) #name: #accept #flags: 40 #isOpaque: true #model: #databaseCommit #label: #(#{UserMessage} #key: #Commit #catalogID: #lens #defaultString: 'Commit' ) #isDefault: false ) #(#LabelSpec #layout: #(#Point 13 299 ) #label: #(#{UserMessage} #key: #MenuButton #catalogID: #lens #defaultString: 'Menu Button' ) ) #(#LabelSpec #layout: #(#Point 135 299 ) #label: #(#{UserMessage} #key: #TextField #catalogID: #lens #defaultString: 'Text Field' ) ) #(#GroupBoxSpec #layout: #(#Rectangle 6 277 396 363 ) #label: #(#{UserMessage} #key: #FieldsWhenTold #catalogID: #lens #defaultString: 'Fields - For ''When Told'' edit policy' ) ) #(#LabelSpec #layout: #(#Point 228 299 ) #label: #(#{UserMessage} #key: #InputField #catalogID: #lens #defaultString: 'Input Field' ) ) #(#MenuButtonSpec #layout: #(#Rectangle 14 323 114 348 ) #model: #'row @ | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestValueChangeSelector: #explicitFocusInRequest ) ) #(#TextEditorSpec #layout: #(#Rectangle 136 323 215 353 ) #model: #'row @ | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestFocusInSelector: #explicitFocusInRequest ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 244 0 49 0 0 1 ) #label: #(#{UserMessage} #key: #Num #catalogID: #lens #defaultString: 'Num:' ) ) #(#InputFieldSpec #layout: #(#Rectangle 287 23 322 47 ) #name: #rowIndex #model: #rowIndex #tabable: false #alignment: #right #isReadOnly: true #type: #number ) #(#InputFieldSpec #layout: #(#Rectangle 232 324 340 349 ) #name: #'''*Field''' #model: #'row * | trigger' #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #valueChanged #requestFocusInSelector: #explicitFocusInRequest ) ) #(#InputFieldSpec #layout: #(#Rectangle 354 23 389 47 ) #name: #rowCount #model: #rowCount #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 327 0 49 0 0 1 ) #label: #(#{UserMessage} #key: #of #catalogID: #lens #defaultString: 'of:') ) ) ) )
rowEditorTemplate "UIPainter new openOnClass: self andSelector: #rowEditorTemplate" <specLabel: #(#RowEditor #lensRuntime 'Row Editor')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #editorForSingleObject #catalogID: #lens #defaultString: 'Editor for a single object' ) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 59 46 413 431 ) ) #component: #(#SpecCollection #collection: #( #(#RegionSpec #layout: #(#Rectangle 6 42 346 74 ) #name: #cellBounds #lineWidth: 1 ) #(#SubCanvasSpec #layout: #(#Rectangle 4 4 346 38 ) #name: #editControls #flags: 0 #minorKey: #editAndExistenceControl ) #(#CompositeSpecCollection #collection: #( #(#InputFieldSpec #layout: #(#Rectangle 181 0 330 25 ) #name: #'*Field' #model: #'row * | trigger' ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0 25 0 0 1 ) #name: #'*Label' #label: '*' ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 12 46 342 71 ) #name: #cellContents ) ) ) ) )
rowViewerTemplate "UIPainter new openOnClass: self andSelector: #rowViewerTemplate" <specLabel: #(#RowViewer #lensRuntime 'Row Viewer')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #RowViewerDisplay #catalogID: #lens #defaultString: 'Row Viewer used to display the data of one single object' ) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 64 42 418 427 ) ) #component: #(#SpecCollection #collection: #( #(#RegionSpec #layout: #(#Rectangle 5 7 345 38 ) #name: #cellBounds #lineWidth: 1 ) #(#CompositeSpecCollection #collection: #( #(#InputFieldSpec #layout: #(#Rectangle 181 0 330 25 ) #name: #'*Field' #model: #'row * | trigger' ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0 25 0 0 1 ) #name: #'*Label' #label: '*' ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 11 10 341 35 ) #name: #cellContents ) ) ) ) )
tabularEditorTemplate "UIPainter new openOnClass: self andSelector: #tabularEditorTemplate" <specLabel: #(#TabularEditor #lensRuntime 'Tabular Editor')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #TabluarEditor #catalogID: #lens #defaultString: 'Tabular Editor' ) #bounds: #(#Rectangle 266 284 818 627 ) ) #component: #(#SpecCollection #collection: #( #(#DataSetSpec #layout: #(#LayoutFrame 0 0 43 0 0 1.0 -1 1 ) #model: #rows #columns: #( #(#DataSetColumnSpec #labelIsImage: false #width: 30 #rendererType: #rowSelector #editorType: #rowSelector #noScroll: false ) #(#DataSetColumnSpec #model: #'row * | trigger' #label: '*' #labelIsImage: false #width: 160 #rendererType: #Text #editorType: #InputField #font: #system #alignment: #left #type: #string #popUpStyle: false #noScroll: false #cellLabel: '' ) ) ) #(#SubCanvasSpec #layout: #(#Rectangle 3 2 67 40 ) #name: #transportControls #flags: 0 #minorKey: #fetchControl ) #(#SubCanvasSpec #layout: #(#Rectangle 64 2 400 36 ) #name: #editControls #flags: 0 #minorKey: #editAndExistenceControl ) ) ) )
tabularViewerTemplate "UIPainter new openOnClass: self andSelector: #tabularViewerTemplate" <specLabel: #(#TabularViewer #lensRuntime 'Tabular Viewer')> <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #tablularViewer #catalogID: #lens #defaultString: 'Tabular Viewer with no edit controls' ) #bounds: #(#Rectangle 215 237 767 580 ) ) #component: #(#SpecCollection #collection: #( #(#DataSetSpec #layout: #(#LayoutFrame 0 0 43 0 0 1.0 -1 1 ) #model: #rows #columns: #( #(#DataSetColumnSpec #labelIsImage: false #width: 30 #rendererType: #rowSelector #editorType: #rowSelector #noScroll: false ) #(#DataSetColumnSpec #model: #'row * | trigger' #label: '*' #labelIsImage: false #width: 160 #rendererType: #Text #editorType: #InputField #font: #system #alignment: #left #type: #string #popUpStyle: false #noScroll: false #cellLabel: '' ) ) ) #(#SubCanvasSpec #layout: #(#LayoutFrame -32 0.5 3 0 32 0.5 41 0 ) #name: #transportControls #flags: 0 #minorKey: #fetchControl ) ) ) )
transportAndFetchControl "UIPainter new openOnClass: self andSelector: #transportAndFetchControl" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #TransportControlsWithFetch #catalogID: #lens #defaultString: 'Transport Controls With Fetch' ) #min: #(#Point 324 51 ) #bounds: #(#Rectangle 178 500 502 551 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 67 5 93 30 ) #name: #firstRow #flags: 40 #isOpaque: true #model: #firstRow #label: #firstRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 93 5 119 30 ) #name: #prevRow #flags: 40 #isOpaque: true #model: #prevRow #label: #prevRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 119 5 145 30 ) #name: #nextRow #flags: 40 #isOpaque: true #model: #nextRow #label: #nextRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 145 5 171 30 ) #name: #lastRow #flags: 40 #isOpaque: true #model: #lastRow #label: #lastRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 5 5 64 30 ) #name: #performQuery #model: #performQuery #label: #(#{UserMessage} #key: #Fetch #catalogID: #lens #defaultString: 'Fetch' ) #isDefault: false ) #(#LabelSpec #layout: #(#AlignmentOrigin 176 0 32 0 0 1 ) #label: #(#{UserMessage} #key: #Num #catalogID: #lens #defaultString: 'Num:' ) ) #(#InputFieldSpec #layout: #(#Rectangle 219 7 254 30 ) #name: #rowIndex #model: #rowIndex #tabable: false #alignment: #right #isReadOnly: true #type: #number ) #(#InputFieldSpec #layout: #(#Rectangle 286 7 321 30 ) #name: #rowCount #model: #rowCount #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 259 0 32 0 0 1 ) #label: #(#{UserMessage} #key: #of #catalogID: #lens #defaultString: 'of:') ) ) ) )
transportControl "UIPainter new openOnClass: self andSelector: #transportControl" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #TransportControls #catalogID: #lens #defaultString: 'Transport Controls' ) #min: #(#Point 40 20 ) #bounds: #(#Rectangle 157 495 427 529 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 4 4 30 29 ) #name: #firstRow #flags: 40 #isOpaque: true #model: #firstRow #label: #firstRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 30 4 56 29 ) #name: #prevRow #flags: 40 #isOpaque: true #model: #prevRow #label: #prevRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 56 4 82 29 ) #name: #nextRow #flags: 40 #isOpaque: true #model: #nextRow #label: #nextRowImage #hasCharacterOrientedLabel: false ) #(#ActionButtonSpec #layout: #(#Rectangle 82 4 108 29 ) #name: #lastRow #flags: 40 #isOpaque: true #model: #lastRow #label: #lastRowImage #hasCharacterOrientedLabel: false ) #(#InputFieldSpec #layout: #(#Rectangle 163 7 198 30 ) #name: #rowIndex #model: #rowIndex #tabable: false #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 120 0 32 0 0 1 ) #label: #(#{UserMessage} #key: #Num #catalogID: #lens #defaultString: 'Num:' ) ) #(#InputFieldSpec #layout: #(#Rectangle 230 7 265 30 ) #name: #rowCount #model: #rowCount #alignment: #right #isReadOnly: true #type: #number ) #(#LabelSpec #layout: #(#AlignmentOrigin 203 0 32 0 0 1 ) #label: #(#{UserMessage} #key: #of #catalogID: #lens #defaultString: 'of:') ) ) ) )
</methods> <methods> Database.AdHocQueryTool class <category>interface specs</category>
connectSpec "UIPainter new openOnClass: self andSelector: #connectSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: '' #min: #(#Point 302 162 ) #max: #(#Point 302 162 ) #bounds: #(#Rectangle 559 265 861 427 ) ) #component: #(#SpecCollection #collection: #( #(#InputFieldSpec #layout: #(#LayoutFrame 152 0 35 0 -11 1 59 0 ) #model: #usernameModel ) #(#InputFieldSpec #layout: #(#LayoutFrame 152 0 65 0 -11 1 89 0 ) #model: #passwordModel #type: #password ) #(#InputFieldSpec #layout: #(#LayoutFrame 152 0 95 0 -11 1 119 0 ) #model: #environmentModel ) #(#ActionButtonSpec #layout: #(#LayoutFrame -82 0.5 -35 1 -8 0.5 -4 1 ) #model: #accept #label: #(#{UserMessage} #key: #OK #catalogID: #database #defaultString: 'OK' ) #isDefault: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 16 0.5 -36 1 89 0.5 -5 1 ) #model: #cancel #label: #(#{UserMessage} #key: #Cancel #catalogID: #database #defaultString: 'Cancel' ) #defaultable: true ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 120 0 0 1 ) #label: #(#{UserMessage} #key: #environment #catalogID: #database #defaultString: 'Environment:') ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 60 0 0 1 ) #label: #(#{UserMessage} #key: #userName #catalogID: #database #defaultString: 'User Name:') ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 90 0 0 1 ) #label: #(#{UserMessage} #key: #password #catalogID: #database #defaultString: 'Password:') ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 30 0 0 1 ) #label: #(#{UserMessage} #key: #databaseConnect #catalogID: #database #defaultString: 'Database Connect:') ) #(#MenuButtonSpec #layout: #(#LayoutFrame 152 0 5 0 -11 1 29 0 ) #model: #whichDriverModel #menu: #installedDBConnectsMenu ) ) ) )
</methods> <methods> UI.MenuButtonSpec class <category>resources</category>
selectionPopUpMenu "MenuEditor new openOnClass: self andSelector: #selectionPopUpMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #definemenuasquery #defaultString: 'define menu as query' #catalogID: #lens ) #value: #defineMenuAsQuery ) ) #(1 ) nil ) decodeAsLiteralArray
selectionPullDownMenu "MenuEditor new openOnClass: self andSelector: #selectionPullDownMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #DefineMenuAsQuery #defaultString: 'Define Menu as Query' #catalogID: #lens ) #value: #defineMenuAsQuery ) ) #(1 ) nil ) decodeAsLiteralArray
</methods> <methods> UI.UISettings class <category>interface specs</category>
databaseSpec "UIPainter new openOnClass: self andSelector: #databaseSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #lens #defaultString: 'Unlabeled Canvas' ) #min: #(#Point 274 270 ) #bounds: #(#Rectangle 173 415 447 685 ) ) #component: #(#SpecCollection #collection: #( #(#GroupBoxSpec #layout: #(#LayoutFrame 8 0 3 0 -8 1 123 0 ) #label: #(#{UserMessage} #key: #DevelopmentToolDefaults #catalogID: #lens #defaultString: 'Development Tools Defaults' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 19 0 55 0 0 1 ) #label: #(#{UserMessage} #key: #UsernameC #catalogID: #lens #defaultString: 'Username:' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 19 0 85 0 0 1 ) #label: #(#{UserMessage} #key: #Password #catalogID: #lens #defaultString: 'Password:' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 19 0 115 0 0 1 ) #label: #(#{UserMessage} #key: #EnvironmentC #catalogID: #lens #defaultString: 'Environment:' ) ) #(#GroupBoxSpec #layout: #(#LayoutFrame 8 0 131 0 -8 1 226 0 ) #label: #(#{UserMessage} #key: #UserApplicationDefaults #catalogID: #lens #defaultString: 'User Application Defaults' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 19 0 188 0 0 1 ) #label: #(#{UserMessage} #key: #UsernameC #catalogID: #lens #defaultString: 'Username:' ) ) #(#LabelSpec #layout: #(#AlignmentOrigin 19 0 218 0 0 1 ) #label: #(#{UserMessage} #key: #Password #catalogID: #lens #defaultString: 'Password:' ) ) #(#InputFieldSpec #layout: #(#LayoutFrame 117 0 29 0 -14 1 54 0 ) #model: #dbDevUsernameEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #menu: #fieldMenu ) #(#InputFieldSpec #layout: #(#LayoutFrame 117 0 59 0 -14 1 84 0 ) #model: #dbDevPasswordEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #menu: #fieldMenu #type: #password ) #(#InputFieldSpec #layout: #(#LayoutFrame 136 0 89 0 -14 1 114 0 ) #model: #dbDevEnvironmentEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #menu: #fieldMenu #type: #string ) #(#InputFieldSpec #layout: #(#LayoutFrame 117 0 163 0 -14 1 188 0 ) #model: #dbUserUsernameEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #menu: #fieldMenu ) #(#InputFieldSpec #layout: #(#LayoutFrame 117 0 193 0 -14 1 218 0 ) #model: #dbUserPasswordEditing #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #disturb ) #menu: #fieldMenu #type: #password ) #(#ActionButtonSpec #layout: #(#Point 10 240 ) #name: #acceptButton #flags: 40 #model: #databaseAccept #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #lens #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#Point 101 240 ) #name: #resetButton #flags: 40 #model: #databaseReset #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #lens #defaultString: 'Reset' ) #defaultable: true ) #(#ActionButtonSpec #layout: #(#Point 185 240 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #lens #defaultString: 'Help' ) #defaultable: true ) ) ) )
</methods> <methods> Tools.VisualWorksSettings class <category>settings-database</category>
database1DevelopmentUserName <setting: #(database developmentUserName)> ^(StringSetting onUISetting: #dbDevUsername) label: #DeveloperName << #labels >> 'Developer name'; helpText: #DeveloperNameHelpText << #dialogs >> 'User name used by database development tools in the image.'
database2DevelopmentPassword <setting: #(database developmentPassword)> ^(StringSetting forPassword onUISetting: #dbDevPassword) label: #DeveloperPassword << #labels >> 'Developer password'; helpText: #DeveloperPasswordHelpText << #dialogs >> 'Database password used by the developer tools in the image.'
database3DevelopmentEnvironment <setting: #(database developmentEnvironment)> ^(StringSetting onUISetting: #dbDevEnvironment) label: #DeveloperEnvironment << #labels >> 'Developer environment'; helpText: #DeveloperEnvironmentHelpText << #dialogs >> 'Database environment string used by the developer tools in the image.'
database4UserUserName <setting: #(database userUserName)> ^(StringSetting onUISetting: #dbUserUsername) label: #DbUserName << #labels >> 'User name'; helpText: #DbUserNameHelpText << #dialogs >> 'Database user name used when running database applications.'
database5UserPassword <setting: #(database userPassword)> ^(StringSetting forPassword onUISetting: #dbUserPassword) label: #DbPassword << #labels >> 'Password'; helpText: #DbPasswordHelpText << #dialogs >> 'Database password used when running database applications.'
</methods> <methods> Tools.VisualWorksSettings class <category>pages</category>
databasePage <settingsPage: #(tools database)> ^ModularSettingsPage new label: #Database << #labels >> 'Database - Lens'; icon: (ListIconLibrary visualFor: #database); settings: (self settingsWithPrefix: #(database))
</methods> <initialize> Lens.LensQuerySurrogate </initialize> <initialize> Lens.LensContainer </initialize> <initialize> Lens.QueryOperation </initialize> <initialize> Lens.LensType </initialize> <initialize> Lens.LensGlobalDescriptor </initialize> <initialize> Lens.LensStructureVariable </initialize> <initialize> Lens.LensCompiler </initialize> <initialize> Lens.QueryOperationAccessor </initialize> <initialize> Lens.LensDataModel </initialize> <initialize> Lens.LensSession </initialize> <initialize> Lens.LensDatabaseContext </initialize> <initialize> Lens.LensSQLTransporter </initialize> <initialize> Lens.LensPolicy </initialize> <initialize> Lens.LensTransactionPolicy </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>UISpecEnumerator</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>UIBuilder-Support</category> <attributes> <package>UIBuilder-Support</package> </attributes> </class> <class> <name>AspectEnumerator</name> <environment>UI</environment> <super>UI.UISpecEnumerator</super> <private>false</private> none source bindings actions clients incompletes details <imports></imports> <category>UIBuilder-Support</category> <attributes> <package>UIBuilder-Support</package> </attributes> </class> <class> <name>Model</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none dependents <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class> <class> <name>Integer</name> <environment>Core</environment> <super>Core.Number</super> <private>false</private> none <imports></imports> <category>Magnitude-Numbers</category> <attributes> <package>Magnitude-Numbers</package> </attributes> </class> <class> <name>SmallInteger</name> <environment>Core</environment> <super>Core.Integer</super> <private>false</private> immediate minVal maxVal maxBits maxBytes <imports></imports> <category>Magnitude-Numbers</category> <attributes> <package>Magnitude-Numbers</package> </attributes> </class> <class> <name>Collection</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Collections-Abstract</category> <attributes> <package>Collections-Abstract</package> </attributes> </class> <class> <name>SequenceableCollection</name> <environment>Core</environment> <super>Core.Collection</super> <private>false</private> none <imports></imports> <category>Collections-Abstract</category> <attributes> <package>Collections-Abstract</package> </attributes> </class> <class> <name>Array</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> objects <imports></imports> <category>Collections-Arrayed</category> <attributes> <package>Collections-Arrayed</package> </attributes> </class> <class> <name>Behavior</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none superclass methodDict format subclasses <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>String</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>ByteEncodedString</name> <environment>Core</environment> <super>Core.String</super> <private>false</private> bytes encoder <imports></imports> <category>Collections-String Support</category> <attributes> <package>Collections-String Support</package> </attributes> </class> <class> <name>UndefinedObject</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ClassDescription</name> <environment>Core</environment> <super>Core.Behavior</super> <private>false</private> none instanceVariables organization <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Metaclass</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none thisClass <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Class</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none name classPool environment <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Dictionary</name> <environment>Core</environment> <super>Core.Set</super> <private>false</private> objects <imports></imports> <category>Collections-Unordered</category> <attributes> <package>Collections-Unordered</package> </attributes> </class> <class> <name>SimpleDialog</name> <environment>UI</environment> <super>UI.ApplicationModel</super> <private>false</private> none close accept cancel preBuildBlock postBuildBlock postOpenBlock escapeIsCancel parentView <imports></imports> <category>Interface-Dialogs</category> <attributes> <package>Interface-Dialogs</package> </attributes> </class> <class> <name>Association</name> <environment>Core</environment> <super>Core.LookupKey</super> <private>false</private> none value <imports></imports> <category>Collections-Support</category> <attributes> <package>Collections-Support</package> </attributes> </class> <class> <name>UIAspectPath</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none head tail trigger builder <imports></imports> <category>UIBuilder-Support</category> <attributes> <package>UIBuilder-Support</package> </attributes> </class> <class> <name>Text</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none string runs <imports> private Graphics.TextConstants.* </imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>ByteFieldDescriptor</name> <environment>Database</environment> <super>Core.Object</super> <private>false</private> none template max isLongType <imports></imports> <category>Database-Support</category> <attributes> <package>Database</package> </attributes> </class> <class> <name>ExternalDatabaseSession</name> <environment>Database</environment> <super>Database.ExternalDatabaseFramework</super> <private>false</private> none connection query queryFragments bindInput bindTemplate bindOutput useNamedOutputBinding bindValues resultTemplate allocateForEachRow blockFactor numColumns columnDescriptions rowAdaptors rowBuffersHolder bufferIndex answerStream currentRow scrollable <imports></imports> <category>Database-Interface</category> <attributes> <package>Database</package> </attributes> </class> <class> <name>BindingReference</name> <environment>Kernel</environment> <super>Kernel.GeneralBindingReference</super> <private>false</private> none baseClass environment <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>Compiler</name> <environment>Kernel</environment> <super>Kernel.SmalltalkCompiler</super> <private>false</private> none <imports></imports> <category>System-Compiler-Public Access</category> <attributes> <package>System-Compiler-Public Access</package> </attributes> </class> <class> <name>NameSpace</name> <environment>Kernel</environment> <super>Kernel.GeneralNameSpace</super> <private>false</private> none parent name <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>NonInteractiveCompilerErrorHandler</name> <environment>Kernel</environment> <super>Kernel.CompilerErrorHandler</super> <private>false</private> none source <imports></imports> <category>System-Compiler-Support</category> <attributes> <package>System-Compiler-Support</package> </attributes> </class> <class> <name>ExternalDatabaseConnection</name> <environment>Database</environment> <super>Database.ExternalDatabaseFramework</super> <private>false</private> none transaction username password environment transactionCoordinator cachedSession isolationLevel environmentMap xif xifMap dependents <imports></imports> <category>Database-Interface</category> <attributes> <package>Database</package> </attributes> </class> <class> <name>CompiledMethod</name> <environment>Kernel</environment> <super>Kernel.CompiledMainBlock</super> <private>false</private> objects mclass sourceCode <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>ExternalDatabaseAnswerStream</name> <environment>Database</environment> <super>Core.Stream</super> <private>false</private> none session nextRow <imports></imports> <category>Database-Interface</category> <attributes> <package>Database</package> </attributes> </class> <class> <name>SubCanvasSpec</name> <environment>UI</environment> <super>UI.NamedSpec</super> <private>false</private> none majorKey minorKey clientKey <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>UIBuilder-Specifications</package> </attributes> </class> <class> <name>ActionButtonSpec</name> <environment>UI</environment> <super>UI.ButtonSpec</super> <private>false</private> none isDefault defaultable <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>UIBuilder-Specifications</package> </attributes> </class> <class> <name>LocalScope</name> <environment>Kernel</environment> <super>Kernel.NameScope</super> <private>false</private> none variables nesting variableList permitDuplicateNames <imports></imports> <category>System-Compiler-Names and Scopes</category> <attributes> <package>System-Compiler-Names and Scopes</package> </attributes> </class> <class> <name>List</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none dependents collection limit collectionSize <imports></imports> <category>UIBasics-Collections</category> <attributes> <package>UIBasics-Collections</package> </attributes> </class> <class> <name>ValueHolder</name> <environment>UI</environment> <super>UI.ValueModel</super> <private>false</private> none value <imports></imports> <category>Interface-Support</category> <attributes> <package>Interface-Support</package> </attributes> </class> <class> <name>ProgramNodeBuilder</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>Error</name> <environment>Core</environment> <super>Core.Exception</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>InstanceVariable</name> <environment>Kernel</environment> <super>Kernel.VariableDefinition</super> <private>false</private> none scope index <imports></imports> <category>System-Compiler-Names and Scopes</category> <attributes> <package>System-Compiler-Names and Scopes</package> </attributes> </class>