From VisualWorks®, 7.6 of February 8, 2008 on March 3, 2008 at 9:41:31 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>LDMAbstractBody</name> <environment>Lens</environment> <super>UI.Model</super> <private>false</private> none foa locked missedUpdate viewModel <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMAbstractBody
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The manager of the graph of displayed relationships. There are many ways the display of the graph could be implemented. For example, a body could be an editor for the text related to the elements, or another body could be a debugger. The typical "graph" browser is implemented by LDMRelationsBody. The graph displayed can be manipulated by oppening and closing relationship. In addition there are facilities to manage the update of graphs when changes happen in the elements themselves. There are two kinds of changes, changes in the label of one or more elements or changes in the relationships between the elements. This class provides the protocol for managing those changes and making them reflect into the graph. Since the idea behind the graphs was that they should not change for each small change in the elements, the graph does not depend on the elements themselves, but on a 'dataBase' defined by the element, then the 'dataBase' notifies of changes when the graphs should be updated. For the current use of the graphs it could make sense to implement a graph update mechanism that uses the regular dependency and change notification mechanisms. Updating a graph is not an easy task, you want to keep relationships that were open open, you want to close (and remove) relationships that do not exist any more. The problems appear inpoints like 'what to do with a new relationship that appear where the user opened all of the outgoing relationships?' - currently this is handled by indicating that there is a new relationship. Perhaps a more intuitive solution would open that relationship automatically; in order to implement that, the graph would have to remember what elements have all their relationships open for both directions. NOTE: The implementation of change notification was geared towards the first usage of this browsing model. The current usage is much more geard towards using the regular Smalltalk change notification. Instance Variables: foa <Set of: elements> the focus of the graph (Focus Of Attention) locked <Boolean> whether the view is locked. If locked, no update in the underlying graph is reflected in the view. This is useful for the cases where the developer want the user to have the option to leave obsolete graphs open, which is useful for comparisons of 'before' and 'after'. missedUpdate <Array> if it lost an update from the database because of being locked the update sender and symbol are stored here viewModel <LDMBrowserModel> the browser model associated with this body Subclasses must implement the following messages instance protocol accessing focus: perspective: private rebuild '
</comment> <class> <name>LDMAbstractVisualBuilder</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none composite graph nodeDict spacing viewModel visualComponentBlock visualConnectionBlock midPoint nodeExtent builder <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMAbstractVisualBuilder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instance Variables: composite <LDMGraphCompositeView> the composite where the view is built graph <LDMGraph> the graph for which the view is built nodeDict <IdentityDictionary> (key: element, value: LDMGraphElementWrapper) the dictionary where for each element we have encountered so far. AgraphWrapper is associated so it can be reused. The wrapper is used to relocate the element's view inside the graphs view and to compute the graph geometry spacing <Point> the spacing between elements in the graph view viewModel <LDMBrowserModel> the browser model which is used as the model for all the views visualComponentBlock <BlockClosure> used to create element views for the elements visualConnectionBlock <BlockClosure> used to create views for relationships (arcs) midPoint <Number> nodeExtent <Number> builder <UIBuilder> The builder used to build widgets from specs (element views can construct their label from specs) Subclasses must implement the following messages instance protocol layout layout build internalBuild:depth:'
</comment> <class> <name>LDMGraphBuilder</name> <environment>Lens</environment> <super>Lens.LDMAbstractVisualBuilder</super> <private>false</private> none mins orientation columnPositions hwyPositions channelOffsets channelsPending buildPath <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMGraphBuilder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instance Variables: mins <Array of: Number> orientation <Symbol> only #horizontal is in use, #vertical only partially works. Indicate what is the orientation of the graph view columnPositions <Array of: Number> the position of the different columns hwyPositions <Array of: Number> the positions of the highways channelOffsets <IdentityDictionary> channelsPending <Array of: OrderedCollection> buildPath <OrderedCollection> collection of element wrappers '
</comment> <class> <name>LDMRelationship</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none name description reverse <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMRelationship
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Represents a relationship between elements. The simplest relationships are implemented by just sending a message to the elements. More complex relationships are implemented as a combination of other relationships. Subclasses implement the most common opperators for combining relationships. The combination of relationships can also be done programatically at the level of the methods implementing the relationships. That seems to be the most useful way to do it when the perspectives are built also programatically and the user has no control over the relationships. In a more dynamic schema, the relationships could be constructed based on the simple ones by combinations using the operators. Note that the NOT operator (which would make the set algebraicly complete) is not provided. The reason for that is that the NOT operator would require the knowledge and the existance of a Universe of elements, which is in general not known. It could be implemented for a particular kind of elements if it is possible to compute the universe in reasonable time. Instance Variables: name <Symbol> the name of the relationship description <String> a description of the relationship. This description can be used in tools that work with general perspectives and refer to the relationships according to what is actually found in the perspective. Most tools using this browsers have their own hard-coded menus and explanations so they do not require descriptions in the relationships. reverse <LDMRelationship> the reverse relationship. It may be set or computed. Sometimes the reverse relationship is not simple or not even known. Note that the reverse relationship is not the Negation of the relationship. For example, the reverse of 'calls' is 'is called by', and NOT 'does not call'. Class Variables: Relationships <Dictionary> Hold onto all the known relationships. This is a global context for relationships. Perhaps it would make sense to have the relationships been local to the context where they are used. Subclasses must implement the following messages instance protocol computing computeReverse '
</comment> <class> <name>LDMHighOrderRel</name> <environment>Lens</environment> <super>Lens.LDMRelationship</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMHighOrderRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A relationship composed of other relationships. The composition rules are given by the specific subclasses.'
</comment> <class> <name>LDMMonadicRel</name> <environment>Lens</environment> <super>Lens.LDMHighOrderRel</super> <private>false</private> none r1 <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMMonadicRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A relationship can be defined in terms of a more basic one. A typical example is the transitive closure, which results from the application of a relationship any number of times. Instance Variables: r1 <LDMRelationship> the basic relationship'
</comment> <class> <name>LDMNonReflexiveRel</name> <environment>Lens</environment> <super>Lens.LDMMonadicRel</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMNonReflexiveRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The same as the basic relationship it is composed of, but it doesn't allow for an element to be related to itself.'
</comment> <class> <name>LDMTransitiveClosureRel</name> <environment>Lens</environment> <super>Lens.LDMMonadicRel</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMTransitiveClosureRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Computes the transitive closure of the application of a relationship. Can be quite expensive if computing a relationship takes any significant amount of time. '
</comment> <class> <name>LDMVisualTreeConnection</name> <environment>Lens</environment> <super>Graphics.VisualComponent</super> <private>false</private> none orientation parent children preferredBounds <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMVisualTreeConnection
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>LDMAbstractElementWrapper</name> <environment>Lens</environment> <super>Graphics.TranslatingWrapper</super> <private>false</private> none depth pass children isRoot <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMAbstractElementWrapper
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>LDMListElementWrapper</name> <environment>Lens</environment> <super>Lens.LDMAbstractElementWrapper</super> <private>false</private> none reference <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMListElementWrapper
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>LDMIndentedListBuilder</name> <environment>Lens</environment> <super>Lens.LDMAbstractVisualBuilder</super> <private>false</private> none bottom referenceConnections <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMIndentedListBuilder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. NOTE that the algorithms here work only if the graph is a true tree. If there are cycles or multiple paths from the root to any leave, the indented list will not be correctly displayed. Instance variables: bottom <Number> referenceConnections <IdentityDictionary> not in use'
</comment> <class> <name>LDMBroomConnection</name> <environment>Lens</environment> <super>Lens.LDMVisualTreeConnection</super> <private>false</private> none builder refreshArea model <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMBroomConnection
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 visual connection between a parent node and it children. It is represented as a broom shape. That is, a broom handle going out to a nexus and the connection to the children goinf from here. Recursion arcs backward. The implementation is based on the column and highway model. builder <LDMGraphBuilder> For getting highway info refreshArea <Rectangle|nil> If this rectangle gets damaged we want to refresh. If nil alway refresh. '
</comment> <class> <name>LDMGraph</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none relationships <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMGraph
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instance Variables relationships <IdentityDictionary> The keys are all the elements present in the graph, the values are for each element a pair of dictionaries, each one of them has as key a relationship and as value the identitySet of elements related through the relationship to the first element. '
</comment> <class> <name>LDMBrowserBodyView</name> <environment>Lens</environment> <super>UI.CompositeView</super> <private>false</private> none decorator <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMBrowserBodyView
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>LDMFirstOrderRel</name> <environment>Lens</environment> <super>Lens.LDMRelationship</super> <private>false</private> none token <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMFirstOrderRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. First order relationships are not built based on any other relationship. Computes a relationship by delegating the question to the lement. Subclases may further refine the answers by applying some particular logic to the results. Instance Variables: token <Symbol> the token to be passed to the elements when computing the relationship. According to the token the element decides which set of related elements it returns. One typical implementation at the element side is to send the token to itself as amessage and return the result. This is useful as a token because this way it can be sent to any object, and if the object does not implement the relationship, an empty set will be returned, which is the right default.'
</comment> <class> <name>LDMGraphElementWrapper</name> <environment>Lens</environment> <super>Lens.LDMAbstractElementWrapper</super> <private>false</private> none builder <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMGraphElementWrapper
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>LensBrowsingToolModel</name> <environment>Lens</environment> <super>UI.ApplicationModel</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LensBrowsingToolModel
This class is private to the implementation of LensGraphView. Users should not use this class directly and should not subclass it. '
</comment> <class> <name>LDMDiadicRel</name> <environment>Lens</environment> <super>Lens.LDMHighOrderRel</super> <private>false</private> none r1 r2 <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMDiadicRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A relationship composed of two other relationships. Instance variables: r1 <LDMRelationship> the first composing relationship r2 <LDMRelationship> the second one'
</comment> <class> <name>LDMArrowView</name> <environment>Lens</environment> <super>UI.LabeledBooleanView</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMArrowView
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>LDMPerspective</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none rows labelHints relDesc name <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMPerspective
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Instance variables: rows <List of: Array> see the class method 'initialize' for an explanation labelHints <List of: Symbol> hints to be used in the construction of element views. For example, a perspective may want the labels to be as short as possible, then it may have as hint #small. The hint is then passed to the elements which can cooperate (or not) in doing what the hint was meant to mean. The hints are the mechanism for displaying the same element in different ways according to the perspective. relDesc <List of: Array> the description of the relationships, for each relationship that appears in the perspective there is an indication of the width of the line, the color and whteher it is displayed or not. name <Symbol> the name of the perspective - the name should be unique in the system'
</comment> <class> <name>LensGraphView</name> <environment>Lens</environment> <super>Lens.LensBrowsingToolModel</super> <private>false</private> none bm focus perspective <imports></imports> <category>Lens-Private-Tools-Support</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LensGraphView
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 as a subCanvas in any lens application using graphical browsers. It encapsulate the browser's capabilities so they are really easy to integrate into any application. This class defines some utility methods to isolate the world of the browsers from the Lens tools.'
</comment> <class> <name>LDMElementProxy</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none element context Elements <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMElementProxy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. A proxy is used when it is important not to change the elements to be displayed in a browser or when the elements to be displayed are of several different kinds. There are two ways in which the proxies can be remembered and accessed when a proxy for the same element is needed. The first way is to use the 'Elements' class instance variable. The second is to use the 'context'. If Using the Elements class instance variable extra care should be taken because by virtue of being in this dictionary they will not be garbage collected. An implementation with weak dictionaries could have been better. Class instance variables: Elements <Dictionary> keeps the instances of myself, the elements are the keys Instance Variables: element <Object> the element we are wrapping context <Dictionary | Object> the context where the proxies are kept associated with the elements so the proxy for a specific element can be found'
</comment> <class> <name>LDMReversingElementProxy</name> <environment>Lens</environment> <super>Lens.LDMElementProxy</super> <private>false</private> none related <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMReversingElementProxy
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This proxy keeps track of the elements that relate to us, so the reverse relationship can be computed. Note that the reverse relationship will be correct only for those elements for which the forward relationship has already been computed. That is, this will not work to find all the 'callers' on a function, if the calling functions were not asked for the functions they call. Note that the implementation of this class makes use of the 'Elements' dictionary in the class. This is done by virtue of calling 'self class at:'. Instance Variables: related <Dictionary> indexed by the relationship. Keeps a Set for each relationship. In the set there are all the KNOWN elements that relate to our element through the relationship'
</comment> <class> <name>LDMOrRel</name> <environment>Lens</environment> <super>Lens.LDMDiadicRel</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMOrRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The conjunction between two relationships. The relationship includes all the pairs that comply with either one of the basic relationships.'
</comment> <class> <name>LDMCompositeViewController</name> <environment>Lens</environment> <super>UI.ControllerWithMenu</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMCompositeViewController
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I add the menu actions '
</comment> <class> <name>LDMCompositeView</name> <environment>Lens</environment> <super>UI.CompositeView</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMCompositeView
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>LDMGraphCompositeView</name> <environment>Lens</environment> <super>Lens.LDMCompositeView</super> <private>false</private> none builder <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMGraphCompositeView
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>LDMArc</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none varOnSide isRestrictedOnSide relationship activePhases generator <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMArc
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The class represents an Arc in the perspective definition graph and is used in computing initial displayable graphs as well as updating displayable graphs as the user opens relationships. Instance Variables: varOnSide <Array of: Variable> By side. The two variables on either side of the arc isRestrictedOnSide <Array of: Boolean> By side. Holds for each side whether there is a restriction on that side. relationship <LDMRelationship> Type of relationship that this arc represents. activePhases <Set of: Symbol> Phases during which this arc operates (initial, userOpens, automatic...) generator <LDMRelationsGenerator> '
</comment> <class> <name>LDMRelationsBody</name> <environment>Lens</environment> <super>Lens.LDMAbstractBody</super> <private>false</private> none composite generator graph canOpen visualBuilder <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMRelationsBody
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The graph is displayed as a real graph, with elements represented by nodes in the graph and relationships represented by arcs between them. Instance Variables: composite <LDMGraphCompositeView> the composite where the graph is drawn generator <LDMRelationsGenerator> used to generate the relationships. Holds the graph and the user opens graph graph <LDMGraph> the graph of elements and relationships canOpen <LDMGraph> the graph of the relationships that the user can open visualBuilder <LDMAbstractVisualBuilder> the builder helps in constructing the graph to be displayed'
</comment> <class> <name>LDMLimitingRel</name> <environment>Lens</environment> <super>Lens.LDMMonadicRel</super> <private>false</private> none limitingBlock <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMLimitingRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. The relationship is defined as a restricted version of a basic relationship. A better implementation would also give the element for whom the relationship is being composed to the limiting block. Instance Variable: limitingBlock <BlockClosure> the single argument block to be used to determine whether an element should be included in the resulting set or not.'
</comment> <class> <name>LDMProtoMapBuilder</name> <environment>Lens</environment> <super>Lens.LDMGraphBuilder</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMProtoMapBuilder
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This is a specialized builder, specifically dedicated to displaying graphs with database columns. After the graph is computed and everything built, it reallocates the columns so they are all in one column. This way they look nice in the mapping tool graph. This is a good example of how the graph rendering can be easily modified to suit specific requirements that do not fit into the parameters to the graph rendering algorithms.'
</comment> <class> <name>LDMElementViewController</name> <environment>Lens</environment> <super>UI.ControllerWithMenu</super> <private>false</private> none charged <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMElementViewController
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I redefine drag and drop functionality'
</comment> <class> <name>LDMSelectionService</name> <environment>Lens</environment> <super>UI.Model</super> <private>false</private> none viewsValue performersValue GlobalInstance <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMSelectionService
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. I keep track of the selected views and can propagate request for deselection. I also provide convenience protocol to send messages to the performers of the views. Instance Variables viewsValue <ValueModel on: OrderedCollection of: views> currently selected views performersValue <BlockValue> computes the performers corresponding to the selected views'
</comment> <class> <name>LDMBrowserModel</name> <environment>Lens</environment> <super>UI.Model</super> <private>false</private> none body focusHolder perspectiveHolder attributes selectionService application visualBuilderClass <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMBrowserModel
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 model for browser body views. It holds and controls a body which has and/or computes the contents of the view. This class updates the body whenever the focus or perspective changes. Instance Variables: body <LDMAbstractBody> The view computation body focusHolder <ValueModel on: IdentitySet> (or something that behaves like a Set) perspectiveHolder <ValueModel on: LDMPerspective> attributes <IdentityDictionary - keys are relationships, values are relationship attributes. They are used to decide on whether to display a relationship, what color it is, etc. The values are taken from the perspective, they could conceivably be changed programatically. selectionService <LDMSelectionService> Can be shared with other models or the whole system. Whenever VisualWorks is made to use the host machine selection service, it is possible that changes will be required here'
</comment> <class> <name>LDMElementView</name> <environment>Lens</environment> <super>UI.CompositeView</super> <private>false</private> none dependents element hasIn hasOut povIcons firstPovIconX touchFlag selected label recycle <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMElementView
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. LDMElementView is the graphical representation of an element, It holds the element's label, the in and out arrows and any perspective icon attached to the element. Instance Variables: hasIn <nil | Boolean> nil ::= doesn't have incoming (to the left) relationships false ::= all the incoming relationships are already open in the graph true ::= there are incoming relationships not yet open in the graph hasOut <nil | Boolean> as hasIn but for outgoing (to the right) relationships povIcons <OrderedCollection of: CYPovIconView> The perspective icons attached firstPovIconX <Number> The X position of the first POV icon attached to the element (for drawing purposes) touchFlag <Boolean> when created or reused this flag is reset, so unused ones can be released selected <ValueHolder on: Boolean> true iff the element is selected label <Wrapper on: Label> the visual component for the element's label recycle <Boolean> true iff the elementView is to be used again and hence shouldn't be released even if it's container is released'
</comment> <class> <name>LDMNodeChild</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none rel node <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMNodeChild
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This class was created to hold an element and a relationship together. Initially, only the element was kept as the kid of another element in a graph, but later, when added flexibility was needed, the relationship indicated whether it should be dispayed, and in what color, therefore there was the need for holding onto the relationship that brought the child element. '
</comment> <class> <name>LDMSpecialRel</name> <environment>Lens</environment> <super>Lens.LDMFirstOrderRel</super> <private>false</private> none evaluationBlock <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMSpecialRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Gives the flexibility of defining a relationship outside the elements themselves. The compuation of the relationship is done in a block which can be arbitrary in its computation. Instance Variables: evaluationBlock <BlockClosure> performs the computation of the relationship. The single argument is the element for which the relationship is evaluated'
</comment> <class> <name>LDMRelationsGenerator</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none variables graph userOpensArcs userOpensGraph <imports></imports> <category>Lens-Private-Tools-Components</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMRelationsGenerator
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>LDMComposedRel</name> <environment>Lens</environment> <super>Lens.LDMDiadicRel</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMComposedRel
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Represents relationships that are formed by computing one relationship and then the other relationship on the result set. For example, the relationship between a method and all the classes that contain methods it calls can be represented by the relationship defined as the composition between callsRel and isContainedInRel.'
</comment> <class> <name>LDMBrowserSpec</name> <environment>Lens</environment> <super>UI.MenuComponentSpec</super> <private>false</private> none <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMBrowserSpec
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. BrowsertSpec describes the layout and external decoration of a browser view, which is expected to be supplied by the user's application at interface building time. LDMBrowserSpec is not accessible from the palette. It is only used internally, to create new windowSpecs having this spec in them you have to copy the spec from an existing windowSpec. See also comments on NamedSpec No Instance Variables'
</comment> <class> <name>LDMVariable</name> <environment>Lens</environment> <super>Core.Object</super> <private>false</private> none elements arcsOnSide <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMVariable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. This class represents one variable in a perspective definition and is used in computing initial displayable graphs as well as updating displayable graphs as the user opens relationships. A Variable is a holder for elements. When computing the graphs, the elements in this variable represent the computed set of variables that correspond to this variable. When elements are added to a variable they may cause other elements to be added to the variables at the other side of the relationships connected to this variable. Instance Variables: elements <Set of: Object> The elements that the variable holds arcsOnSide <Array of: Collection of: Arc> The Arcs outgoing from this variable one Collection per side. This was done as an array to allow for iterations on the 'sides' of a variable'
</comment> <class> <name>LDMFocusVariable</name> <environment>Lens</environment> <super>Lens.LDMVariable</super> <private>false</private> none focusNumber <imports></imports> <category>Lens-Private-Tools-Browsing</category> <attributes> <package>LDM-Framework</package> </attributes> </class> <comment> Lens.LDMFocusVariable
This class is private to the implementation of the ObjectLens. Users should not use this class directly and should not subclass it. Represent an LDMVariable that is initialized with the set of elements in the focus. The focus number is an interesting feature not in use in any of the applications, nor supported by the tools, but may be useful nevertheless. The idea is that there may be more than one focus set, in that case, the different numbered focus variables will get the numbered foci. This could be useful for a browser where there are two sets of elements that make sense for starting relationships. One example could be a browser where the focus is a group of methods and a class, the browser shows the call graph from the methods to methods included in the class. The focusNumber is not required for any of the applications currently using this browsing system. Instance Variables: focusNumber <Number> the index of this focus variable '
</comment> <name>ColumnNames</name> <environment>Lens.LDMPerspective</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <name>Perspectives</name> <environment>Lens.LDMPerspective</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <name>EmptyImage</name> <environment>Lens.LDMArrowView</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <name>FullImage</name> <environment>Lens.LDMArrowView</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <name>CachedBounds</name> <environment>Lens.LDMArrowView</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <name>Relationships</name> <environment>Lens.LDMRelationship</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>LDM-Framework</package> </attributes> <methods> Lens.LDMAbstractBody <category>initialize-release</category>
initialize "We start not locked, and therefore, no update may have been missed" locked := false. missedUpdate := nil
release "We have to remove our dependency on the foa members" foa notNil ifTrue: [foa do: [:f | f removeDependent: self]]. super release.
</methods> <methods> Lens.LDMAbstractBody <category>accessing</category>
foa "Answer the value for foa" ^foa
foa: aFoa "remove the dependency on the old foa, depend on the new one, notify our dependents that the foa changed and also the 'triples' meaning that the whole graph has changed" self doNotDepend. self setFoa: aFoa. self dependOnFoaDataBase. self changed: #cds with: #(#foa #triples ). ^aFoa
focus: aFocus ^self subclassResponsibility
getLabelHints "The label hints are passed from the perspective to the elements themselves. The hints may be defined in the perspective to affect the way the element is displayed for the specific perspective. For example if it is desired for a perspective that the elements display in a very small space, then the hints may be #small. Of course, the cooperation of the elements is required to pay attention to the hints" ^viewModel perspective labelHints
isLocked ^locked
perspective: aPerspective ^self subclassResponsibility
setFoa: aFoa ^foa := aFoa
upToDate "We missed an update if it is not nil, otherwise it is the update that we missed" ^missedUpdate isNil
viewModel "What is the model for the created views. The model is the LDMBrowserModel and it is used by the views created for each element" ^viewModel
viewModel: aModel "Set the model for the created views." viewModel := aModel
</methods> <methods> Lens.LDMAbstractBody <category>ors</category>
addAllToOrs: aCollectionOfRels "The ors is the Open Relationships Set, i.e. the graph. Subclasses implement this"
openAll: cfnode level: n out: isOut "Implemented by subclasses. Open all the relationships going out or in (according to isOut), for n levels"
</methods> <methods> Lens.LDMAbstractBody <category>updating</category>
lock locked := true
lock: bool bool ifTrue: [self lock] ifFalse: [self unLock]
makeUpToDate "This can be used even while remaining locked, so the previous state of locked is saved, and then set to false so the updates are performed. If there was a missed update, then we perform it now. Return the locked flag to its previous state and notify our dependents that we are up to date. This notification can be used by the window displaying the graph to indicate to the user that the view is up to date (when it is not up to date the user should be notified graphically so the user knows not to believe in the graph as if it was the current state of the world)" | saveLocked | saveLocked := locked. locked := false. missedUpdate notNil ifTrue: [self update: (missedUpdate at: 1) with: (missedUpdate at: 2). missedUpdate := nil]. locked := saveLocked. self changed: #cdsUpToDate with: true
missUpdate: aspect with: par "Record the update message that we are missing and make sure to notify our dependents that we are not up to date. This way the window can graphically show the user that the view is out of date" missedUpdate isNil ifTrue: [missedUpdate := OrderedCollection with: aspect with: par] ifFalse: [(missedUpdate at: 2) isNil ifTrue: [missedUpdate at: 2 put: par]]. self changed: #cdsUpToDate with: false.
unLock "Unlock and make sure we update if something happened while locked" locked := false. self makeUpToDate.
update: aspect with: par "If the database has changed and the parameter is #clear is an indication that the database does not contain any more information and any open browsers should be closed. Otherwise update the graph to reflect the change in the database" aspect = #dataBase ifTrue: [par ~~ #clear ifTrue: [self updateDataBase] ifFalse: [self changed: #cdsQuit]]
update: aspect with: par from: aSender "If the database is the one that changed and we are locked then record that we are missing an update" aspect == #dataBase ifTrue: [locked ifTrue: [self missUpdate: aspect with: par] ifFalse: [^self update: aspect with: par]]
updateDataBase "Update the display after a change in the database. Here it is implemented as: if the foa (Focus Of Attention) changed, then reset the view by resetting the focus" self updateFoa ifTrue: [self foa: foa]
updateFoa "Checks if the foa elements changed. Collect the new ones" "Elements are asked if they changed, the response may be 'false' indicating that it has not changes, 'nil' indicating that the element is not there any more, 'true' indicating it changed 'nil' indicating the element is not there any more 'another element' indicating that the element has been replaced by another element" | newFoa changed | changed := false. newFoa := OrderedCollection new. foa == nil ifFalse: [foa do: [:element | | newElement | newElement := element changed. newElement == false ifTrue: [newFoa addLast: element] ifFalse: [newElement notNil ifTrue: [newElement == true ifTrue: [newFoa addLast: element] ifFalse: [newFoa addLast: newElement]]. changed := true]]]. changed ifTrue: [foa := newFoa]. ^changed
</methods> <methods> Lens.LDMAbstractBody <category>private</category>
dependOnFoaDataBase "Add myself to the dependencies list of all the foa's data bases, so when they change I get the signal to update my graphs" foa size > 0 ifTrue: [foa do: [:f | f removeDependent: self; addDependent: self]]
doNotDepend foa size > 0 ifTrue: [foa do: [:f | f removeDependent: self]]
isNewFoaDifferent: newFoa "Return true if either foa is nil or if they do not contain the same elements" (foa notNil & newFoa notNil) ifTrue: [ | oldS newS | oldS := foa asSet. newS := newFoa asSet. ^(oldS - newS) size > 0 or: [(newS - oldS) size > 0]]. ^true
rebuild ^self subclassResponsibility
</methods> <methods> Lens.LDMAbstractBody class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMAbstractVisualBuilder <category>initialize-release</category>
flush "Cleanup everything and get ready to begin from a clean state" composite := LDMGraphCompositeView model: self viewModel. composite builder: self. builder := UIBuilder new. builder source: self viewModel. builder composite: composite
initialize "Initialize the nodeDict to an identity dictionary of some big size since we know that it will probably contain a few tens of elements" nodeDict := IdentityDictionary new: 101.
initializeVisualComponentAsCFList "Initialize the visualComponentBlock to produce list element wrappers" self visualComponentBlock: [:bldr :object | LDMListElementWrapper on: (LDMElementView for: object model: bldr viewModel) at: 0 @ 0]
initializeVisualComponentAsCFTree "Initialize the visual component block to produce graph element browsers. This method would make more sense in the subclasses, but it is present here just in case it needs to be reused by unrelated subclasses" self visualComponentBlock: [:bldr :object | | ev | ev := LDMElementView for: object model: bldr viewModel. LDMGraphElementWrapper on: ev at: 0 @ 0 builder: bldr]
initializeVisualConnectionAsBroom "Initialize the connection block, which is the one that builds the visual components to render relationships in the graph. In this case it is a 'broom' which connects the elements in the typical way" self visualConnectionBlock: [:bldr :node :children | | connections | connections := LDMBroomConnection orientation: bldr orientation parent: node children: children builder: bldr. connections model: viewModel. Array with: connections]
initializeVisualConnectionAsListReference "not used"
releaseVisuals "Make sure that all the visuals that are not used are properly released" | toRemove | toRemove := OrderedCollection new. nodeDict keysAndValuesDo: [:el :node | node pass == #defunct ifTrue: [node release. toRemove add: el]]. toRemove do: [:el | nodeDict removeKey: el]
visualComponentBlock: aBlock "Private" visualComponentBlock := aBlock
visualConnectionBlock: aBlock "private" visualConnectionBlock := aBlock
</methods> <methods> Lens.LDMAbstractVisualBuilder <category>accessing</category>
childrenFor: element "Return all the children for an element. Sorted according to their sortKey" | unsorted elemKids | unsorted := graph relationshipsOutFromElement: element. elemKids := SortedCollection new: unsorted size. elemKids sortBlock: [:a :b | a node sortKey <= b node sortKey]. unsorted keysAndValuesDo: [:rel :els | (self shouldDisplayRel: rel) ifTrue: [els do: [:el | elemKids add: (LDMNodeChild node: el rel: rel)]]]. ^elemKids asOrderedCollection
composite ^composite
graph: aGraph graph := aGraph
viewModel ^viewModel
viewModel: aModel viewModel := aModel
visualForElement: anElement "Returns the component found in the nodes dictionary under the anElement key. If none is found returns nil" ^(nodeDict at: anElement ifAbsent: [^nil]) component
</methods> <methods> Lens.LDMAbstractVisualBuilder <category>build</category>
build "Build graph wrappers around the elements, connecting children, and computing depth. Note that internalBuild is implemented in the subclasses" self buildNodes. self nodesDo: [:elem | self internalBuild: elem depth: 1]
buildNodes "Make sure we have a node for each element. Mark the nodes that we do not have an element for them anymore as #defunct. For each node used update the children of the node" graph elementsDo: [:object | | node | node := nodeDict at: object ifAbsent: [nil]. node ~~ nil ifTrue: [node flush] ifFalse: [node := visualComponentBlock value: self value: object. nodeDict at: object put: node]. composite addWrapper: node]. nodeDict keysAndValuesDo: [:object :node | node flushed ifTrue: [| elemKids | elemKids := self childrenFor: object. elemKids do: [:kid | kid node: (nodeDict at: kid node)]. node children: elemKids] ifFalse: [node pass: #defunct]]
internalBuild: node depth: aDepth ^self subclassResponsibility
visualForGraph: aGraph viewModel: aModel "This is the main method for building a graph. Follow these steps to understand the whole process" self graph: aGraph. self viewModel: aModel. self flush. self build. self layout. self releaseVisuals. ^composite
</methods> <methods> Lens.LDMAbstractVisualBuilder <category>private</category>
horizontalSpacing "Can be reimplemented by subclasses to do something else, maybe a variable spacing?" ^spacing x
nodesDo: aBlock "Iterate thru all currently active nodes. Non active ones are marked as #defunct" nodeDict do: [:node | node pass == #defunct ifFalse: [aBlock value: node]]
shouldDisplayRel: rel "Whether or not a relationship should be displayed. The perspective holds a list of attributes for each relationship included in it, the second attribute indicates whether or not the relationship is displayed. For certain perspectives, a relationship can be used to compute the graph but it is actually not displayed" ^(viewModel attributesForRel: rel) at: 2
verticalSpacing "Can be reimplemented by subclasses to do something else, maybe a variable spacing?" ^spacing y
</methods> <methods> Lens.LDMAbstractVisualBuilder <category>layout</category>
layout ^self subclassResponsibility
</methods> <methods> Lens.LDMAbstractVisualBuilder class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMGraphBuilder <category>initialize-release</category>
flush "Clear also the positions of the columns" super flush. columnPositions := nil.
initializeForHorizontal "Initialize the constants for creating n horizontally layed out graph" orientation := #horizontal. spacing := 16@0
initializeForVertical "Initialize the constants for creatingin vertically layed out graph. The vertical graphs do not work as well as horizontal ones, no vertical graph is used in the system" orientation := #vertical. spacing := 10@20
</methods> <methods> Lens.LDMGraphBuilder <category>build</category>
build "Build graph wrappers around the elements, connecting children, and computing depth. Initialize the buildPath before starting to build" buildPath := OrderedCollection new. super build.
internalBuild: node depth: aDepth "We are currently building for depth 'aDepth'. If the node does not have a depth or its previous depth is less, make it 'aDepth' (after checking that this is not recursion). Descend any nodes we have not previously encountered or whose depths have changed." | descend | descend := false. buildPath changeSizeTo: (aDepth max: buildPath size); at: aDepth put: node. (node depth == nil or: [node depth < aDepth and: [(buildPath indexOf: node) >= aDepth]]) ifTrue: [node depth: aDepth. descend := true]. node pass == #build ifFalse: [descend := true]. node pass: #build. descend ifTrue: [node children do: [:kidNode | self internalBuild: kidNode node depth: aDepth + 1]]
visualForGraph: aGraph viewModel: aModel "This is actually identical to the parent's method" self graph: aGraph. self viewModel: aModel. self flush. self build. self layout. self releaseVisuals. ^composite
</methods> <methods> Lens.LDMGraphBuilder <category>construction-accessing</category>
channelOffsets ^channelOffsets
columnPositions "Return an ordered collection of locations of columns" ^columnPositions
highwayPositions "Return an ordered collection of locations of highways" ^hwyPositions
orientation ^orientation
</methods> <methods> Lens.LDMGraphBuilder <category>layout</category>
centerOfKids: myKids "Determine the row position which is the center of the newly laid out kids. Assume the kids are in row order." | low high | self isHorizontal ifTrue: [low := (myKids at: 1) bounds top. high := (myKids at: myKids size) bounds bottom] ifFalse: [low := (myKids at: 1) bounds left. high := (myKids at: myKids size) bounds right]. ^low + high // 2
channelThickness "How much space to leave for a channel" ^8
computePendingChannelsFrom: node toChildren: children "Figure out which recursion channels will be needed later for connections out from this 'node' to 'children'." "Remember pending channels for later when the recursion unwinds towards the root." | ndepth cshallow | cshallow := nil. ndepth := node depth. 1 to: children size do: [:i | | cdepth | cdepth := (children at: i) node depth. (cdepth <= ndepth and: [cshallow == nil or: [cshallow < cdepth]]) ifTrue: [cshallow := cdepth]]. cshallow == nil ifFalse: [(channelsPending at: cshallow) add: node]
connectToChildren: node "Make graphical connections between node 'node' and all of its children. But first figure out which recursion channels will be needed later for connections out from this node and reserve channels needed at this depth." | children | children := node children. children size > 0 ifTrue: [self computePendingChannelsFrom: node toChildren: children. self reservePendingChannelsFor: node. (visualConnectionBlock value: self value: node value: children) do: [:c | composite add: c]]
layout | level1 oneNode | composite computePreferredBounds. self setColumns. oneNode := nodeDict detect: [:n | true] ifNone: [nil]. oneNode == nil ifFalse: [self isHorizontal ifTrue: [| height | height := oneNode bounds height. midPoint := height // 2. nodeExtent := height + self verticalSpacing] ifFalse: [| width | width := oneNode bounds width. midPoint := width // 2. nodeExtent := width + self horizontalSpacing]]. channelsPending := Array new: columnPositions size. 1 to: columnPositions size do: [:i | channelsPending at: i put: OrderedCollection new]. channelOffsets := IdentityDictionary new. level1 := SortedCollection sortBlock: [:a :b | a component sortKey <= b component sortKey]. self nodesDo: [:node | node isRoot ifTrue: [level1 add: node]]. level1 do: [:node | self layoutNode: node]. composite flushCoordinateCaches; computePreferredBounds
layoutDeepestDepth: depth kidsOf: node kids: myKids "Layout the portion of the subgraph rooted at 'node' which has the deepest depth." "'depth' is the depth of the kids (there are no deeper)." "'node' is the parent." "'myKids' are the children of 'node' which are at depth 'depth' and have not been laid out already." | pos currentMin sz | currentMin := mins at: depth - 1. sz := myKids size. sz > 0 ifTrue: [self minAt: depth atLeast: currentMin - (sz - 1 * (node bounds height + self verticalSpacing) // 2). 1 to: sz do: [:i | self layoutNode: (myKids at: i)]. pos := (self centerOfKids: myKids) - (node bounds height // 2) max: currentMin] ifFalse: [pos := currentMin]. self moveNode: node to: pos. self stepNextPositionFor: node
layoutDepth: depth kidsOf: node "Layout the subgraph rooted at node." "'depth' is the depth of the kids." "'node' is the parent." | myKids deeper children | myKids := OrderedCollection new. deeper := false. children := node children. children do: [:ch | | child | child := ch node. child depth = depth ifTrue: [child pass == #build ifTrue: [myKids add: child]] ifFalse: [child depth > depth ifTrue: [deeper := true]]]. deeper ifTrue: [self layoutNonDeepestDepth: depth kidsOf: node kids: myKids] ifFalse: [self layoutDeepestDepth: depth kidsOf: node kids: myKids]
layoutNode: node "Layout the subgraph rooted at node." self layoutDepth: node depth + 1 kidsOf: node. self connectToChildren: node. node pass: #final
layoutNonDeepestDepth: depth kidsOf: node kids: myKids "Layout the portion of the subgraph rooted at 'node' which is at depth 'depth'." "Technique: layout half the kids, then layout the deeper kids (this causes space to be reserved for the line out to the deeper kids), then layout the other half of the kids." "'depth' is the depth of the kids (there are deeper kids of 'node')." "'node' is the parent." "'myKids' are the children of 'node' which are at depth 'depth' and have not been laid out already." | midIndex sz | sz := myKids size. midIndex := sz // 2. self minAt: depth atLeast: (mins at: node depth) - (midIndex * (node bounds height + self verticalSpacing)). 1 to: midIndex do: [:inx | self layoutNode: (myKids at: inx)]. self minAt: depth + 1 atLeast: (mins at: depth). self layoutDepth: depth + 1 kidsOf: node. self minAt: depth atLeast: ((mins at: depth + 1) max: (mins at: node depth)). midIndex + 1 to: sz do: [:inx | self layoutNode: (myKids at: inx)]. ^self
minAt: depth atLeast: aMin "Make sure the min row position is at least 'aMin'." mins at: depth put: ((mins at: depth) max: aMin)
moveNode: aNode to: anOffset aNode setOrigin: anOffset@anOffset
reservePendingChannelsFor: node "Reserve channels needed at this depth." "If the node needing the channel is the current node then it is just direct recursion, handle it simply. Otherwise, make sure the channel is far enough down for all the depths it will pass through, then adjust the mins for all those depths to make room for the channel." | ndepth chanPend | ndepth := node depth. chanPend := channelsPending at: ndepth. chanPend size > 0 ifTrue: [| dmin | dmin := mins at: ndepth. 1 to: chanPend size do: [:i | | pend | pend := chanPend at: i. pend == node ifTrue: [| bot | bot := node bounds bottom. channelOffsets at: pend put: bot. dmin < (bot + self channelThickness) ifTrue: [channelsPending at: ndepth put: (dmin := dmin + self channelThickness)]] ifFalse: [ndepth + 1 to: pend depth do: [:dep | dmin := dmin max: (mins at: dep)]. channelOffsets at: pend put: dmin. dmin := dmin + self channelThickness. ndepth to: pend depth do: [:dep | mins at: dep put: dmin]]]. channelsPending at: ndepth put: OrderedCollection new. mins at: ndepth put: dmin]
setColumns "Determine where the element columns and the highways will be. Do so by determining the largest element in each column. Allow room for one perspective icon. Highway width is computed from the number of lines in the column - this computation should get even more sophisticated." | widths pos counts | widths := OrderedCollection new. counts := OrderedCollection new. self nodesDo: [:node | | depth w oldW oldCount | depth := node depth. w := node preferredBounds width. (widths size < depth or: [(oldW := widths at: depth) == nil or: [w > oldW]]) ifTrue: [widths changeSizeTo: (depth max: widths size); at: depth put: w]. (counts size < depth or: [(oldCount := counts at: depth) == nil]) ifTrue: [oldCount := 0]. counts changeSizeTo: (depth max: counts size); at: depth put: 1 + oldCount]. columnPositions := Array new: widths size. hwyPositions := Array new: widths size. mins := Array new: widths size. pos := 10. 1 to: widths size do: [:depth | mins at: depth put: 10. columnPositions at: depth put: pos. pos := pos + (widths at: depth) + 18 "Room for Icon". hwyPositions at: depth put: pos. pos := pos + 10 + ((counts at: depth) + ((counts size < (depth + 1)) ifTrue: [0] ifFalse: [counts at: depth + 1]) * 2)]
</methods> <methods> Lens.LDMGraphBuilder <category>private</category>
isHorizontal ^orientation == #horizontal
stepNextPositionFor: node "Assign final position to leaf node." | bounds | bounds := node bounds. mins at: node depth put: ( (self isHorizontal ifTrue: [bounds bottom + self verticalSpacing] ifFalse: [bounds right + self horizontalSpacing]) max: (mins at: node depth))
</methods> <methods> Lens.LDMGraphBuilder class <category>instance creation</category>
newTree | b | b := self new. b initializeForHorizontal. b initializeVisualConnectionAsBroom. b initializeVisualComponentAsCFTree. ^b
</methods> <methods> Lens.LDMRelationship <category>initialize release</category>
reset "The reverse relationship can be a symbol or the relationship itself. If it is a symbol, then the relationship is searched for and the symbol is replaced. If the relationship is not found, then nil is used instead, the reverse will be computed if needed." reverse isSymbol ifTrue: [reverse := self class at: reverse ifAbsent: [nil]]
</methods> <methods> Lens.LDMRelationship <category>accessing</category>
description ^description
description: aString description := aString
name ^name
name: nm name := nm. ^self
r1 "Used only when building perspectives. A more general UI would ask how many relationships the relationship is composed of" ^nil
r2 "Used only when building perspectives. A more general UI would ask how many relationships the relationship is composed of" ^nil
reverse "Returns the reverse relationship. If it is currently nil, then it computes it" reverse isNil ifTrue: [self computeReverse]. reverse isSymbol ifTrue: [reverse := self class at: reverse]. ^reverse
reverse: rr "rr is either the reverse relationship itself or its name" reverse := rr
token "Used only when building perspectives. A more general UI would ask if the relationship has a token" ^nil
</methods> <methods> Lens.LDMRelationship <category>computing</category>
computeReverse "Computes the reverse relationship" ^self subclassResponsibility
relatedTo: el "returns all the elements related to el through myself. This is the main method for the computation of a relationship. Subclasses override it to implement their own computation" ^IdentitySet new
</methods> <methods> Lens.LDMRelationship <category>printing</category>
printOn: aStream "For debugging purposes. Prints the name of the relationship" aStream nextPutAll: 'Rel'. aStream nextPut: $<. aStream nextPutAll: name. aStream nextPut: $>.
storeOn: aStream "Before storing in the stream transform the reference to the reverse relationship into a symbol. Reassign the reverse relationship after storing. This way an infinite loop is avoided and the references to relationships are stored as symbols" | r | r := reverse. r notNil ifTrue: [reverse := r name asSymbol]. super storeOn: aStream. reverse := r
</methods> <methods> Lens.LDMRelationship <category>private</category>
fromLiteralArrayEncoding: anArray "The literal array encoding includes the names of the messages that need to be sent to reconstruct the Relationship. This method would probably make sense in Object" 2 to: anArray size by: 2 do: [:i | self perform: (anArray at: i) with: (anArray at: i + 1)]. LDMRelationship at: name asSymbol put: self
literalArrayEncoding "encode the name, description and the reverse relationship as a symbol" | oc | oc := OrderedCollection new. oc add: self class fullyQualifiedReference. oc add: #name:. oc add: name. oc add: #description:. oc add: description. oc add: #reverse:. reverse isNil ifTrue: [oc add: nil] ifFalse: [oc add: reverse name asSymbol]. ^oc
</methods> <methods> Lens.LDMRelationship class <category>class initialization</category>
initialize "Relationship initialize" "Creates the relationships that will be used anywhere in the application. An additional class method is provided in order to add relationships to this dictionary" Relationships := IdentityDictionary new. LDMSpecialRel initialize.
initializeRelationships "Creates and returns a list of relationships. The creation of the relationships adds them into the relationships dictionary. Only first order relationships are created here. The literal array includes: name - the name of the relationship (used in menus) description - a longer description than the name token - the symbol sent to the elements to tell them to compute the relationship. By convention it is <name>Rel, the reverse relationship is <name>RRel Reverse relationships should be created to have their name and description correct." "self initializeRelationships" ^List new add: #(#LDMFirstOrderRel #name: 'calls' #description: 'calls' #reverse: nil #token: #callsRel ) decodeAsLiteralArray; add: #(#LDMFirstOrderRel #name: 'callsR' #description: 'calls' #reverse: nil #token: #callsRRel ) decodeAsLiteralArray; add: #(#LDMFirstOrderRel #name: 'contains' #description: 'contains' #reverse: nil #token: #containsRel ) decodeAsLiteralArray; add: #(#LDMFirstOrderRel #name: 'containsR' #description: 'is contained in' #reverse: nil #token: #containsRRel ) decodeAsLiteralArray; add: #(#LDMFirstOrderRel #name: 'callsR' #description: 'is called by' #reverse: #calls #token: #callsRRel ) decodeAsLiteralArray; yourself
</methods> <methods> Lens.LDMRelationship class <category>instance creation</category>
complexRelationship: relDef "Given the definition of a complex relationship, build and return it. The description of relDef is found in the comments for 'createSingleRelationship:" | def op newRel | def := relDef at: 2. op := def at: 1. op == #+ ifTrue: [newRel := LDMTransitiveClosureRel newWithRel: (self at: (def at: 2))] ifFalse: [op == #or ifTrue: [newRel := LDMOrRel newWithRel: (self at: (def at: 2)) andRel: (self at: (def at: 3))] ifFalse: [op == #@ ifTrue: [newRel := LDMComposedRel newWithRel: (self at: (def at: 2)) andRel: (self at: (def at: 3))] ifFalse: [def size == 2 ifTrue: [newRel := op asQualifiedReference value newWithRel: (self at: (def at: 2))] ifFalse: [newRel := op asQualifiedReference value newWithRel: (self at: (def at: 2)) andRel: (self at: (def at: 3))]]]]. Relationships at: (relDef at: 1) put: newRel. ^newRel
createRelationships: relsList "The parameter is a list of descriptions of relationships, create the corresponding relationship for each one of them" relsList do: [:r | self createSingleRelationship: r]
createSingleRelationship: rd "The purpose of this method is to aid in building new relationships programatically" "rd is the relationship description, as follows: #(<textual name> <relationship definition> <textual name of reverse relationship>) where <relationship definition> is: <simple symbol> or (<symbol> <complex relationship definition>) If <simple symbol> is given then the symbol is used as both, the name of the relationship and the token for a LDMFirstOrderRel. Otherwise, the <symbol> is the name and the complex relationship definition is parsed" "NOTE - we do not check for errors since this method is not open to the users" | relDef newRel reverseRel | relDef := rd at: 2. relDef isSymbol ifTrue: [ Relationships at: relDef put: (newRel := LDMFirstOrderRel withToken: (self relify: relDef)) ] ifFalse: [ newRel := self complexRelationship: relDef ]. newRel name: (rd at: 1). (rd size == 4) ifTrue: [ reverseRel := self complexRelationship: (rd at: 4) ] ifFalse: [ reverseRel := newRel reverse ]. reverseRel name: (rd at: 3)
new ^super new
relify: sym "A utility method to add 'Rel' at the end of a symbol and make it a new symbol" ^(sym, 'Rel') asSymbol
</methods> <methods> Lens.LDMRelationship class <category>accessing</category>
at: aSymbol "The symbol represents the name of the wanted relationship. Returns the relationship found in the dictionary of relationships at the symbol key" ^(Relationships at: aSymbol)
at: aSymbol ifAbsent: aBlock "The symbol represents the name of the wanted relationship. Returns the relationship found in the dictionary of relationships at the symbol key" ^(Relationships at: aSymbol ifAbsent: aBlock)
at: aSymbol put: aRel "Puts the relationship in the dictionary using aSymbol as the key" ^(Relationships at: aSymbol put: aRel)
relationshipNames "Returns a collection with the names of the relationships. Note that the symbols used are the keys to the dictionary rather than taking the name from the relationships themselves - they should be consistent" ^Relationships keys collect: [:n | n asString]
remove: aSymbol "Available for development tools" Relationships removeKey: aSymbol
</methods> <methods> Lens.LDMRelationship class <category>file In/Out</category>
readFromFile: aFileName "aFileName can either be a string representing the name of the file or the Filename. This method reads the definitions of the relationships into the named file. These definitions are added to the current ones, hence in order to replace the current ones, Relationships initialize should be called first" | in newP | in := aFileName asFilename readStream. newP := self evaluatorClass new evaluate: in in: nil to: self notifying: self ifFail: [^nil]. in close. newP keysAndValuesDo: [:k :v | v notNil ifTrue: [Relationships at: k put: v]]. Relationships do: [:r | r reset].
saveInFile: aName | out | out := aName asFilename writeStream. Relationships storeOn: out. out close
</methods> <methods> Lens.LDMRelationship class <category>private</category>
decodeFromLiteralArray: anArray "Return an instance based on the information encoded in anArray." ^self new fromLiteralArrayEncoding: anArray
</methods> <methods> Lens.LDMMonadicRel <category>initialize release</category>
reset "After readed references are symbols" r1 isSymbol ifTrue: [r1 := self class at: r1 ifAbsent: [nil]].
</methods> <methods> Lens.LDMMonadicRel <category>accessing</category>
r1 ^r1
r1: basicRel r1 := basicRel. ^self
</methods> <methods> Lens.LDMMonadicRel <category>computing</category>
computeReverse "The default is to reverse the basic relationship. This default may or may not be correct for specific subclasses" reverse := self class newWithRel: r1 reverse
</methods> <methods> Lens.LDMMonadicRel <category>printing</category>
storeOn: aStream | q1 | q1 := r1. r1 := q1 name asSymbol. super storeOn: aStream. r1 := q1.
</methods> <methods> Lens.LDMMonadicRel class <category>instance creation</category>
new ^self shouldNotImplement
newWithRel: basicRel "create an instance with the basicRel" ^self newWithRel: basicRel named: nil
newWithRel: basicRel named: nm "create an instance with the basicRel" ^(super new r1: basicRel) name: nm
</methods> <methods> Lens.LDMNonReflexiveRel <category>computing</category>
relatedTo: el "Selects only those rels where the acted is different than the actor" ^(r1 relatedTo: el) select: [:e2 | e2 ~~ el ]
</methods> <methods> Lens.LDMTransitiveClosureRel <category>computing</category>
computeReverse "returns the transitive closure of its component reversed" reverse := LDMTransitiveClosureRel newWithRel: r1 reverse
relatedTo: el "Starts with the set that results from applying one time the basicRelationship. Then applies it to all of the members in the set, as many times as required (it stops when the set doesn't grow any more elements ). Remember that here we are interested only in the relationship between the root and all the tree. This computation can be quite expensive. The algorithm presented here is completely general. A more specific solution for specific cases can be implemented in the elements themselves" | resultSet incrementSet | resultSet := r1 relatedTo: el. incrementSet := resultSet copy. [incrementSet isEmpty] whileFalse: [| newIncrementSet | newIncrementSet := IdentitySet new. incrementSet do: [:newEl | newIncrementSet addAll: (r1 relatedTo: newEl)]. incrementSet := IdentitySet new. newIncrementSet do: [:newEl2 | (resultSet includes: newEl2) ifFalse: [incrementSet add: newEl2. resultSet add: newEl2]]]. ^resultSet
</methods> <methods> Lens.LDMVisualTreeConnection <category>initialize-release</category>
flushCaches preferredBounds := nil
flushCoordinateCaches preferredBounds := nil
initialize super initialize. orientation := #horizontal
</methods> <methods> Lens.LDMVisualTreeConnection <category>bounds accessing</category>
preferredBounds preferredBounds == nil ifTrue: [self computePreferredBounds]. ^preferredBounds
</methods> <methods> Lens.LDMVisualTreeConnection <category>displaying</category>
displayOn: aGraphicsContext orientation == #horizontal ifTrue: [self displayHorizontalOn: aGraphicsContext] ifFalse: [self displayVerticalOn: aGraphicsContext].
</methods> <methods> Lens.LDMVisualTreeConnection <category>private</category>
childrenDo: aBlock "The block is executed for each one of the children" children do: [:ch | aBlock value: ch node]
computePreferredBounds | left p right first top bottom last | p := parent preferredBounds. first := self firstChild preferredBounds. last := self lastChild preferredBounds. orientation = #horizontal ifTrue: [left := p right. right := first left. top := first top min: p top. bottom := last bottom max: p bottom] ifFalse: [left := first left min: p left. right := last right max: p right . top := p top. bottom := first top]. preferredBounds := Rectangle left: left right: right top: top bottom: bottom
displayHorizontalOn: aGraphicsContext | p cp | p := parent bounds rightCenter + (2 @ 0). self childrenDo: [:c | cp := c bounds leftCenter - (2 @ 0). aGraphicsContext displayLineFrom: p to: cp]
displayVerticalOn: aGraphicsContext | p cp | p := parent bounds bottomCenter + (0 @ 2). self childrenDo: [:c | cp := c bounds topCenter - (0 @ 2). aGraphicsContext displayLineFrom: p to: cp]
firstChild children do: [:ch | ^ch node]
lastChild ^children last node
relsAndChildrenDo: aBlock "The block is executed for each NodeChild" children do: [:ch | aBlock value: ch rel value: ch node]
setOrientation: o parent: pvc children: childrenCollection orientation := o. parent := pvc. children := childrenCollection
setParent: pvc children: childrenCollection parent := pvc. children := childrenCollection
</methods> <methods> Lens.LDMVisualTreeConnection class <category>instance-creation</category>
orientation: o parent: p children: c ^self new setOrientation: o parent: p children: c
parent: p children: c ^self new setParent: p children: c
</methods> <methods> Lens.LDMAbstractElementWrapper <category>initialize-release</category>
flush depth := nil. pass := nil. children := nil. component == nil ifFalse: [component flush].
</methods> <methods> Lens.LDMAbstractElementWrapper <category>accessing</category>
children ^children
children: theChildren children := theChildren
depth ^depth
depth: aDepth depth := aDepth
flushed "Was this node flushed?" ^depth == nil.
isRoot: bol isRoot := bol
object ^component
pass ^pass
pass: aPass pass := aPass
</methods> <methods> Lens.LDMAbstractElementWrapper <category>testing</category>
isRoot ^isRoot isNil ifTrue: [depth == 1] ifFalse: [isRoot]
</methods> <methods> Lens.LDMListElementWrapper <category>accessing</category>
reference ^reference
reference: aRef reference := aRef
</methods> <methods> Lens.LDMIndentedListBuilder <category>initialize-release</category>
initialize super initialize. self reset.
reset bottom := 0. spacing := 16@4
</methods> <methods> Lens.LDMIndentedListBuilder <category>build</category>
internalBuild: node depth: aDepth "Build a node for 'elem'. We are currently building for depth 'aDepth'. If the node does not have a depth (i.e. has not been encountered before), ... Descend any nodes we have not previously encountered." "We do not deal with DAG nor Cyclic graphs right now" node pass ~~ #build ifTrue: [node depth: aDepth. node pass: #build. node children do: [:kidNode | self internalBuild: kidNode node depth: aDepth + 1]] ifFalse: [(aDepth > 1 and: [node depth == 1]) ifTrue: [self recursivelyReset: node toDepth: aDepth]]. ^node
recursivelyReset: aNode toDepth: aDepth "When a node is moved (maybe because a new reference was found, pushing the node farther), then itself and all its children have to be moved to deeper depths" | kids | aNode depth: aDepth. kids := aNode children. kids size > 0 ifTrue: [kids do: [:kid | self recursivelyReset: kid node toDepth: aDepth + 1]]
visualForGraph: aGraph viewModel: aModel self reset. ^super visualForGraph: aGraph viewModel: aModel
</methods> <methods> Lens.LDMIndentedListBuilder <category>layout</category>
layout | level1 | composite computePreferredBounds. referenceConnections := IdentityDictionary new. level1 := SortedCollection sortBlock: [:a :b | a component sortKey <= b component sortKey]. self nodesDo: [:node | node depth = 1 ifTrue: [level1 add: node]]. level1 do: [:node | self layoutNode: node]. composite flushCoordinateCaches; computePreferredBounds
layoutNode: node "Layout the subgraph rooted at node. " node setOrigin: node depth * self horizontalSpacing @ bottom. self stepNextPositionFor: node. node children do: [:kid | self layoutNode: kid node]. "node reference == nil ifFalse: [| connect | connect := referenceConnections at: node object ifAbsent: [| nc | nc := CYListReferenceConnection new. nc referent: node reference. composite add: nc. referenceConnections at: node object put: nc. nc]. connect addReference: node]"
</methods> <methods> Lens.LDMIndentedListBuilder <category>private</category>
stepNextPositionFor: node "Assign final position to leaf node." | bounds | bounds := node bounds. bottom := (bounds bottom + self verticalSpacing) max: bottom
</methods> <methods> Lens.LDMIndentedListBuilder class <category>instance creation</category>
newTree | b | b := self new. b initializeVisualConnectionAsBroom. b initializeVisualComponentAsCFList. ^b
</methods> <methods> Lens.LDMBroomConnection <category>accessing</category>
builder ^builder
builder: aBuilder builder := aBuilder
model ^model
model: aModel model := aModel
</methods> <methods> Lens.LDMBroomConnection <category>testing</category>
intersects: aRectangle "Answer whether the receiver intersects aRectangle." "If we have a known refreshArea see if we intersect it, if not assume we intersect everything." ^refreshArea == nil ifTrue: [true] ifFalse: [refreshArea intersects: aRectangle]
</methods> <methods> Lens.LDMBroomConnection <category>private</category>
computePreferredBounds | left p right top bottom chanOff | p := parent preferredBounds. top := p top. bottom := p bottom. right := p right. left := right. chanOff := builder channelOffsets at: parent ifAbsent: [nil]. self relsAndChildrenDo: [:rel :kid | | kidBounds | kidBounds := kid bounds. top := top min: kidBounds top. kid depth <= parent depth ifTrue: [| nextDepth | chanOff == nil ifFalse: [bottom := bottom max: chanOff + (self lineWidthFor: rel)]. nextDepth := parent depth + 1. right := right max: (nextDepth <= builder columnPositions size ifTrue: [builder columnPositions at: nextDepth] ifFalse: [(builder highwayPositions at: parent depth) + 30]). left := left min: (kid depth > 1 ifTrue: [builder highwayPositions at: kid depth - 1] ifFalse: [0])] ifFalse: [bottom := bottom max: kidBounds bottom. right := right max: kidBounds right]]. refreshArea := preferredBounds := Rectangle left: left right: right top: top bottom: bottom
displayHorizontalOn: aGraphicsContext "Display the broom. Compute a nexus which all (non-recursive) connection go thru. For each child node draw the line from parent to child. In the process compute the refreshArea, that is the area that if damaged we need to refresh." | par maxNexus chanOff cpxMin baseNexus oldLineWidth oldColor olw oc | chanOff := nil. cpxMin := nil. par := parent bounds rightCenter. maxNexus := baseNexus := (builder highwayPositions at: parent depth) @ par y. olw := oldLineWidth := aGraphicsContext lineWidth. oc := oldColor := aGraphicsContext paint. self relsAndChildrenDo: [:rel :kid | | cp cpx nexus nlw nc | (nlw := self lineWidthFor: rel) ~~ olw ifTrue: [aGraphicsContext lineWidth: (olw := nlw)]. (nc := self lineColorFor: rel) ~~ oc ifTrue: [aGraphicsContext paint: (oc := nc)]. cp := kid bounds leftCenter - (1 @ 0). kid depth <= parent depth ifTrue: [| firstCol | chanOff == nil ifTrue: [chanOff := builder channelOffsets at: parent]. cpx := cp x. (cpxMin == nil or: [cpx < cpxMin]) ifTrue: [cpxMin := cpx]. firstCol := kid depth > 1 ifTrue: [builder highwayPositions at: kid depth - 1] ifFalse: [0]. self halfEllipseOn: aGraphicsContext startPoint: cp xEnd: firstCol yEnd: chanOff startAngle: 90] ifFalse: [nexus := (builder highwayPositions at: kid depth - 1) @ par y. nexus <= par ifTrue: [nexus := par]. nexus >= maxNexus ifTrue: [maxNexus := nexus]. aGraphicsContext displayLineFrom: nexus to: cp]]. aGraphicsContext displayLineFrom: par to: maxNexus. chanOff == nil ifFalse: [| nextCol colPos nextDepth | colPos := builder columnPositions. nextDepth := parent depth + 1. nextCol := nextDepth <= colPos size ifTrue: [colPos at: nextDepth] ifFalse: [nil]. self halfEllipseOn: aGraphicsContext startPoint: baseNexus xEnd: nextCol yEnd: chanOff startAngle: -90. aGraphicsContext displayLineFrom: cpxMin @ chanOff to: baseNexus x @ chanOff]. aGraphicsContext lineWidth: oldLineWidth. aGraphicsContext paint: oldColor
halfEllipseOn: aGraphicsContext startPoint: startPoint xEnd: xEnd yEnd: yEndParm startAngle: startAngle | yStart yArc xhArc rect yEnd | (aGraphicsContext class == nil"CYPSGenerator") ifTrue: [^self halfEllipsePSOn: aGraphicsContext startPoint: startPoint xEnd: xEnd yEnd: yEndParm startAngle: startAngle ]. startPoint y < yEndParm ifTrue: [yStart := startPoint y. yEnd := yEndParm] ifFalse: [yStart := yEndParm. yEnd := startPoint y]. yArc := yEnd - yStart. xhArc := xEnd == nil ifTrue: [(yArc // 2) min: 30] ifFalse: [(xEnd - startPoint x) abs - 2]. xhArc * 2 > yArc ifTrue: [xhArc := yArc // 2]. rect := startPoint x - xhArc @ yStart corner: startPoint x + xhArc @ yEnd. aGraphicsContext displayArcBoundedBy: rect startAngle: startAngle sweepAngle: 180
halfEllipsePSOn: aGraphicsContext startPoint: startPoint xEnd: xEnd yEnd: yEndParm startAngle: startAngle | yStart yArc xhArc rect yEnd | startPoint y < yEndParm ifTrue: [yStart := startPoint y. yEnd := yEndParm] ifFalse: [yStart := yEndParm. yEnd := startPoint y]. yArc := yEnd - yStart. xhArc := xEnd == nil ifTrue: [yArc // 2] ifFalse: [(xEnd - startPoint x) abs - 2]. xhArc * 2 > yArc ifTrue: [xhArc := yArc // 2]. rect := Rectangle left: startPoint x right: startPoint x + (startAngle < 0 ifTrue: [xhArc] ifFalse: [xhArc negated]) top: yStart bottom: yEnd. aGraphicsContext displayArcBoundedBy: rect startAngle: startAngle sweepAngle: 180
lineColorFor: rel ^(model attributesForRel: rel) at: 4
lineWidthFor: rel ^(model attributesForRel: rel) at: 5
setOrientation: o parent: pvc children: childrenCollection builder: aBuilder self setOrientation: o parent: pvc children: childrenCollection. self builder: aBuilder
</methods> <methods> Lens.LDMBroomConnection class <category>instance-creation</category>
orientation: theOrientation parent: theParent children: theChildren builder: theBuilder ^self new setOrientation: theOrientation parent: theParent children: theChildren builder: theBuilder
</methods> <methods> Lens.LDMGraph <category>initialize-release</category>
initialize "Keys are the elements, values are dictionaries holding the relationships for each one of the sides" relationships := IdentityDictionary new
</methods> <methods> Lens.LDMGraph <category>accessing graph</category>
anyFromElement: el side: side "Returns whether 'el' has children." (self relationshipsFromElement: el side: side) do: [:elemSet | elemSet size > 0 ifTrue: [^true]]. ^false
elementsConnectedTo: el notIn: there "Returns all the elements connected to el which are not already in there" | elems | elems := IdentitySet new. 1 to: 2 do: [:side | (self relationshipsFromElement: el side: side) do: [:elemSet | elemSet do: [:e | (there includes: e) ifFalse: [elems add: e]]]]. ^elems
elementsFromElement: el side: side "Returns the 'children' or 'parents' (according to side) of el in an IdentitySet" | elems | elems := IdentitySet new. (self relationshipsFromElement: el side: side) do: [:elemSet| elems addAll: elemSet]. ^elems
elementsInFromElement: el "Returns the 'parents' of el as elements" ^self elementsFromElement: el side: 2
elementsOutFromElement: el "Returns the 'children' of el as elements" ^self elementsFromElement: el side: 1
relationshipsFromElement: el side: side "Returns a dictionary whose keys are relationship types and the values are elements related to 'el', where 'el' is at side 'side'." | sides | sides := relationships at: el ifAbsent: [nil]. sides isNil ifTrue: [^IdentityDictionary new]. ^sides at: side
relationshipsInFromElement: el "Returns the 'children' of el" "Returns a dictionary whose keys are relationships and the values are elements related to el, where el is at side 2" ^self relationshipsFromElement: el side: 2
relationshipsOutFromElement: el "Returns the 'children' of el" "Returns a dictionary whose keys are relationships and the values are elements related to el, where el is at side 1" ^self relationshipsFromElement: el side: 1
</methods> <methods> Lens.LDMGraph <category>accessing internals</category>
addElement: el "The value for the entry in the dictionary is an array of two dictionaries, each one for each side" relationships at: el put: (Array with: IdentityDictionary new with: IdentityDictionary new)
addToElement: el atSide: side andRelationship: rel elements: aCollection "We take great care to keep the graph consistent, hence if relationships are added to one side, we make sure to add them to the other side also" | otherSide | (self elementsAtSide: side ofElement: el withRelationship: rel) addAll: aCollection. otherSide := self otherSide: side. aCollection do: [:otherEl | (self elementsAtSide: otherSide ofElement: otherEl withRelationship: rel) add: el]
elementsDo: aBlock ^relationships keysDo: aBlock
outRelationshipsDo: aBlock relationships keysAndValuesDo: [:el :arr | (arr at: 1) keysAndValuesDo: [:rel :related | aBlock value: el value: related value: rel]]
parentlessElements "Return all elements which are not connected on the left. They are the ones to start the drawing from" | orphans | orphans := OrderedCollection new. relationships keysAndValuesDo: [:el :rels | rels notNil ifTrue: [(rels at: 1) size = 1 ifTrue: [orphans add: el]]]. ^orphans
removeFromElement: el atSide: side andRelationship: rel elements: related "Remove the elements in 'related' from the set of elements related to 'el' through relationship 'rel' on side 'side'" | bag otherSide | bag := self elementsAtSide: side ofElement: el withRelationship: rel. otherSide := self otherSide: side. related do: [:r | (bag remove: r ifAbsent: [nil]) notNil ifTrue: [| bag2 | bag2 := self elementsAtSide: otherSide ofElement: r withRelationship: rel. bag2 remove: el ifAbsent: [nil]]]
withElement: el atSide: side andRelationship: rel "returns the elements related to el without changing the graph but returning an empty collection in case nothing is found" | relDict | relDict := relationships at: el ifAbsent: [nil]. relDict isNil ifTrue: [^Set new]. relDict := relDict at: side. ^relDict at: rel ifAbsent: [^Set new]
</methods> <methods> Lens.LDMGraph <category>computing</category>
remove: e from: e2 side: side rel: rel (((relationships at: e2) at: side) at: rel) remove: e
removeElements: aSet "Remove the elements given in aSet from the graph. To do so go through all the relationships and tell all the elements found at the other side that we are removing the element. Since the graph is kept with pointers on both directions, we have to make sure to remove the pointers to the elements as well as the pointers from the elements" aSet do: [:e | | sides | sides := relationships at: e ifAbsent: [nil]. sides == nil ifFalse: [1 to: 2 do: [:side | (sides at: side) keysAndValuesDo: [:rel :els | els do: [:e2 | self remove: e from: e2 side: (self otherSide: side) rel: rel]]]. relationships removeKey: e ifAbsent: []]]
</methods> <methods> Lens.LDMGraph <category>private</category>
elementsAtSide: side ofElement: el withRelationship: rel "Return all the elements connected to 'el' on side 'side' by relationship 'rel'." | relDict | relDict := relationships at: el ifAbsent: [nil]. relDict isNil ifTrue: [relDict := relationships at: el put: (Array with: IdentityDictionary new with: IdentityDictionary new)]. relDict := relDict at: side. ^relDict at: rel ifAbsent: [relDict at: rel put: IdentitySet new]
otherSide: side "responds the other side of side" side == 1 ifTrue: [^2]. ^1
</methods> <methods> Lens.LDMGraph class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMBrowserBodyView <category>accessing</category>
decorator ^decorator
decorator: deco decorator := deco
</methods> <methods> Lens.LDMBrowserBodyView <category>adding-removing</category>
body: aBody self releaseAllComponents. self add: aBody.
</methods> <methods> Lens.LDMBrowserBodyView <category>updating</category>
update: aspect aspect == #graph ifTrue: [ decorator notNil ifTrue: [decorator flushCaches]]
</methods> <methods> Lens.LDMFirstOrderRel <category>accessing</category>
token ^token
token: newToken token := newToken. ^self
</methods> <methods> Lens.LDMFirstOrderRel <category>computing</category>
computeReverse "This method is called if the reverse relationship has not been defined already. The default for the reverse relationship is to add (or omit if it was originally there) an 'R' at the fourth place from the end. This way, the token for the reverse of callsRel is callsRRel. If a relationship with the constructed token is not found, a new one is added" | strToken size revSymbol | strToken := token asString. size := strToken size. (strToken at: size - 3) = $R ifTrue: [revSymbol := strToken copyReplaceFrom: size - 3 to: size with: ''] ifFalse: [revSymbol := strToken copyReplaceFrom: size - 2 to: size with: 'R']. revSymbol := revSymbol asSymbol. reverse := Relationships at: revSymbol ifAbsent: [Relationships at: revSymbol put: (LDMFirstOrderRel withToken: (self class relify: revSymbol))]
relatedTo: el "Asks the element to give the set of all the elements connected to it by this relationship. Many elements implement relatedBy: as sending the 'token' to themselves, checking that it is one of the tokens they understand. The default implementation in Object will return an empty set" ^el relatedBy: token
</methods> <methods> Lens.LDMFirstOrderRel <category>private</category>
literalArrayEncoding "Add the token to the literal array encoding" | oc | oc := super literalArrayEncoding. oc add: #token:. oc add: token. ^oc asArray
</methods> <methods> Lens.LDMFirstOrderRel class <category>instance creation</category>
withToken: token ^(super new) token: token
withToken: token named: nm ^(super new token: token) name: nm
</methods> <methods> Lens.LDMGraphElementWrapper <category>accessing</category>
builder: aBuilder builder := aBuilder
</methods> <methods> Lens.LDMGraphElementWrapper <category>bounds accessing</category>
translation "Answer the receiver's translation." | cPos | cPos := builder columnPositions. ^((cPos == nil or: [cPos size < depth]) ifTrue: [0] ifFalse: [cPos at: depth]) @ origin value y
</methods> <methods> Lens.LDMGraphElementWrapper class <category>instance creation</category>
on: aVisualComponent at: aPoint builder: aBuilder | baby | baby := self on: aVisualComponent at: aPoint. baby builder: aBuilder. ^baby
</methods> <methods> Lens.LensBrowsingToolModel <category>actions</category>
closeIn self selectionDo: [:e | self browserModel body closeAllFrom: e side: 2]
closeOut self selectionDo: [:e | self browserModel body closeAllFrom: e side: 1]
open2In self selectionDo: [:e | self browserModel body openAllFrom: e side: 2 levels: 2]
open2Out self selectionDo: [:e | self browserModel body openAllFrom: e side: 1 levels: 2]
open4In self selectionDo: [:e | self browserModel body openAllFrom: e side: 2 levels: 4]
open4Out self selectionDo: [:e | self browserModel body openAllFrom: e side: 1 levels: 4]
openIn self selectionDo: [:e | self browserModel body openAllFrom: e side: 2 levels: 1]
openOneIn self selectionDo: [:e | self browserModel body openOneRelFrom: e side: 2 ifNone: [nil]]
openOneOut self selectionDo: [:e | self browserModel body openOneRelFrom: e side: 1 ifNone: [nil]]
openOut self selectionDo: [:e | self browserModel body openAllFrom: e side: 1 levels: 1]
</methods> <methods> Lens.LensBrowsingToolModel <category>actions-support</category>
browser: bModel selectionDo: aBlock bModel selectionService selectedPerformers do: aBlock
browserModel "Returns the brwsing model the user refers to in the actions" self subclassResponsibility
selectionDo: aBlock self browserModel selectionService selectedPerformers do: aBlock
</methods> <methods> Lens.LensBrowsingToolModel <category>defaults</category>
defaultFocusHolder "Default to a statically empty focus, for a static focus override this method, otherwise use a real focus holder." ^Set new asValue
defaultPerspectiveHolder "Usable only for a fixed perspective, for changable perspectives provide a real focus holder." ^self perspectiveHolderFor: self defaultPerspectiveName
defaultPerspectiveName "Override with fixed perspective you wish to use, or for changable perspectives provide a real focus holder." ^#=
defaultSelectionService "A 'nil' selection service means it will be created fresh for this body and not shared." ^nil
perspectiveHolderFor: aName "Create a perspective holder initially set to the perspective named 'aName'." ^(LDMPerspective at: aName) asValue
</methods> <methods> Lens.LensBrowsingToolModel class <category>private</category>
isVisualStartable "Used by UIFinder to divine that the application will respond to Start" ^false
</methods> <methods> Lens.LDMDiadicRel <category>initialize release</category>
reset "The references in r1 and r2 may be symbols, if so, fetch the corresponding relationships. The references are symbols after the relationship is read from external storage" r1 isSymbol ifTrue: [r1 := self class at: r1 ifAbsent: [nil]]. r2 isSymbol ifTrue: [r2 := self class at: r2 ifAbsent: [nil]]
</methods> <methods> Lens.LDMDiadicRel <category>accessing</category>
r1 ^r1
r1: firstRel r2: secondRel r1 := firstRel. r2 := secondRel. ^self
r2 ^r2
</methods> <methods> Lens.LDMDiadicRel <category>printing</category>
storeOn: aStream "Put the names of the referenced relationships instead of the references themselves, store the object into the stream, then reassign the references" | q1 q2 | q1 := r1. q2 := r2. r1 := q1 name asSymbol. r2 := q2 name asSymbol. super storeOn: aStream. r1 := q1. r2 := q2
</methods> <methods> Lens.LDMDiadicRel class <category>instance creation</category>
new "We do not want undefined diadic relationships hanging arround, hence we do not want user of this class and sub-classes to use the 'new' message, instead we provide the 'newWithRel:andRel:' message" ^self shouldNotImplement
newWithRel: firstRel andRel: secondRel "This method creates a new diadic relationship and sets the two composing rels." ^super new r1: firstRel r2: secondRel
newWithRel: firstRel andRel: secondRel named: nm "This method creates a new diadic relationship and sets the two composing rels." ^(super new r1: firstRel r2: secondRel) name: nm
</methods> <methods> Lens.LDMArrowView <category>display box accessing</category>
preferredBounds "Compute the preferredBounds for the receiver" CachedBounds == nil ifTrue: [| imageOff imageOn labelOff labelOn | imageOff := offImage isNil ifTrue: [0 @ 0] ifFalse: [offImage preferredBounds extent]. imageOn := onImage isNil ifTrue: [0 @ 0] ifFalse: [onImage preferredBounds extent]. labelOff := (ComposedText withText: label style: LabelStyle) preferredBounds extent. labelOn := (ComposedText withText: label asText copy allBold style: LabelStyle) preferredBounds extent. CachedBounds := Rectangle origin: 0 @ 0 corner: (imageOff x + labelOff x max: imageOn x + labelOn x) + 0 @ ((imageOff y max: labelOff y) max: (imageOn y max: labelOn y))]. ^CachedBounds
</methods> <methods> Lens.LDMArrowView <category>private</category>
useFilling " Answer whether to color-invert the image. " ^false
</methods> <methods> Lens.LDMArrowView class <category>class initialization</category>
initialize "CYDotView initialize" | maskPalette | CachedBounds := nil. maskPalette := CoveragePalette monoMaskPalette. EmptyImage := CachedImage on: (Image extent: 10@9 depth: 1 palette: maskPalette bits: #[ 2r00000000 2r00000000 2r10000000 2r00000000 2r11100000 2r00000000 2r10011000 2r00000000 2r10000110 2r00000000 2r10011000 2r00000000 2r11100000 2r00000000 2r10000000 2r00000000 2r00000000 2r00000000 ] pad: 8). FullImage := CachedImage on: (Image extent: 10@9 depth: 1 palette: maskPalette bits: #[ 2r00000000 2r00000000 2r10000000 2r00000000 2r01100000 2r00000000 2r01111000 2r00000000 2r00111110 2r00000000 2r01111000 2r00000000 2r01100000 2r00000000 2r10000000 2r00000000 2r00000000 2r00000000 ] pad: 8).
</methods> <methods> Lens.LDMArrowView class <category>instance creation</category>
model: mdl | dv | dv := super model: mdl. dv beVisual: EmptyImage ifTrue: FullImage. ^dv
</methods> <methods> Lens.LDMPerspective <category>initialize-release</category>
initialize rows := List new. relDesc := List new. labelHints := OrderedCollection new.
upToDate "Reconciliate the size of the rows and the initialization of new variables" rows do: [:r | r size + 1 to: ColumnNames size do: [:i | r add: nil]. ColumnNames size + 1 to: r size do: [:i | r removeLast]]. labelHints isNil ifTrue: [labelHints := OrderedCollection new]. relDesc isNil ifTrue: [relDesc := List new]
</methods> <methods> Lens.LDMPerspective <category>accessing</category>
addRow rows addLast: (List new: ColumnNames size)
arrLabelHints: arr labelHints := arr asList
arrRelDesc: arr relDesc := List new. arr do: [:r | relDesc add: r asList]
arrRows: arr rows := List new. arr do: [:r | rows add: r asList]
at: aPoint ^(rows at: aPoint y) at: aPoint x
at: aPoint put: value ^(rows at: aPoint y) at: aPoint x put: value
labelHints ^labelHints
labelHints: hints labelHints := hints
name ^name
name: aSymbol name := aSymbol
relDesc ^relDesc
relDesc: aList relDesc := aList
rows ^rows
rows: theRows rows := theRows
</methods> <methods> Lens.LDMPerspective <category>private</category>
fromLiteralArrayEncoding: anArray 2 to: anArray size by: 2 do: [:i | self perform: (anArray at: i) with: (anArray at: i + 1)]. LDMPerspective at: name asSymbol put: self
literalArrayEncoding | a arrRows arrRelDesc| a := Array new: 9. a at: 1 put: self class fullyQualifiedReference. a at: 2 put: #arrRows:. arrRows := rows asArray. 1 to: arrRows size do: [:i | arrRows at: i put: (arrRows at: i) asArray]. a at: 3 put: arrRows. a at: 4 put: #arrLabelHints:. a at: 5 put: labelHints asArray. a at: 6 put: #arrRelDesc:. arrRelDesc := relDesc asArray. 1 to: arrRelDesc size do: [:i | arrRelDesc at: i put: (arrRelDesc at: i) asArray]. a at: 7 put: arrRelDesc. a at: 8 put: #name:. a at: 9 put: name. ^a
</methods> <methods> Lens.LDMPerspective class <category>class initialization</category>
initialize "Perspectives holds the known perspectives, the key is the name of the perspective, a symbol. ColumnNames are the names of the columns in each row of the perspective. V1 - the 'from' variable V2 - the 'to' variable REL - the relationship joining the two variables INIT - whether or not the row should be used when computing the initial graph AUTO - whether or not the row should be used when looking for relationships that should be opened automatically OPEN - whether or not the relationship can be opened and closed by the user R1 - whether the row is restricted or variable 1, which means that an element can be added to V2 if and only if it has a counterpart in V1 R2 - the same for the other variable" "Perspective initialize" Perspectives := IdentityDictionary new. ColumnNames := #('V1' 'V2' 'REL' 'INIT' 'AUTO' 'OPEN' 'R1' 'R2' )
initializePerspectives "This is an example to show the structure of a perspective, inspect the result from this method to understand the structure. The mere creation of a perspective will add it to the Perspectives dictionary, therefore, the names of perspectives should be unique in the system" "self initializePerspectives" "To create new perspectives copy the lines below to the initialization method of the class that needs the perspective and edit it to fit the required definition. See LDMRelationship class>>initializeRelationships for the way to define new relationships" ^List new add: ((Array new: 9) at: 1 put: #LDMPerspective; at: 2 put: #arrRows:; at: 3 put: #( "The order here is: <variable 1> <variable 2> <relationship name> <used on init> <opened automatically> <user can open> <restricted on variable 1> <restricted on variable 2>" #(#F1 #V1 'calls' true false false false false ) #(#V1 #V1 'calls' false true true false false ) ); at: 4 put: #arrLabelHints:; "The label hints are passed to the elements, they decide what to do with them" at: 5 put: #(); "Add an array for each different relationship used in the perspective." at: 6 put: #arrRelDesc:; at: 7 put: ((Array new: 1) at: 1 put: ((Array new: 5) at: 1 put: 'calls'; "name of the relationship" at: 2 put: true; "Displayed or not" at: 3 put: #solid; "line style - only 'solid' implemented" at: 4 put: ColorValue green; "line color" at: 5 put: #zero; yourself); yourself); "line width #zero is the special case where the relationship is there, but does not show as a line" at: 8 put: #name:; at: 9 put: #calls; "The name of the perspective" yourself) decodeAsLiteralArray; yourself
</methods> <methods> Lens.LDMPerspective class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMPerspective class <category>accessing</category>
any "Returns a perspective found in the dictionary. If none is there then returns a new one. This is used for creating browsers with unknown perspectives" Perspectives do: [:p | p notNil ifTrue: [^p]]. ^self new
at: aSymbol ^Perspectives at: aSymbol
at: aSymbol ifAbsent: aBlock ^Perspectives at: aSymbol ifAbsent: aBlock
at: aSymbol put: pp Perspectives at: aSymbol put: pp
columnNames ^ColumnNames
deletePerspective: nm "A new dictionary is created and all the perspectives that are not the deleted one are put in it, this way all the memories of the deleted perspective are erased" | newP | newP := IdentityDictionary new. Perspectives keysAndValuesDo: [:n :p | n ~= nm ifTrue: [newP at: n put: p]]. Perspectives := newP
perspectiveNames "This can be used by user interfaces to present a list of all the perspectives" ^Perspectives keys collect: [:n | n asString]
</methods> <methods> Lens.LDMPerspective class <category>save restore</category>
readFromFile: aFileName "aFileName can either be a string representing the name of the file or the Filename. This method reads the definitions of the perspectives into the named file. These definitions are added to the current ones, hence in order to replace the current ones, Perspective initialize should be called first. Importing the perspectives from a file may be useful if it is not desired to save them in methods. Usually, saving them in methods is better" | in newP | in := aFileName asFilename readStream. newP := self evaluatorClass new evaluate: in in: nil to: self notifying: self ifFail: [^nil]. in close. newP keysAndValuesDo: [:k :v | Perspectives at: k put: v]
saveInFile: aFileName "aFileName can either be a string representing the name of the file or the Filename. This method saves the definitions of the perspectives into the named file. This may be useful for an editing tool if saving the perspectives in a method is not desired" | out | out := aFileName asFilename writeStream. Perspectives storeOn: out. out close
</methods> <methods> Lens.LDMPerspective class <category>private</category>
decodeFromLiteralArray: anArray "Return an instance based on the information encoded in anArray. This or a better mechanism for recreating selves from arrays should be implemented in Object" ^self new fromLiteralArrayEncoding: anArray
</methods> <methods> Lens.LensGraphView <category>initialize release</category>
onPerspective: aSymbol "Initialize using the perspective named by aSymbol" bm := LDMBrowserModel new. bm application: self. focus := (IdentitySet new) asValue. bm focusHolder: focus. perspective := (LDMPerspective at: aSymbol) asValue. bm perspectiveHolder: perspective.
</methods> <methods> Lens.LensGraphView <category>accessing</category>
bm: aBM bm := aBM
perspective: aSymbol "Sets the perspective of the graph to be the one named with the given aSymbol. Since this is done from the design tools, no checking is done and the LDMPerspective must exist" perspective value: (LDMPerspective at: aSymbol)
</methods> <methods> Lens.LensGraphView <category>actions</category>
closeInOf: inSet andOpenOutOf: outSet | body | body := bm body. body recomputeUserCanOpen. inSet do: [:e | bm body closeAllFrom: e side: 2]. outSet do: [:eo | bm body openAllFrom: eo side: 1 levels: 1]
</methods> <methods> Lens.LensGraphView <category>actions-support</category>
browserModel ^bm
select: anElement ^self browserModel select: anElement
</methods> <methods> Lens.LensGraphView <category>aspects</category>
bm "Return the browser model" ^bm
focus ^focus
focus: aSet "Change the focus of the graph. We ask to release the visuals because we do not want them to be reused" bm body releaseVisuals. focus value: aSet
</methods> <methods> Lens.LensGraphView class <category>class initialization</category>
initialize "LensGraphView initialize" self initializeRelationships. self initializePerspectives.
initializePerspectives "self initializePerspectives" ^List new add: ((Array new: 9) at: 1 put: #LDMPerspective; at: 2 put: #arrRows:; at: 3 put: #(#(#F1 #V1 'related' true false false false false ) #(#F1 #V1 'metaMapped' true false false false false ) #(#V1 #V1 'related' true false false false false ) #(#V1 #V1 'mapped' true false false false false ) #(#V1 #V1 'metaMapped' true false false false false ) ); at: 4 put: #arrLabelHints:; at: 5 put: #(); at: 6 put: #arrRelDesc:; at: 7 put: ((Array new: 3) at: 1 put: ((Array new: 5) at: 1 put: 'related'; at: 2 put: true; at: 3 put: #solid; at: 4 put: ColorValue black; at: 5 put: 1; yourself); at: 2 put: ((Array new: 5) at: 1 put: 'mapped'; at: 2 put: true; at: 3 put: #solid; at: 4 put: ColorValue brown; at: 5 put: 3; yourself); at: 3 put: ((Array new: 5) at: 1 put: 'metaMapped'; at: 2 put: true; at: 3 put: #solid; at: 4 put: ColorValue black; at: 5 put: 1; yourself); yourself); at: 8 put: #name:; at: 9 put: #mappings; yourself) decodeAsLiteralArray; add: ((Array new: 9) at: 1 put: #LDMPerspective; at: 2 put: #arrRows:; at: 3 put: #(#(#F1 #V1 '=' true false false false false ) #(#V1 #V1 'containsColumn' false false true false false ) ); at: 4 put: #arrLabelHints:; at: 5 put: #(); at: 6 put: #arrRelDesc:; at: 7 put: ((Array new: 2) at: 1 put: ((Array new: 5) at: 1 put: 'containsColumn'; at: 2 put: true; at: 3 put: #solid; at: 4 put: ColorValue gray; at: 5 put: 1; yourself); at: 2 put: ((Array new: 5) at: 1 put: '='; at: 2 put: false; at: 3 put: #solid; at: 4 put: ColorValue olive; at: 5 put: 2; yourself); yourself); at: 8 put: #name:; at: 9 put: #dbtable; yourself) decodeAsLiteralArray; add: ((Array new: 9) at: 1 put: #LDMPerspective; at: 2 put: #arrRows:; at: 3 put: #(#(#F1 #V1 '=' true false false false false ) #(#V1 #V1 'containsColumn' false false true false false ) ); at: 4 put: #arrLabelHints:; at: 5 put: #(#simple); at: 6 put: #arrRelDesc:; at: 7 put: ((Array new: 2) at: 1 put: ((Array new: 5) at: 1 put: 'containsColumn'; at: 2 put: true; at: 3 put: #solid; at: 4 put: ColorValue gray; at: 5 put: 1; yourself); at: 2 put: ((Array new: 5) at: 1 put: '='; at: 2 put: false; at: 3 put: #solid; at: 4 put: ColorValue olive; at: 5 put: 2; yourself); yourself); at: 8 put: #name:; at: 9 put: #dbtable2; yourself) decodeAsLiteralArray; add: ((Array new: 9) at: 1 put: #LDMPerspective; at: 2 put: #arrRows:; at: 3 put: #(#(#V1 #V1 '=' true false false false false ) ); at: 4 put: #arrLabelHints:; at: 5 put: #(#simple); at: 6 put: #arrRelDesc:; at: 7 put: ((Array new: 1) at: 1 put: ((Array new: 5) at: 1 put: '='; at: 2 put: false; at: 3 put: #solid; at: 4 put: ColorValue cyan; at: 5 put: 2; yourself); yourself); at: 8 put: #name:; at: 9 put: #identity; yourself) decodeAsLiteralArray; yourself
initializeRelationships "self initializeRelationships" ^List new add: #(#LDMFirstOrderRel #name: 'mapped' #description: '' #reverse: nil #token: #mappedRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'mappedR' #description: '' #reverse: nil #token: #mappedRRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'metaMapped' #description: '' #reverse: nil #token: #metaMappedRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'metaMappedR' #description: '' #reverse: nil #token: #metaMappedRRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'related' #description: '' #reverse: nil #token: #relatedRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'relatedR' #description: '' #reverse: nil #token: #relatedRRel ) decodeAsLiteralArray; add: #(#LDMFirstOrderRel #name: 'containsColumn' #description: 'contains column' #reverse: containsColumnR #token: #containsColumnRel ) decodeAsLiteralArray;add: #(#LDMFirstOrderRel #name: 'containsColumnR' #description: 'column is contained in' #reverse: #containsColumn #token: #containsColumnRRel ) decodeAsLiteralArray; yourself
</methods> <methods> Lens.LensGraphView class <category>instance creation</category>
onPerspective: aSymbol ^self new onPerspective: aSymbol
</methods> <methods> Lens.LensGraphView class <category>fileIn/Out</category>
prerequisitesForLoading "List those classes that must be filed or BOSSed into the system before I can be loaded." | oc | oc := super prerequisitesForLoading. oc add: LDMRelationship; add: LDMPerspective. ^oc
</methods> <methods> Lens.LDMElementProxy <category>initialize-release</category>
initialize "To be used by subclasses"
on: el element := el
</methods> <methods> Lens.LDMElementProxy <category>accessing</category>
context "The default context is an IdentityDictionary" context isNil ifTrue: [ context := IdentityDictionary new]. ^context
element ^element
element: anElement element := anElement
</methods> <methods> Lens.LDMElementProxy <category>printing</category>
printOn: aStream "Add {} to show that this is a wrapper on the element and not the element itself" aStream nextPut: ${. element printOn: aStream. aStream nextPut: $}. ^self
</methods> <methods> Lens.LDMElementProxy <category>relationships</category>
relatedBy: token "The default is to let the element respond with the relationship. This is most likely to be changed by subclasses" ^element relatedBy: token
stringKey: hints "The key shown in the graphs is the same as the key for the element. Subclasses may redefine this to provide functionality not available in the wrapped element" ^element stringKey: hints
</methods> <methods> Lens.LDMElementProxy class <category>class initialization</category>
initialize "Note that 'Elements' is a class instance variable. Therefore each subclass using the global dictionary facility should initialize" "ReversingElementWrapper initialize" Elements := IdentityDictionary new
</methods> <methods> Lens.LDMElementProxy class <category>instance creation</category>
newOn: el "This method can be redefined in subclasses to add the instance to the 'Elements' dictionary, if so desired" ^self new initialize on: el
</methods> <methods> Lens.LDMElementProxy class <category>accessing</category>
at: el ^Elements at: el ifAbsent: [Elements at: el put: (self newOn: el)]
</methods> <methods> Lens.LDMReversingElementProxy <category>initialize-release</category>
initialize related := Dictionary new.
</methods> <methods> Lens.LDMReversingElementProxy <category>relationships</category>
elementLabel: hints ^element elementLabel: hints
related: other by: aRelationship "Add other to the set of elements that are related to us by aRelationship" | bag | bag := related at: aRelationship ifAbsent: [related at: aRelationship put: Set new]. bag add: other
relatedBy: rel "Compute the relationship. For each one of the related ones notify the other that we are related to them. This way, the other can keep track of the reverse relationship" ^related at: rel ifAbsent: [| bag rltd | rltd := element relatedBy: rel. bag := Set new. rltd do: [:r | (bag add: (self class at: r)) related: self by: (self reverse: rel)]. related at: rel put: bag]
</methods> <methods> Lens.LDMReversingElementProxy <category>private</category>
reverse: rel "Utility for computing the token for the revere relationship" ((rel at: (rel size - 3)) == $R) ifTrue: [^((rel copyFrom: 1 to: rel size - 4) , 'Rel') asSymbol] ifFalse: [^((rel copyFrom: 1 to: rel size - 3) , 'RRel') asSymbol]
</methods> <methods> Lens.LDMOrRel <category>computing</category>
computeReverse "The OR of the reverses of the components. The order is not important" reverse := LDMOrRel newWithRel: r1 reverse andRel: r2 reverse
relatedTo: el "Returns the union of the sets returned by each one of the composing relationships. The order of the computation is not important" | aSet | aSet := r1 relatedTo: el. aSet addAll: (r2 relatedTo: el). ^aSet
</methods> <methods> Lens.LDMCompositeViewController <category>actions</category>
select "If I got this it means that nobody wanted control so I do my part" view selectionService deselectAll
</methods> <methods> Lens.LDMCompositeViewController <category>control defaults</category>
isControlActive "Answer whether the receiver wants to retain control. The default is to retain control if the cursor is inside the view and the blue button is not pressed. Pressing blue button will default to explicitly give up control without moving the cursor." "It is sent by Controller|controlLoop in order to determine when the receiver's control loop should terminate, and should be redefined in a subclass if some other condition for terminating the main control loop is needed." ^self isControlWanted
isControlWanted "Answer true if the cursor is inside the display box of the receiver's view." "Subclasses may want to enhance this test." ^super isControlWanted and: [self sensor yellowButtonPressed]
</methods> <methods> Lens.LDMCompositeViewController <category>menu processing</category>
dispatchMenuSelection: menuSelection super dispatchMenuSelection: menuSelection.
localMenuItem: aSymbol ^#menuSelectAll = aSymbol
menuSelectAll "Select all views inside the window" | set | set := view componentsInside: nil. view selectionService newSelection: set.
</methods> <methods> Lens.LDMCompositeView <category>initialize-release</category>
scrollOffsetHolder: aValueHolder aValueHolder grid: 65@25
</methods> <methods> Lens.LDMCompositeView <category>controller accessing</category>
defaultControllerClass "Answer the class of the default controller for the receiver." ^LDMCompositeViewController
</methods> <methods> Lens.LDMCompositeView <category>hit detection</category>
componentsInside: aRectangle "Return a collection of components that are inside aRectangle" ^components select: [:c | aRectangle intersects: c bounds]
</methods> <methods> Lens.LDMCompositeView <category>selection</category>
deselect
select
toggle
</methods> <methods> Lens.LDMCompositeView <category>event driven</category>
handlerForMouseEvent: aMouseEvent "Answer the first component that answers an object other than nil. Otherwise answer nil." | ctrl | ctrl := self getController. (ctrl isNil or: [(ctrl viewHasCursorWithEvent: aMouseEvent) not]) ifTrue: [^nil]. components size to: 1 by: -1 do: [:i | | controlObject | controlObject := (components at: i) handlerForMouseEvent: aMouseEvent. controlObject == nil ifFalse: [^controlObject]]. Object errorSignal handle: [:ex | "Trap errors occurring while searching for the object wanting control." Controller badControllerSignal raiseErrorString: (#BadControllerMouseEvent << #dialogs >> 'Bad controller in handlerForMouseEvent:')] do: [^ctrl handlerForMouseEvent: aMouseEvent]. ^nil
</methods> <methods> Lens.LDMGraphCompositeView <category>accessing</category>
builder: b builder := b
selectionService ^model selectionService
</methods> <methods> Lens.LDMGraphCompositeView <category>broadcast</category>
upcastEvent: aKey with: aParameter from: anInitiator path: aPathCollection "This is a message passed up the view structure through all containers. If aPathCollection is not nil then the client desires for the containment path to be collected as a side effect." "If the message is a change in the selection, then we perform the required action" aKey == #selectionChange ifTrue: [aParameter == #replaceSelection ifTrue: [self selectSubView: anInitiator replace: true] ifFalse: [aParameter == #addSelection ifTrue: [self selectSubView: anInitiator replace: false] ifFalse: [super upcastEvent: aKey with: aParameter from: anInitiator path: aPathCollection]]]
</methods> <methods> Lens.LDMGraphCompositeView <category>private</category>
changedPreferredBounds: oldPreferredBoundsOrNil forComponent: aVisualComponent "Do re-layout for the whole tree" | ct | ct := container. container := nil. builder layout. container := ct. self bounds: self bounds. self invalidate
selectSubView: subView replace: replaceCurrentSelection "Adds or replaces the current selection with subView" replaceCurrentSelection ifTrue: [self selectionService newSelection: (Array with: subView)] ifFalse: [self selectionService addOne: subView]
</methods> <methods> Lens.LDMArc <category>initialize-release</category>
initialize "Initially, no active phases, vars not yet specified, and unrestricted on both sides." activePhases := IdentitySet new. varOnSide := Array new: 2. isRestrictedOnSide := Array with: false with: false.
</methods> <methods> Lens.LDMArc <category>accessing</category>
addUserCanOpenTo: openableGraph "Add to the Graph 'openableGraph' all the new relationships which can be opened from this arc. Whether they are already open or not" self graph elementsDo: [:el | 1 to: 2 do: [:side | | want accept | want := self relatedTo: el fromSide: side. want size > 0 ifTrue: [accept := (varOnSide at: (self otherSide: side)) canAddElements: want fromArc: self phase: #automatic. openableGraph addToElement: el atSide: side andRelationship: relationship elements: accept]]]
graph ^generator graph
isActiveIn: phase "Is this arc active is phase 'phase'?" ^activePhases includes: phase
relationship "Return the kind of relationship this arc handles." ^relationship
userOpens "Is this arc active is phase #userOpens?" ^self isActiveIn: #userOpens
</methods> <methods> Lens.LDMArc <category>computing</category>
addElements: els fromSide: side phase: phase "The elements 'els' have been added to the variable on side 'side'. See if this means other relationships should be opened on the other side. Do this by finding which elements each element can connect to and adding these." | otherSideVar | otherSideVar := varOnSide at: (self otherSide: side). els do: [:el | | other | other := self relatedTo: el fromSide: side. other size > 0 ifTrue: [other := otherSideVar canAddElements: other fromArc: self phase: phase. other size > 0 ifTrue: [self addRelationshipsBetween: el fromSide: side and: other. otherSideVar addElements: other phase: phase]]]
canAddElements: els fromSide: side phase: phase "Returns the subset of 'els' which can be opened." "If there is no restriction on side 'side' then all the elements can be added. Otherwise, each element is checked whether it is related to at least one element in the other side" | retElems | (isRestrictedOnSide at: side) ifFalse: [^els]. retElems := IdentitySet new. els do: [:el | | others | others := self relatedTo: el fromSide: side. others notNil ifTrue: [others := (varOnSide at: (self otherSide: side)) canAddElements: others fromArc: self phase: phase. others size > 0 ifTrue: [retElems add: el]]]. ^retElems
openAllRelatedTo: el side: side "Opens all the elements related to el that can be opened through this arc" | want accept | want := self relatedTo: el fromSide: side. want size == 0 ifTrue: [want := self fromUserOpensRelatedTo: el fromSide: side]. want size > 0 ifTrue: [want := want - (self graph elementsFromElement: el side: side). want size > 0 ifTrue: [accept := (varOnSide at: (self otherSide: side)) canAddElements: want fromArc: self phase: #automatic. self userOpenFrom: el to: accept side: side]]
userClosedFrom: el to: related side: side "The user has closed the relationships between 'el' and 'related' on this arc. So remove it from the list of relationships. We do not check connectivity with the focus, as this closing may be a part of a batch of closing, so the connectivity will be checked later" self graph removeFromElement: el atSide: side andRelationship: relationship elements: related.
userOpenFrom: el to: related side: side "The user has opened the relationships between 'el' and 'related' on this arc. So record this in myself and open any relationships that should be opened automatically as a result." | elAsSet otherSide | elAsSet := IdentitySet with: el. otherSide := self otherSide: side. self addRelationshipsBetween: el fromSide: side and: related. related do: [:relEl | self addRelationshipsBetween: relEl fromSide: otherSide and: elAsSet]. (varOnSide at: side) addElements: elAsSet phase: #automatic. (varOnSide at: otherSide) addElements: related phase: #automatic
</methods> <methods> Lens.LDMArc <category>construction</category>
beActiveIn: phase "Specifies that this arc is active in phase 'phase'." ^activePhases add: phase
beRestrictedIn: side "Specifies that this arc is restricted on side 'side'. Been restricted means it has to have an element on this side for each element in the other side" isRestrictedOnSide at: side put: true
generator: aGenerator generator := aGenerator
putVariable: var atSide: side "Specifies that the variable on side 'side' of this arc is 'var' ." varOnSide at: side put: var
relationship: rel "Specifies that this is a 'rel' relationship arc." relationship := rel
</methods> <methods> Lens.LDMArc <category>printing</category>
printOn: aStream "Mainly for debugging purposes" aStream nextPutAll: 'Arc< '. relationship printOn: aStream. aStream nextPut: $>
</methods> <methods> Lens.LDMArc <category>private</category>
addRelationshipsBetween: el fromSide: side and: related "Add all the relationships on this arc between 'el' and 'related' which are on side 'side' of 'el'." self graph addToElement: el atSide: side andRelationship: relationship elements: related.
fromUserOpensRelatedTo: el fromSide: side "This method is used to access the information in the userOpens graph. This is needed in cases where the element itself doesn't know who is related to it" ^generator userCanOpen withElement: el atSide: side andRelationship: relationship
otherSide: side "responds the other side of side" side == 1 ifTrue: [^2]. ^1
relatedTo: element fromSide: side "The given element is at side 'side', returns the related elements for the other side of the relationship." ^side == 1 ifTrue: [relationship relatedTo: element] ifFalse: [relationship reverse relatedTo: element]
</methods> <methods> Lens.LDMArc class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMRelationsBody <category>initialize-release</category>
initialize "By default we use a relations generator" generator := LDMRelationsGenerator new. visualBuilder := nil.
</methods> <methods> Lens.LDMRelationsBody <category>accessing</category>
bodySubView "Returns just the composite used for building the graph. If it was necessary, a scrolling wrapper or something similar could be added here to the composite" ^self composite
focus: aFocus "Set or reset the focus for the browser. The generator supports multiple foci, we do not and therefore we make an array of the single focus. We remember the focus so it can later be used, even though it could be fetched from somewhere in the generator" generator setFocus: (Array with: aFocus). foa := aFocus
hasFrom: anObject side: side "anObject is an element in the graph. Responds: 0 - if anObject can not have any relationship for side side false - if anObject has relationships but they are all opened already true - if it has and they are not yet open" "Check in the canOpen graph, if none, then it can not open anyone. Then check in the already open graph, if the difference between the sets returned is 0 then there is nothing new to be opened" | can current | can := canOpen elementsFromElement: anObject side: side. can size == 0 ifTrue: [^0]. current := graph elementsFromElement: anObject side: side. (can - current) size == 0 ifTrue: [^false]. ^true
perspective: aPerspective "Set the perspective in the generator" generator initialize. generator perspective: aPerspective. generator reset.
recomputeUserCanOpen "delegate to the generator" canOpen := generator computeUserCanOpen
releaseVisuals "Release all the visual components associated with the elements in the graph. This may be important to do in some cases because the visual components are reused when we encounter the same element again" visualBuilder notNil ifTrue: [visualBuilder initialize]
visualForElement: anElement "Returns the visual component associated with anElement" ^visualBuilder visualForElement: anElement
</methods> <methods> Lens.LDMRelationsBody <category>graph manipulation</category>
closeAllFrom: element side: side "Close all the relationships from element for the given side. First get all the open relationships, then let the generator close those relationship. Then remove the relationships that are not connected to the focus (foa) and rebuild the graph view" | clossable | clossable := graph relationshipsFromElement: element side: side. clossable keysAndValuesDo: [:rel :related | generator userCloseRelationship: rel from: element to: related copy side: side]. generator checkConnectivity: self foa. self rebuild
closeOneKindFrom: el side: side ifNone: aBlock "Presents the user a menu with the names of relationships that can be closed, closes all the relationships of the given type" "returns true if something was done, false if nothing and 'aBlock value' if nothing could have been opened" | can | can := graph relationshipsFromElement: el side: side. can size > 0 ifTrue: [| selRel | selRel := self userSelectMenu: (can keys collect: [:r | Array with: r description with: r]) asArray. selRel notNil ifTrue: [generator userCloseRelationship: selRel from: el to: (can at: selRel) side: side. generator checkConnectivity: self foa. self rebuild. ^true]. ^false]. ^aBlock value
closeOneRelFrom: el side: side ifNone: aBlock "Presents the user a menu with the names of relationships that can be closes, closes all the relationships of the given type" | can | can := graph relationshipsFromElement: el side: side. can size > 0 ifTrue: [| selRel toMenu | toMenu := OrderedCollection new. can keysAndValuesDo: [:r :elements | elements do: [:e | toMenu add: (Array with: (el stringKey: #(#menu )) , ' ' , r description , ' ' , (e stringKey: #(#menu )) with: (Array with: r with: e))]]. selRel := self userSelectMenu: toMenu. (selRel notNil and: [selRel ~~ 0]) ifTrue: [generator userCloseRelationship: (selRel at: 1) from: el to: (IdentitySet with: (selRel at: 2)) side: side. generator checkConnectivity: self foa. self rebuild. ^self]. ^nil]. ^aBlock value
openAllFrom: element side: side levels: n "n indicate the number of levels to open the graph, 1 indicates to open only the immediate ones, 0 indicates to open everything" self privateOpenAllFrom: element side: side levels: n. self rebuild
openOneKindFrom: el side: side ifNone: aBlock "Presents the user a menu with the names of relationships that can be opened, opens all the relationships of the given type" "returns true if something was done, false if nothing and 'aBlock value' if nothing could have been opened" | can | can := self getReallyCanOpenFrom: el side: side. can size > 0 ifTrue: [| selRel | selRel := self userSelectMenu: (can keys collect: [:r | Array with: r description with: r]) asArray. selRel notNil ifTrue: [generator userOpenRelationship: selRel from: el to: (can at: selRel) side: side. self rebuild. ^true]. ^false]. ^aBlock value
openOneRelFrom: el side: side ifNone: aBlock "Presents the user a menu with the names of relationships that can be opened, opens all the relationships of the given type" | can | can := self getReallyCanOpenFrom: el side: side. can size > 0 ifTrue: [| selRel toMenu | toMenu := OrderedCollection new. can keysAndValuesDo: [:r :elements | elements do: [:e | toMenu add: (Array with: (el stringKey: #(#menu )) , ' ' , r description , ' ' , (e stringKey: #(#menu )) with: (Array with: r with: e))]]. selRel := self userSelectMenu: toMenu. (selRel notNil and: [selRel ~~ 0]) ifTrue: [generator userOpenRelationship: (selRel at: 1) from: el to: (IdentitySet with: (selRel at: 2)) side: side. self rebuild. ^self]. ^nil]. ^aBlock value
</methods> <methods> Lens.LDMRelationsBody <category>private</category>
buildComposite "Builds the composite that represents the graph according to the rdms. Ask the generator to compute the graph and the canOpen graph. Ask the visualBuilder to build the composite for the computed graph" graph := generator getGraph. canOpen := generator userCanOpen. visualBuilder == nil ifTrue: [visualBuilder := self viewModel visualBuilderClass newTree]. composite := visualBuilder visualForGraph: graph viewModel: self viewModel
composite "If the composite has not been computed, build it" composite == nil ifTrue: [self buildComposite]. ^composite
getReallyCanOpenFrom: el side: side "Returns an IdentityDictionary whose key are relationships and the vlaues are collections of elements related to 'el' with the respective relationship. All this for relationships that can be opened and are not already open" | could current can | can := IdentityDictionary new. could := canOpen relationshipsFromElement: el side: side. could size > 0 ifTrue: [current := graph relationshipsFromElement: el side: side. could keysAndValuesDo: [:rel :els | | notThere | notThere := els - (current at: rel ifAbsent: [IdentitySet new]). notThere size > 0 ifTrue: [can at: rel put: notThere]]]. ^can
keyboardOrder: aKProc "Set the TAB order for the element views in the graph. Sort by 'x' and then by 'y'. Setting the tab order doesn't add the element views to the keyboard chain" aKProc keyboardConsumers: (SequenceableCollectionSorter on: aKProc keyboardConsumers using: [:a :b | | ap bp | (ap := a localPointToGlobal: 0 @ 0) y = (bp := b localPointToGlobal: 0 @ 0) y ifTrue: [ap x < bp x] ifFalse: [ap y < bp y]]) sort.
privateOpenAllFrom: element side: side levels: n "n indicate the number of levels to open the graph, 1 indicates to open only the immediate ones" "This recursive method opens one level and calls itself for all the elements connected with the current one, with (n-1). NOTE that we ask the graph for all the relationships, this is good because we will descend the graph even if the relationship was not just now open, so this method will make sure that the n levels relationships are all open, independently of whether there were any already open from before" generator openAllRelatedTo: element side: side. n ~~ 1 ifTrue: [(graph relationshipsFromElement: element side: side) do: [:rels | rels do: [:anEl | self privateOpenAllFrom: anEl side: side levels: n - 1]]]
rebuild "Builds the composite that represents the graph." | container decor ec eb | ( composite notNil and: [(container := composite container) notNil] ) ifTrue: [self buildComposite. container component: composite. viewModel graphHasChanged. decor := nil. decor notNil ifTrue: ["never true - kept for reference only" eb := composite bounds extent. ec := decor bounds extent. eb x > ec x ifTrue: [decor useHorizontalScrollBar] ifFalse: [decor noHorizontalScrollBar]. eb y > ec y ifTrue: [decor useVerticalScrollBar] ifFalse: [decor noVerticalScrollBar]. decor flushCaches. self keyboardOrder: decor topComponent keyboardProcessor]]
userSelectMenu: aCollection "aCollection is a collection of pairs, each one is composed of a string and a value, the strings are presented to the user, the corresponding value is returned" | labels values | labels := Array new: aCollection size. values := Array new: aCollection size. 1 to: aCollection size do: [:i | labels at: i put: ((aCollection at: i) at: 1). values at: i put: ((aCollection at: i) at: 2)]. ^Dialog choose: (#ChooseOne << #dialogs >> 'Choose one:') fromList: labels values: values lines: 10 cancel: [0]
</methods> <methods> Lens.LDMLimitingRel <category>initialize release</category>
reset "After readed references are symbols"
</methods> <methods> Lens.LDMLimitingRel <category>accessing</category>
limitingBlock: aBlock "aBlock has one parameter" limitingBlock := aBlock
</methods> <methods> Lens.LDMLimitingRel <category>computing</category>
computeReverse "The reverse relationship is formed by using the same limiting block on the reverse of the basic relationship. This works quite well for limiting blocks that are symetric, and it is likely that the block will be symetrical because it is not given the element for which the relationship is being computed" reverse := self class newWithRel: r1 reverse named: name,' Reverse' limitedBy: limitingBlock
relatedTo: el "Computes the basic relationship. Selects only those elements where the limitingBlock returns true" ^(r1 relatedTo: el) select: limitingBlock
</methods> <methods> Lens.LDMLimitingRel <category>printing</category>
storeOn: aStream nil storeOn: aStream
</methods> <methods> Lens.LDMLimitingRel class <category>class initialization</category>
initialize "Initialize relationships limited by a block"
</methods> <methods> Lens.LDMLimitingRel class <category>instance creation</category>
newWithRel: r named: nm limitedBy: lmBlck ^(super newWithRel: r named: nm) limitingBlock: lmBlck
</methods> <methods> Lens.LDMProtoMapBuilder <category>build</category>
build "Reorder the database columns after the graph is built" super build. self reorderColumns
reorderColumns "Get the maximum depth where database columns are found. Then make sure all the columns are at that depth. This way, the columns will all be shown in one column" | max colNds | colNds := OrderedCollection new. max := 0. nodeDict do: [:nd | (#{LensDatabaseTableColumn} ifDefinedDo: [:lensDatabaseTableColumn | (nd component selectionPerformer isKindOf: lensDatabaseTableColumn)] elseDo: [false]) ifTrue: [colNds add: nd. nd depth > max ifTrue: [max := nd depth]]]. colNds do: [:cnd | cnd depth == 1 ifTrue: [cnd isRoot: true]. cnd depth: max]
</methods> <methods> Lens.LDMElementViewController <category>control defaults</category>
doSelect "Do the selection according to the symbol in 'charged'" | code | code := charged. charged := nil. view upcastEvent: #selectionChange with: code from: view path: nil
isControlActive "Answer whether the receiver wants to retain control. Retain control if the cursor is inside the label part of the view and the blue button is not pressed. Pressing blue button a default to explicitly give up control without moving the cursor. It is sent by Controller|controlLoop in order to determine when the receiver's control loop should terminate, and should be redefined in a subclass if some other condition for terminating the main control loop is needed." self sensor redButtonPressed ifTrue: [^self labelViewHasCursor] ifFalse: [charged notNil ifTrue: [self doSelect]. ^false]
isControlWanted "The test is the same as isControlActive but the sensor has to be inside a view" ^self isControlActive
</methods> <methods> Lens.LDMElementViewController <category>cursor</category>
labelViewHasCursor "Answer true if the cursor point of the receiver's sensor lies within the display box of the label part of the receiver's view. " | sen | sen := self sensor. ^sen isActive and: [view labelBounds containsPoint: sen cursorPoint]
</methods> <methods> Lens.LDMElementViewController <category>event driven</category>
handlerForMouseEvent: event "answers self as the handler if the label view bounds contains the event, otherwise answer nil" ^(self labelViewHasCursorWithEvent: event) ifTrue: [self] ifFalse: [nil]
labelViewHasCursorWithEvent: event "Answer true if the cursor point of the receiver's sensor lies within the display box of the label part of the receiver's view. " | pt | pt := self sensor cursorPointFor: event. ^view labelBounds containsPoint: pt
redButtonPressedEvent: event "If the control key is pressed then the view is added to the selection instead of replacing the old one" event ctrlDown ifTrue: [charged := #addSelection] ifFalse: [charged := #replaceSelection]
redButtonReleasedEvent: event "do select when the red button is released" charged notNil ifTrue: [self doSelect].
</methods> <methods> Lens.LDMSelectionService <category>initialize-release</category>
initialize "viewsValue is a value holder on a collection of views." viewsValue := self emptyViews asValue. performersValue := viewsValue compute: [:views| (views collect: [:v | v selectionPerformer]) select: [:o | o notNil]]
</methods> <methods> Lens.LDMSelectionService <category>accessing</category>
addOne: aView "Add a view into the current selection, inform a view that it has been selected. If it is being readded, remove and add to keep the order correct." | selViews | selViews := self getSelectedViews. (self isSelected: aView) ifTrue: [selViews remove: aView. selViews add: aView] ifFalse: [aView select. selViews add: aView]. self setSelectedViews: selViews
deselectAll "Deselect all views and forget about all the views we were holding onto." self deselectAllViews. self setSelectedViews: self emptyViews
newSelection: aCollection "Replace a current selection with a new collection of objects" | newViews | self deselectAllViews. newViews := self emptyViews. aCollection do: [:aView | aView select. newViews add: aView]. self setSelectedViews: newViews
removeIfSelected: aView "Check if a view is in selectedView collection and remove it. This message is send when a view is released. Note that a view is NOT notified that its status has changed" (self isSelected: aView) ifTrue: [self setSelectedViews: (self getSelectedViews remove: aView ifAbsent: [])]
removeOne: aView "remove a view from the current selection, inform a view that it has been deselected" (self isSelected: aView) ifTrue: [| selViews | aView deselect. selViews := self getSelectedViews. selViews remove: aView ifAbsent: []. self setSelectedViews: selViews]
selectedPerformers "Given selected views return a collections of object designated by the views to perform actions" ^self value
selectedViews "Answer the value for selectedViews" ^self getSelectedViews copy
value ^performersValue value
</methods> <methods> Lens.LDMSelectionService <category>constructing</category>
compute: aBlock "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:." ^performersValue compute: aBlock
</methods> <methods> Lens.LDMSelectionService <category>testing</category>
isSelected: aView "is aView in the list of selected views?" self getSelectedViews do: [:v| v == aView ifTrue: [^true]]. ^false
</methods> <methods> Lens.LDMSelectionService <category>private</category>
deselectAllViews "Deselect all views" self getSelectedViews do: [:v| v deselect ].
emptyViews "Returns an empty ordered list of views." ^OrderedCollection new
getSelectedViews "Return the collection of all the selected views" ^viewsValue value
setSelectedViews: newViews "Sets newViews as the current collection of selected views" viewsValue value: newViews
</methods> <methods> Lens.LDMSelectionService class <category>class-initialization</category>
initialize "Create an instance of me and store it in a class variable. This instance can be used as a global selection service if such thing is required. If using a global selection service, the window system's selection service should be considered for possible integration and data translation from the internal selection service to the external and vice-versa." "Note that if using the global selection service extra care should be taken to remove views from the selection if they are released" "CYSelectionService initialize" GlobalInstance := self new
</methods> <methods> Lens.LDMSelectionService class <category>instance-creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMSelectionService class <category>accessing</category>
globalSelection "Return the global selection service" "Note that if using the global selection service extra care should be taken to remove views from the selection if they are released" ^GlobalInstance
</methods> <methods> Lens.LDMBrowserModel <category>initialize-release</category>
initialize "The default is to be a graph, it can be changed to be an indented list programatically. If the browsers were added to the palette as specs, this would make sense as a property of the spec" self beGraph
</methods> <methods> Lens.LDMBrowserModel <category>accessing</category>
application ^application
application: app application := app
attributesForRel: rel "Returns an array of attributes for the relationship rel" ^attributes at: rel
beGraph "The builder class is set to be the GraphBuilder. A builder will be created from this class, and it will build a graph to be presented in the view" visualBuilderClass := LDMGraphBuilder
beIndentedList "The builder class is set to be the IndentedListBuilder. A builder will be created from this class, and it will build an indented list to be presented in the view" visualBuilderClass := LDMIndentedListBuilder
body "Return the body currently associated with this model. If it hasn't been created, create it - this assumes that the body will not be queried for before the perspective and focus holders have been specified." body == nil ifTrue: [body := LDMRelationsBody new. body viewModel: self. self updateAttributesFor: perspectiveHolder value. body perspective: perspectiveHolder value. body focus: focusHolder value]. ^body
focusHolder "Return the focusHolder." ^focusHolder
focusHolder: aValue "Set the focusHolder. Whenever the holder changes the body needs to be recomputed with the new focus. This way, whenever the focus changes the correct recomputation happens" focusHolder := aValue. focusHolder compute: [:focus | self body focus: focus. body rebuild]
perspective ^perspectiveHolder value
perspectiveHolder: aValue "Set the perspectiveHolder. Whenever the holder changes the body needs to be recomputed with the new perspective. The focus needs to be respecified since this information is wiped out when the new perspective is sent. The attributes also need be updated with the settings in the new perspective." perspectiveHolder := aValue. perspectiveHolder compute: [:perspective | self body perspective: perspective. self body focus: self focusHolder value. self updateAttributesFor: perspective. self body rebuild]
selectionService "Return the selection service. If the selection service is not specified ('nil') this means the user wants a new one created on the fly for each browser - so create it. If it is wanted to share the selectionService, it should be assigned to the browser model. The selection service can be shared at all the different levels, for example, an application could chose to have a selection service per window, but when there is more than one browser in a window, they share the selection service" selectionService == nil ifTrue: [selectionService := LDMSelectionService new]. ^selectionService
selectionService: aService "Set the selection service. This is useful for sharing sel. serv." selectionService := aService
visualBuilderClass ^visualBuilderClass
visualBuilderClass: aClass visualBuilderClass := aClass
</methods> <methods> Lens.LDMBrowserModel <category>selection service</category>
select: anElement "If anElement is in the graph, select it. This is used to programatically select elements. The selection service keeps the selections as the views that are selected, the model wants to understand them in terms of elements" | visual | visual := self body visualForElement: anElement. visual notNil ifTrue: [self selectionService newSelection: (Array with: visual)]
</methods> <methods> Lens.LDMBrowserModel <category>update</category>
graphHasChanged self changed: #graph
</methods> <methods> Lens.LDMBrowserModel <category>private</category>
updateAttributesFor: perspective "Arrange the attributes of the relationships in a dictionary so the access is faster. The attributes in the dictionary may be programatically changed, thus overriding the default defined in the perspective" attributes := IdentityDictionary new. perspective relDesc do: [:rDesc | | rel | rel := LDMRelationship at: (rDesc at: 1) asSymbol. attributes at: rel put: rDesc copy]
</methods> <methods> Lens.LDMBrowserModel class <category>instance creation</category>
focusHolder: aFocusHolder perspectiveHolder: aPerspectiveHolder selectionService: aSelectionService "Create a fully specified browser model." ^LDMBrowserModel new focusHolder: aFocusHolder; perspectiveHolder: aPerspectiveHolder; selectionService: aSelectionService
new ^super new initialize
</methods> <methods> Lens.LDMElementView <category>initialize-release</category>
flush hasIn := nil. hasOut := nil.
for: aNode model: aModel element := aNode. self model: aModel. self doLayout
inButton "creates the button for opening and closing the incoming relationships. cyev is self" | v pa | pa := PluggableAdaptor on: self. pa getBlock: [:cyev | cyev hasIn == true] putBlock: self inButtonPutBlock updateBlock: [:m :a :p | false]. v := LDMArrowView model: pa. v controller beToggle. v label: ''. ^v
inButtonPutBlock "This block is executed when the arrow to the left of the element view is hit." "If the element has incoming relationships not already open, we open them one level. If all the incoming rels are already open then we close them all." ^[:cyev :val | Cursor wait showWhile: [cyev hasIn == true ifTrue: [cyev openAllSide: 2] ifFalse: [cyev closeAllSide: 2]]]
initialize super initialize. povIcons := OrderedCollection new: 0. hasIn := hasOut := nil. selected := ValueHolder with: false. recycle := false
outButton "same as inButton but for outgoing relationships" | v pa | pa := PluggableAdaptor on: self. pa getBlock: [:cyev | cyev hasOut == true] putBlock: self outButtonPutBlock updateBlock: [:m :a :p | false]. v := LDMArrowView model: pa. v controller beToggle. v label: ''. ^v
outButtonPutBlock "This block is executed when the arrow to the right of the element view is hit." "If the element has outgoing relationships not already open, we open them one level. If all the outgoing rels are already open then we close them all." ^[:cyev :val | Cursor wait showWhile: [cyev hasOut == true ifTrue: [cyev openAllSide: 1] ifFalse: [cyev closeAllSide: 1]]]
realRelease "Remove the receiver as a dependent of the model." model removeDependent: self. model := nil. super release
release "Do nothing, because we are released only after the cds that created us is finished with us. This is the price of recycling" recycle == false ifTrue: [self realRelease]
</methods> <methods> Lens.LDMElementView <category>accessing</category>
bottomRootView ^self
hasIn hasIn == nil ifTrue: [hasIn := model body hasFrom: element side: 2]. ^hasIn
hasOut hasOut == nil ifTrue: [hasOut := model body hasFrom: element side: 1]. ^hasOut
height ^(self preferredBounds height)
isElementView "Am I an CYElementView? - Yep" ^true
key ^element key
recycle recycle := true
sortKey ^element sortKey
touchFlag ^touchFlag
touchFlag: f touchFlag := f
</methods> <methods> Lens.LDMElementView <category>actions</category>
closeAllSide: side "Close all the relationships from our element, to side side" model body closeAllFrom: element side: side
openAll: trios level: n out: isOut ^self
openAllSide: side model body openAllFrom: element side: side levels: 1
</methods> <methods> Lens.LDMElementView <category>adding-removing</category>
addPovIconComponent: wrapper "Actually add the POV component onto the element." "Collapses the actions of: add:to: addWrapper: addComponent: from CompositePart so that the update code could be changed. If there is only one icon we have reserved space and need not redraw the graph." wrapper container: self. components addLast: wrapper. self isOpen ifTrue: [ | layoutBox box | layoutBox := (0@0 extent: self bounds extent). box := self computeDisplayBoxFor: wrapper inDisplayBox: layoutBox. wrapper bounds: box. preferredBounds := self computePreferredBounds. povIcons size <= 1 ifTrue: [self layoutComponentsForBounds: preferredBounds] ifFalse: [self changedPreferredBounds: preferredBounds]. self invalidateRectangle: preferredBounds]
removePovIcon: aPov "Find a wrapper containig aPov and remove it from my components. The braodcasting scheme is used to detect which wrapper contains a perspective icons. When an icon is removed I notify my container that my prefered bounds has changed. Note that aPov has to be removed before remove: message is sent, this removal does not affect calculation of preferred bounds since the value is cached, but when the new value is recalculated the povIcons collection has to contain only active icons." | toBeRemoved | toBeRemoved := nil. self components do: [:c | | holder | holder := OrderedCollection new. c broadcastDown: #cyPovIconView with: holder. (holder isEmpty not and: [holder first == aPov]) ifTrue: [toBeRemoved := c]]. toBeRemoved isNil ifFalse: [povIcons remove: aPov. self removePovIconComponent: toBeRemoved] ifTrue: [self error: (#iconNotFound << #dialogs >> 'icon not found')].
removePovIconComponent: aVisualComponent "Remove aVisualComponent from the receiver's components. " "Collapses the actions of: remove: removeComponent: from CompositePart so that the update code could be changed. If there is only one icon before the remove, it is our reserved space and we need not redraw the graph. Redisplay any now exposed component. However, the layoutComponentsForBounds: is necessary to recalculate dot view bounds. If more than one icon, redraw everything. Make sure the invalidation stretchs far enough to redraw the broom handle." | lastPreferredBounds | lastPreferredBounds := self preferredBounds. components remove: aVisualComponent. aVisualComponent container: nil. preferredBounds := self computePreferredBounds. povIcons size < 1 ifTrue: [self layoutComponentsForBounds: lastPreferredBounds] ifFalse: [self changedPreferredBounds: lastPreferredBounds]. self invalidateRectangle: (lastPreferredBounds insetOriginBy: 0@0 cornerBy: -18@0). ^aVisualComponent
</methods> <methods> Lens.LDMElementView <category>bounds accessing</category>
labelBounds "Answer the part of view used by label" ^label bounds
</methods> <methods> Lens.LDMElementView <category>broadcasting-events</category>
broadcastDown: anEvent with: arguments anEvent = #cySelectableView ifTrue: [arguments add: self]
</methods> <methods> Lens.LDMElementView <category>controller accessing</category>
defaultController "Answer an initialized instance of the receiver's default controller. Subclasses should redefine this message only if the default controller instances need to be initialized in a nonstandard way." ^LDMElementViewController new
</methods> <methods> Lens.LDMElementView <category>displaying</category>
displayOn: aGraphicsContext "Display each of the receiver's components. If the view is selected then use selection colors." | clipBox aGC | "aGraphicsContext class == CYPSGenerator ifTrue: [^self displayOnPs: aGraphicsContext]." aGC := aGraphicsContext copy. clipBox := aGC clippingBounds. aGC paint: self foregroundColor. 1 to: components size do: [:i | | component | component := components at: i. (component intersects: clipBox) ifTrue: [component displayOn: aGC copy]]
displayOnPs: aPSG | p | p := 0@0. self hasIn == 0 ifFalse: [ p := p + (3 @ 0)]. self hasOut == 0 ifFalse: [ p := p + (3 @ 0)]. aPSG displayString: self key at: p
</methods> <methods> Lens.LDMElementView <category>hit detection</category>
componentsInside: aRectangle ^Set with: self.
hitDetect: aPoint ^(self containsPoint: aPoint) ifTrue: [self] ifFalse:[nil]
</methods> <methods> Lens.LDMElementView <category>printing</category>
printOn: aStream aStream nextPutAll: 'cyev'. aStream nextPut: $<. element printOn: aStream. aStream nextPut: $>.
</methods> <methods> Lens.LDMElementView <category>selection</category>
canBeSelectedWith: anotherView "Element views can be selected only with element views" ^anotherView isKindOf: self class
deselect selected value: false.
isSelected ^selected value
select selected value: true.
selectionPerformer ^element
toggle self isSelected ifTrue: [self deselect] ifFalse: [self select]
</methods> <methods> Lens.LDMElementView <category>private-model</category>
myDependents "Answer the receiver's dependents or nil." ^dependents
myDependents: dependentsOrNil "Set the receivers dependents." dependents := dependentsOrNil
postCopy "Do not copy the dependents list." super postCopy. self breakDependents
</methods> <methods> Lens.LDMElementView <category>private</category>
doLayout | pt | pt := 0. self hasIn == 0 ifFalse: [| inBut inLf inWid | inBut := self inButton. inWid := inBut preferredBounds width + 2. inLf := LayoutFrame new. inLf bottomFraction: 1; topOffset: 1; leftOffset: pt; rightOffset: pt + inWid. self add: inBut in: inLf. pt := pt + inWid]. label := self elLabelFor: element at: pt @ 0. label := self findTopmostWrapperFor: label. pt := label bounds corner x. firstPovIconX := pt + 2. self hasOut == 0 ifFalse: [| outBut outLf outWid | outBut := self outButton. outWid := outBut preferredBounds width. outLf := LayoutFrame new. outLf bottomFraction: 1; topOffset: 1; leftOffset: [self outButtonXPosition]; rightOffset: [self outButtonXPosition + outWid]. self add: outBut in: outLf]
elLabelFor: aNode at: start "The label is given by the element. It can be either a visual component or a collection of specs. If it's a visual component, it's put in a reversing wrapper" | w lbl | lbl := aNode elementLabel: self getLabelHints. lbl isSequenceable ifTrue: [| b c | b := model application builder newSubBuilder. b composite: (c := CompositeView new). lbl do: [:sp | b add: sp]. c controller: NoController new. lbl := c]. w := ReversingWrapper on: lbl. w reverse: selected. self add: w at: start. ^w
findTopmostWrapperFor: component "Start from component and go up in the hierarchy until myself is found. Return the thing reached in the iteration just before the last one." | prev next | prev := component. next := component container. [next notNil and: [next ~~ self]] whileTrue: [prev := next. next := next container]. ^prev
getLabelHints ^model body getLabelHints
iconXPosition: icon ^firstPovIconX + ((povIcons indexOf: icon) - 1 * 18)
outButtonXPosition "Return the current position for the out arrow button." ^firstPovIconX + (povIcons size * 18)
</methods> <methods> Lens.LDMElementView <category>event driven</category>
handlerForMouseEvent: aMouseEvent "Give all the components within myself a chance to say they want to handle aMouseEvent first, then ask my controller whether it wants to handle the event or not." | o | o := label handlerForMouseEvent: aMouseEvent. o notNil ifTrue: [^o]. o := super handlerForMouseEvent: aMouseEvent. o notNil ifTrue: [^o]. ^self controller handlerForMouseEvent: aMouseEvent.
</methods> <methods> Lens.LDMElementView class <category>instance creation</category>
for: aNode model: aModel ^self new for: aNode model: aModel
</methods> <methods> Lens.LDMNodeChild <category>accessing</category>
node ^node
node: aNode node := aNode
rel ^rel
rel: aRel rel := aRel
</methods> <methods> Lens.LDMNodeChild class <category>instance creation</category>
node: aNode rel: aRel ^self new node: aNode; rel: aRel
</methods> <methods> Lens.LDMSpecialRel <category>initialize-release</category>
onBlock: ablk "Set the evaluation block" evaluationBlock := ablk
reset "These relationships are not readed and can not be saved, the reverse is expected to be set and not computed or named"
</methods> <methods> Lens.LDMSpecialRel <category>computing</category>
relatedTo: el "Evaluate the block on the element we are asked to compute the relationship for. This gives the flexibility of implementing relationships in a way external to the elements themselves, thus avoiding changing the elements or having to implement the relationship in many places" ^evaluationBlock value: el
</methods> <methods> Lens.LDMSpecialRel <category>printing</category>
storeOn: aStream "Can not really be stored in a stream" nil storeOn: aStream
</methods> <methods> Lens.LDMSpecialRel class <category>class initialization</category>
initialize "Create the = relationship. When computed it returns the same element it is computed for. Of course, it is the reverse to itself" "SpecialRel initialize" | newOne | newOne := self withToken: #'=Rel'. newOne name: #=. newOne onBlock: [:el | IdentitySet with: el]. newOne reverse: newOne. Relationships at: #= put: newOne
</methods> <methods> Lens.LDMRelationsGenerator <category>initialize-release</category>
initialize variables := OrderedCollection new
</methods> <methods> Lens.LDMRelationsGenerator <category>accessing</category>
getGraph self postChange. ^graph
graph ^graph
userCanOpen "returns a Graph of the relationships that can be opened" ^userOpensGraph
</methods> <methods> Lens.LDMRelationsGenerator <category>computing</category>
checkConnectivity: focus "After one or more arcs have been removed from a graph, connectivity is checked with the focus, so that any arc not connected to the focus will be removed from the graph" | touched totouch | touched := IdentitySet new. totouch := IdentitySet new. totouch addAll: focus. [totouch size > 0] whileTrue: [| next | next := self removeOneFrom: totouch. touched add: next. totouch addAll: (graph elementsConnectedTo: next notIn: touched)]. variables do: [:v | graph removeElements: (v removeNotIn: touched)]
openAllRelatedTo: el side: side "Opens all the relationships connected to el from side" userOpensArcs do: [:a | a openAllRelatedTo: el side: side]
updateGraph "Checks whether the relationships in the current graph still hold. Remove relationships that do not hold any more" | toDelete | toDelete := OrderedCollection new. graph outRelationshipsDo: [:el :related :rel | | newRelated bye | newRelated := rel relatedTo: el. (bye := related - newRelated) size > 0 ifTrue: [toDelete add: (Array with: el with: bye with: rel)]]. toDelete do: [:trio | graph removeFromElement: (trio at: 1) atSide: 1 andRelationship: (trio at: 3) elements: (trio at: 2)]
</methods> <methods> Lens.LDMRelationsGenerator <category>construction</category>
addRow: row using: vars "interprets a row from a description table. vars contains the variables knows so far" | v1 v2 a | v1 := self variableFromName: (row at: 1) using: vars. v2 := self variableFromName: (row at: 2) using: vars. self addVariable: v1. self addVariable: v2. a := LDMArc new. a generator: self. a relationship: (LDMRelationship at: (row at: 3) asSymbol). a putVariable: v1 atSide: 1. a putVariable: v2 atSide: 2. v1 addArc: a atSide: 1. v2 addArc: a atSide: 2. (row at: 4) ifTrue: [a beActiveIn: #initial]. (row at: 5) ifTrue: [a beActiveIn: #automatic]. (row at: 6) ifTrue: [a beActiveIn: #userOpens. userOpensArcs add: a]. (row at: 7) ifTrue: [a beRestrictedIn: 1]. (row at: 7) ifTrue: [a beRestrictedIn: 2]
addVariable: v (variables includes: v) ifFalse: [variables add: v]
perspective: ppv "builds the variables and arcs from the description table given. A description table is a collection of rows, each row contains the information regarding one arc. A row is a collection of containing the following fields: V1 - the variable at side 1 V2 - the variable at side 2 relationship - the name of the relationship initial - true or false automatic - true or false userOpens - true or false restrictedSide1 - true or false restrictedSide2 - true or false Variables are either Vnumber for regular variables or Fnumber for foci" | vars | vars := Dictionary new. userOpensArcs := OrderedCollection new. ppv rows do: [:row | self addRow: row using: vars]
variableFromName: name using: vars "vars is a dictionary with names and corresponding variables. A variable name starting with an F is a Focus variable" ^vars at: name ifAbsent: [vars at: name put: ((name at: 1) == $F ifTrue: [LDMFocusVariable newWithNumber: (Number readFrom: (name copyFrom: 2 to: name size) readStream)] ifFalse: [LDMVariable new])]
</methods> <methods> Lens.LDMRelationsGenerator <category>printing</category>
printOn: aStream aStream nextPutAll: 'RelationsGenerator <'. variables do: [:v | v printOn: aStream. aStream nextPutAll: ' ']. aStream nextPut: $>
</methods> <methods> Lens.LDMRelationsGenerator <category>private-computing</category>
addToGraph: fEls "Adds the focus elements to the graph so they are always accessible for opening and/or closing relationships" fEls do: [:el | graph addElement: el]
computeUserCanOpen "returns a LDMGraph of the relationships that can be opened" userOpensGraph := LDMGraph new. userOpensArcs do: [:a | (a isActiveIn: #initial) ifFalse: [a addUserCanOpenTo: userOpensGraph]]. ^userOpensGraph
postChange self computeUserCanOpen
reset variables do: [:v | v reset]. graph := LDMGraph new. userOpensGraph := LDMGraph new.
setFocus: foci "foci is an ordered collection of focuses, usually only one focus will be used. For each one of the Focus variables set their initial value" self reset. foci do: [:foa | self addToGraph: foa]. variables do: [:v | (v focusNumber > 0 and: [v focusNumber <= foci size]) ifTrue: [v setFocus: (foci at: v focusNumber)]]
userCloseRelationship: rel from: element to: related side: side userOpensArcs do: [:arc | arc relationship == rel ifTrue: [ arc userClosedFrom: element to: related side: side]]
userOpenRelationship: rel from: element to: related side: side userOpensArcs do: [:arc | arc relationship == rel ifTrue: [ arc userOpenFrom: element to: related side: side]]
</methods> <methods> Lens.LDMRelationsGenerator <category>private system</category>
removeOneFrom: aCollection aCollection do: [:e | aCollection remove: e. ^e]
</methods> <methods> Lens.LDMRelationsGenerator class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMRelationsGenerator class <category>testing</category>
callsDemo "RelationsGenerator callsDemo" ^self new perspective: (LDMPerspective at: #calls)
</methods> <methods> Lens.LDMComposedRel <category>computing</category>
computeReverse "The components are reversed and in reversed order. Reverse(p @ q) == Reverse(q) @ Reverse(p). Note that composition is different than AND." reverse := LDMComposedRel newWithRel: r2 reverse andRel: r1 reverse
relatedTo: el "Calculates the set of elements satisfying r1 with el, returns the union of the sets that result when applying r2 over all the elements of the first set" | firstSet resultSet | firstSet := r1 relatedTo: el. resultSet := Set new. firstSet do: [:middleEl | resultSet addAll: (r2 relatedTo: middleEl)]. ^resultSet
</methods> <methods> Lens.LDMBrowserSpec <category>building</category>
widgetWrapperWrapping: aWrapper decorator: aDecorator component: aComponent | sw | sw := SpecWrapper on: aWrapper. sw spec: self. sw widget: aComponent. sw decorator: aDecorator. colors == nil ifFalse: [sw setLookPreferences: colors]. sw setOpaque: self isOpaque. ^sw
</methods> <methods> Lens.LDMBrowserSpec <category>private</category>
defaultFlags "Default to full scroll bars. The graph will probably grow to need the scrollbars" ^2r1111
defaultModel "The default model is used while painting. We take a browserModel with the first Perspective we find. Anyway the model will not be asked to perform any computation" | dm | dm := LDMBrowserModel new. dm focusHolder: IdentitySet new asValue. dm perspectiveHolder: (LDMPerspective any) asValue. ^dm
dispatchTo: policy with: builder "Off to policy to create the view." policy browser: self into: builder
</methods> <methods> Lens.LDMBrowserSpec class <category>property slices</category>
colorSlice "Empty means NO PAGE!" ^#(1 #())
detailsSlice "Empty means NO PAGE!" ^#(1 #())
dropTargetSlice "Empty means NO PAGE!" ^#(1 #())
notificationSlice "Empty means NO PAGE!" ^#(1 #())
positionSlice "Empty means NO PAGE!" ^#(1 #())
validationSlice "Empty means NO PAGE!" ^#(1 #())
</methods> <methods> Lens.LDMVariable <category>initialize-release</category>
initialize "Initially, there are no elements and there are no arcs on either side." elements := IdentitySet new. arcsOnSide := Array with: OrderedCollection new with: OrderedCollection new
</methods> <methods> Lens.LDMVariable <category>accessing</category>
focusNumber "A regular variable is not a focus hence it returns 0, meaning no focus" ^0
setFocus: ignore "since we are not the focus, do nothing"
</methods> <methods> Lens.LDMVariable <category>computing</category>
addElements: els phase: phase "Add the elements 'els'. Then if there are any new elements, compute their impact of this on the arcs. This is done by notifying each one of our outgoing arcs (for both sides), that there are new elements. The phase is the part of the processing, either #initial or #automatic. Some arcs are only active in some phases, for example, an arc whose purpose is to add relationships once some other relationship is open, will be active on the #automatic phase. Whereas an arc that is used to compute the initial view of the graph is active on the #initial phase. An arc can be active in more than one phase." | newElems | newElems := els - elements. newElems size > 0 ifTrue: [elements addAll: newElems. self arcAndSideDo: [:arc :side | (arc isActiveIn: phase) ifTrue: [arc addElements: newElems fromSide: side phase: phase]]]
canAddElements: els fromArc: arc phase: phase "Returns the set of elements from 'els' that can be added to the variable. Checks each one of the arcs whether they accept the elements, returns the intersection of all the arcs responses. An element can be added to the variable if it is accepted by all the arcs connecting to the variable. An arc may reject a variable if it requires the relationship to have a corresponding element at the other side of the arc. This is useful for example to 'Show all the variables that reference a class', where the restricting arc would allow in only variables that have a 'reference' relationship with elements of type class. There is no need to check for the elements that are already here in the variable because they are of course 'acceptable' in this variable. Returns the elements that were already here and all of those that can be added with regard to ALL the connected arcs." | retElems alreadyHere | alreadyHere := els select: [:el | elements includes: el]. retElems := els - alreadyHere. retElems size > 0 ifTrue: [ self arcAndSideDo: [:anArc :side | (anArc ~~ arc and: [anArc isActiveIn: phase]) ifTrue: [retElems := anArc canAddElements: retElems fromSide: side phase: phase]]]. retElems addAll: alreadyHere. ^retElems
removeNotIn: aSet "Removes all the elements not present in aSet, and their respective relationships. The collection toRemove is created because a set should not be modified while an iteration over it is done" | toRemove | toRemove := OrderedCollection new. elements do: [:e | (aSet includes: e) ifFalse: [toRemove add: e]]. elements removeAll: toRemove. ^toRemove
reset "Reset to begin a new graph computation. Initially no elements." elements := IdentitySet new.
</methods> <methods> Lens.LDMVariable <category>construction</category>
addArc: arc atSide: side "Add the arc 'arc' to the 'side'. This method is used during the construction of the perspective" (arcsOnSide at: side) add: arc
</methods> <methods> Lens.LDMVariable <category>printing</category>
printOn: aStream "For debugging purposes. Prints as V(<elements>)" aStream nextPutAll: 'V( '. elements do: [:el | el printOn: aStream. aStream nextPutAll: ' ']. aStream nextPut: $)
</methods> <methods> Lens.LDMVariable <category>private</category>
arcAndSideDo: aBlock "For each side and all the arcs on the side evaluate the block giving it the arc and the side. The order of the iteration should not be important" 1 to: 2 do: [:side | | arcs | arcs := arcsOnSide at: side. 1 to: arcs size do: [:index | aBlock value: (arcs at: index) value: side]]
</methods> <methods> Lens.LDMVariable class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Lens.LDMFocusVariable <category>accessing</category>
beNumber: n "Gives the number of focus to this variable. The tools only support one focus, but future applications could use more than one (see class comment)" focusNumber := n
focusNumber "returns the focus number for this variable. In most cases it will be 1" ^focusNumber
setFocus: aCollection "Sets aCollection to be the collection of elements we include. We do not just add them to the elements, but we call addElements because we want the change to be propagated through the arcs" self addElements: aCollection phase: #initial
</methods> <methods> Lens.LDMFocusVariable <category>computing</category>
canAddElements: els fromArc: arc phase: phase "Returns the set of elements from 'els' that can be added to the variable. A Focus variable can add only what is already there" ^els select: [:el | elements includes: el]
removeNotIn: aSet "Removes all the elements not present in aSet, and their respective relationships" "For Focus Variables we do not remove any elements, because we want the focus to stay always there. This may break the premise that the arcs can reject elements in a variable, but the focus is a special case and the elements staying there do not harm in general. An element in the focus needs to be shown even if it is not related to anything, by definition" ^Set new
</methods> <methods> Lens.LDMFocusVariable <category>printing</category>
printOn: aStream "Print as 'FV(<elements>)'. This could include the focus number" aStream nextPut: $F. ^super printOn: aStream
</methods> <methods> Lens.LDMFocusVariable class <category>instance creation</category>
newWithNumber: aNumber ^self new beNumber: aNumber
</methods> <methods> UI.UILookPolicy <category>private-object lens</category>
browser: spec into: builder | component model menu | model := spec modelInBuilder: builder. component := LDMBrowserBodyView new. builder decorator: (component inDefaultEdgeDecorator). builder wrapper: (BoundedWrapper on: builder decorator). builder decorator setWidgetFlags: spec scrollingFlags. component decorator: builder decorator. component model: model. component controller: LDMCompositeViewController new. component controller performer: builder source. component body: model body bodySubView. (menu := spec getMenuIn: builder) == nil ifFalse: [component controller menuHolder: menu]. "=== (performer := spec getPerformerIn: builder) == nil ifFalse: [component controller performer: performer]. ===" builder component: component. spec decorationType == #bordered ifTrue: [builder wrapWith: self borderedWrapperClass new. builder wrapper inset: 0. builder wrapper border: self inputFieldBorder] ifFalse: [builder wrapWith: self boundedWrapperClass new]. builder applyLayout: spec layout. builder wrapWith: (self simpleWidgetWrapperOn: builder spec: spec state: nil)
</methods> <methods> Core.Object <category>relationships</category>
elementLabel: hints "This method returns a visual component used to represent myself in a browser graph. The default is to return a Label with my string key" ^Label with: (self stringKey: hints) attributes: (TextAttributes styleNamed: #systemDefault)
relatedBy: token token == #isInstanceOfRel ifTrue: [^IdentitySet with: self class]. ^IdentitySet new
sortKey "Returns a string used for sorting elements in a browser. By default returns the string key" ^self stringKey: #(sort)
stringKey: hints "A string used to represent myself in browsers, for example in a menu. The default is to use my displayString" ^self displayString
</methods> <methods> Lens.LensGraphView class <category>interface opening</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{Kernel.UserMessage} #key: #DatabaseTables #defaultString: 'Database tables' #catalogID: #labels) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 396 344 596 544 ) ) #component: #(#SpecCollection #collection: #( #(#LDMBrowserSpec #layout: #(#LayoutFrame 2 0 2 0 -2 1 -2 1 ) #name: #ldmBrowser #model: #bm ) ) ) )
</methods> <methods> Lens.LDMBrowserSpec class <category>interface specs</category>
basicsEditSpec "UIPainter new openOnClass: self andSelector: #basicsEditSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 300 171 ) #max: #(#Point 300 171 ) #bounds: #(#Rectangle 220 356 520 527 ) ) #component: #(#SpecCollection #collection: #( #(#InputFieldSpec #layout: #(#LayoutFrame 60 0 28 0 -10 1 53 0 ) #model: #name #menu: #fieldMenu ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0.5 4 0 0.5 0 ) #label: #(#{Kernel.UserMessage} #key: #LDMBrowser #defaultString: 'LDMBrowser' #catalogID: #labels) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 53 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #IDC #defaultString: 'ID:' #catalogID: #labels) ) ) ) )
</methods> <initialize> Lens.LDMRelationship </initialize> <initialize> Lens.LDMArrowView </initialize> <initialize> Lens.LDMPerspective </initialize> <initialize> Lens.LensGraphView </initialize> <initialize> Lens.LDMElementProxy </initialize> <initialize> Lens.LDMLimitingRel </initialize> <initialize> Lens.LDMSelectionService </initialize> <initialize> Lens.LDMSpecialRel </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>MenuComponentSpec</name> <environment>UI</environment> <super>UI.WidgetSpec</super> <private>false</private> none menu performer <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>UIBuilder-Specifications</package> </attributes> </class> <class> <name>VisualComponent</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Graphics-Visual Objects</category> <attributes> <package>Graphics-Visual Objects</package> </attributes> </class> <class> <name>ControllerWithMenu</name> <environment>UI</environment> <super>UI.Controller</super> <private>false</private> none menuHolder performer <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</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>UILookPolicy</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none systemAttributes systemWidgetAttributes useSystemFontOnWidgets systemMenuAttributes <imports></imports> <category>UIBuilder-Support</category> <attributes> <package>UIBuilder-Support</package> </attributes> </class> <class> <name>LabeledBooleanView</name> <environment>UI</environment> <super>UI.BooleanWidgetView</super> <private>false</private> none label onImage offImage <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</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>TranslatingWrapper</name> <environment>Graphics</environment> <super>Graphics.Wrapper</super> <private>false</private> none origin <imports></imports> <category>Graphics-Visual Objects</category> <attributes> <package>Graphics-Visual Objects</package> </attributes> </class> <class> <name>CompositeView</name> <environment>UI</environment> <super>Graphics.DependentComposite</super> <private>false</private> none controller <imports></imports> <category>UIBasics-Support</category> <attributes> <package>UIBasics-Support</package> </attributes> </class>