From VisualWorks®, 7.6 of February 8, 2008 on March 3, 2008 at 9:41:38 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>BrowserHelper</name> <environment>Tools</environment> <super>Core.Object</super> <private>false</private> none module selectionId attribute <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.BrowserHelper
BrowserHelpers represent the personality of a list view in a source code browser. Usually, a list view will only have one personality, but on occasion, it is necessary for a list view to have various personalities based on the state of other list views. For example, if a NameSpace is selected in the second pane of a four-pane browser, the fourth pane would probably show static variables within that NameSpace. But if a Class is selected, the same fourth pane will usually show messages implemented by that class. This is accomplished by attaching two different BrowserHelpers to the list view (which is represented by a SimpleBrowserModule) and allowing the BrowserModule to choose which is the current helper depending on what is selected in other BrowserModules. The BrowserHelper is responsible for supplying the list view's menu, the appropriate submenu on the menu bar, and for implementing all of the actions reachable from that menu. It also computes the contents of the list view, and for setting some guidelines on how those list items appear. Instance Variables: module <SimpleBrowserModule> represents the list view to which this helper is connected
</comment> <class> <name>MethodsBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.MethodsBrowserHelper
This class represents a list of methods--being abstract, it does not make any assumptions about the origin of those methods. The actual list elements may be message selectors, MethodDefinitions, or Contexts. As such, if one wanted to add a generic implementation of a method to this class, it would need to access the selector, method, or implementing class of a selected method via a message like "self definitionOf: aSelection". Concrete subclasses will implement #definitionOf: to return instances of MethodDefinition, or of a similar class. The generic method can then operate on the MethodDefinition to get the selector, method, implementingClass, source code, et al. Class Variables: MethodMoveProtocol <ClassOfVariable> The last protocol used in a "move method" operation
</comment> <class> <name>ClassesBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none lastSelection <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.ClassesBrowserHelper
This class represents a list of static variables--frequently classes.
</comment> <class> <name>NameSpaceCategoryBrowserHelper</name> <environment>Tools</environment> <super>Tools.ClassesBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.NameSpaceCategoryBrowserHelper
This class represents a list of all the static variables that are in a particular category of a particular NameSpace. It requires that its module's "primaryObject" be a Class or NameSpace--if it is a Class, its class pool is treated as a NameSpace for purposes of browsing. This NameSpace can be accessed via "self environment". The module's "secondaryObject" must be a Symbol, which names a particular category within the NameSpace, and can be accessed via "self category".
</comment> <class> <name>ParcelNameSpaceCategoryBrowserHelper</name> <environment>Tools</environment> <super>Tools.NameSpaceCategoryBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Programming</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ParcelNameSpaceGlobalCategoryBrowserHelper</name> <environment>Tools</environment> <super>Tools.ParcelNameSpaceCategoryBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Programming</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>SimpleBrowserModule</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none list forcedValue nextModule browser selectionCandidates helpers deselectNext cachedComponents allowsMultiSelect specName <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.SimpleBrowserModule
This represents a browser's interface onto one of its list views. This particular class supports a list with multiple selections, but only one BrowserHelper, or personality. This means that the list view will always contain generally the same kind of data, as opposed to (say) a list view that sometimes displays static variables and sometimes message selectors. The module accesses whichever BrowserHelper is currently appropriate via "self currentHelper." Instance Variables: list <SelectionInList | MultiSelectionInList> The list plus selection combination that interfaces to the list widget forcedValue <nil | Object> If nil, the module is attached to a list view, and can ask one of its helpers to compute a list for the list view. If not nil, the module does not correspond to a list view, and appears only as a submenu on the menu bar. It behaves to its helpers as though it had a list with a single item (the forced value) which is always selected. nextModule <SimpleBrowserModule> The next module in the list, which allows the list of modules to trigger cascading reactions based on selections or on menu actions browser <SystemBrowser> Allows the module or its helpers to access the entire containing browser, for global information. selectionCandidates <nil | Set> cache of selections so that the module can update these selections at the same time as it updates the list, rather than updating the list, followed by updating the selections, which would flash badly. primaryObject <Object> A piece of context possibly used by the BrowserHelper to compute a list. For example, if the list displays some of the static variables in a NameSpace, this might hold the NameSpace that is being viewed. secondaryObject <Object> A secondary piece of information used to filter the information that a BrowserHelper presents. For example, if the primaryObject is a NameSpace, the secondaryObject might be a category within that NameSpace. helpers <Array of: BrowserHelper> list of the possible BrowserHelpers, or personalities, that the module can express. If this list contains more than one helper, the receiver needs to implement some algorithm for deciding which one is currently appropriate.
</comment> <class> <name>HierarchicalBrowserModule</name> <environment>Tools</environment> <super>Tools.SimpleBrowserModule</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>MethodListBrowserHelper</name> <environment>Tools</environment> <super>Tools.MethodsBrowserHelper</super> <private>false</private> none label baseList initialSelection <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.MethodListBrowserHelper
This class represents a list of independent MethodDefinitions collected from some external source. Instance Variables: label <String> label for the window baseList <List> collection of MethodDefinitions to be displayed. This list may shrink over time as methods are found to no longer exist. initialSelection <String> When a method is selected, the string that should be high-lighted in the method's source code.
</comment> <class> <name>NameSpaceOrganizerBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none searchChildNamespaces <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.NameSpaceOrganizerBrowserHelper
This class represents a list of all the categories that are in a particular NameSpace (or the classPool of a Class). It requires that its module's "primaryObject" be a Class or NameSpace, which is accessed via "self environment".
</comment> <class> <name>ParcelNameSpaceOrganizerBrowserHelper</name> <environment>Tools</environment> <super>Tools.NameSpaceOrganizerBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>DebugContextsBrowserHelper</name> <environment>Tools</environment> <super>Tools.MethodsBrowserHelper</super> <private>false</private> none stackSize <imports></imports> <category>Tools-Programming</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.DebugContextsBrowserHelper
This class represents a list of contexts in a debugger. Instance Variables: stackSize <Integer> how long a list of contexts is desired?
</comment> <class> <name>SelectorBrowserHelper</name> <environment>Tools</environment> <super>Tools.MethodsBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.SelectorBrowserHelper
This class represents a list of all the message selectors that are in a particular protocol of a particular class or metaclass. It requires that its module's "primaryObject" be a Class or Metaclass, which is accessed via "self targetClass". The module's "secondaryObject" must be a Symbol, which names a particular protocol within the class, and is accessed via "self protocol".
</comment> <class> <name>BrowserTabApplication</name> <environment>Tools</environment> <super>Core.Object</super> <private>false</private> none components canvas browser blankCategoryCanvas indexOfCategoryCanvas icon categoryIcon emphasizer <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ParcelTabApplication</name> <environment>Tools</environment> <super>Tools.BrowserTabApplication</super> <private>false</private> none manager parcelFilterOn unparceledFilterOn conflictsFilterOn savedParcels parcelDefType <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>Emphasizer</name> <environment>Tools</environment> <super>Core.Object</super> <private>false</private> objects <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.Emphasizer
An emphasizer provides the emphasis for items displayed the browser. Emphasis is based on a criteria (eg. parcel or package) queried from the browser, which allows the client to display emphasis without knowing the criteria upon which it's based. Subclasses should define: #currentCriteria: aBrowser id: selectionId - answer the basis for emphais and all the "private-staus" methods not provided by the superclass. #emphasisForAttribute: can be used to override the default highlighting.
</comment> <class> <name>ProtocolBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.ProtocolBrowserHelper
This class represents a list of all the categories that are in a particular NameSpace (or the classPool of a Class). It requires that its module's "primaryObject" be a Class or Metaclass, which can be accessed via "self targetClass". Class Variables: LastProtocol <Symbol> The last protocol selected--used as a possible name when adding a new protocol.
</comment> <class> <name>TabbedDialog</name> <environment>UI</environment> <super>UI.ApplicationModel</super> <private>false</private> none list disturbed subBuilder developmentTabLabels runtimeTabLabels tabSpecsAndHelpSelectors <imports></imports> <category>Tools-Misc</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> UI.TabbedDialog
TabbedDialog is an abstract class that provides for tabbed selection and acceptance of user modifiable setting or property pages. Subclasses must implement the following messages: class protocol: constants windowLabel Instance Variables: disturbed <ValueModel on: Boolean> True on page entry change. list <SelectionInList> Selection model. subBuilder <UIBuilder> Page subcanvas builder. Class Instance Variables: developmentTabLabels <OrderedCollection of: String> Labels of the dialog tabs shown at development time. runtimeTabLabels <OrderedCollection of: String> Labels of the dialog tabs shown at runtime. tabSpecsAndHelpSelectors <OrderedCollection of: Array> A collection of the same size as developmentTabLabels, with two-element arrays as entries. The first element is the spec to use for the tab, the second is the selector to send to the application to get help text for the tab.
</comment> <class> <name>HierarchyBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>NameSpaceHierarchyBrowserHelper</name> <environment>Tools</environment> <super>Tools.HierarchyBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>FullSystemBrowser</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none componentDictionary components coordinator text inBatchMode meta defType toolBar selectionDictionary disableBatchUpdates ignoreNamepaceChanges listMenuMap menuBarMenuMap <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>FullNotebookSystemBrowser</name> <environment>Tools</environment> <super>Tools.FullSystemBrowser</super> <private>false</private> none majorTabs currentTabApplication labelApplicationDictionary tabApplications searchChildNamespaces <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>BrowserListEntry</name> <environment>Tools</environment> <super>UI.ValueHolder</super> <private>false</private> none type offset <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ParcelProtocolBrowserHelper</name> <environment>Tools</environment> <super>Tools.ProtocolBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>BlankUI</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none blankList <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ClassHierarchyBrowserHelper</name> <environment>Tools</environment> <super>Tools.ClassesBrowserHelper</super> <private>false</private> none baseClass <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.ClassHierarchyBrowserHelper
This class represents a class hierarchy, including a class, all of its superclasses, and all of its subclasses. It requires that its module's "primaryObject" be a class, which it uses as the starting point for creating the class hierarchy. This primaryObject can be accessed via "self baseClass".
</comment> <class> <name>ParcelListBrowserHelper</name> <environment>Tools</environment> <super>Tools.BrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Programming</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ParcelSelectorBrowserHelper</name> <environment>Tools</environment> <super>Tools.SelectorBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Programming</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>TabApplicationSystemBrowser</name> <environment>Tools</environment> <super>Tools.FullSystemBrowser</super> <private>false</private> none tabApplication <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>PackagePropertiesDialog</name> <environment>UI</environment> <super>UI.TabbedDialog</super> <private>false</private> none package properties <imports></imports> <category>Tools-Misc</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> UI.PackagePropertiesDialog
A PackagePropertiesDialog provides an user-interface for editing a CodeComponents properties. Typically, this will be a parcel, package or bundle. These properties include the various action blocks (preload, postload, presave, etc), development and deployed prerequisites properties. The receiver also provides the ability to add or remove arbitrary properties via a specialized inspector embedded in the Other Properties tab. All of the editing is buffered, i.e. a user will have to click on the accept button on each page to cause the desired property to be effected. Instance Variables: package <Parcel | PackageModel | BundleModel> The component whose properties are being modified properties <IdentityDictionary key: Symbol value: ValueHolder> The aspects for the components on each tab
</comment> <class> <name>MorphingBrowserModule</name> <environment>Tools</environment> <super>Tools.SimpleBrowserModule</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <comment> Tools.MorphingBrowserModule
This class refines its superclass to allow more than one BrowserHelper, with a very specific mechanism for choosing. If the primaryObject is a class, and the browser's "mode" for classes is either #instance or #class, then the module uses the BrowserHelper that is appropriate for looking at the class's methods (or those of its metaclass). But if the primaryObject is a NameSpace, or if it is a class but the browser's mode is #data, then the module's currentHelper is the BrowserHelper appropriate for showing static variables in a NameSpace. In this case, the BrowserHelper treats a Class as a NameSpace by showing the contents of its classPool. Instance Variables: specName <Symbol> class-side message selector that returns an encoded UISpec for the list view.
</comment> <class> <name>NamespaceTabApplication</name> <environment>Tools</environment> <super>Tools.BrowserTabApplication</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>NameSpaceNavigator</name> <environment>Tools</environment> <super>UI.SimpleDialog</super> <private>false</private> none home list path action <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>PickASomethingDialog</name> <environment>Tools</environment> <super>UI.SimpleDialog</super> <private>false</private> none list <imports></imports> <category>Interface-Dialogs</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>ParcelEmphasizer</name> <environment>Tools</environment> <super>Tools.Emphasizer</super> <private>false</private> objects <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <class> <name>NameSpaceGlobalCategoryBrowserHelper</name> <environment>Tools</environment> <super>Tools.NameSpaceCategoryBrowserHelper</super> <private>false</private> none <imports></imports> <category>Tools-Name Spaces</category> <attributes> <package>OldBrowsers</package> </attributes> </class> <name>MaxMenuEntryWidth</name> <environment>Tools.BrowserHelper</environment> <private>false</private> <constant>false</constant> <category>Menus</category> <initializer>36</initializer> <attributes> <package>OldBrowsers</package> </attributes> <name>MaxSelectorSubMenuEntries</name> <environment>Tools.BrowserHelper</environment> <private>false</private> <constant>false</constant> <category>Menus</category> <initializer>20</initializer> <attributes> <package>OldBrowsers</package> </attributes> <name>ApplicationTabs</name> <environment>Tools.FullNotebookSystemBrowser</environment> <private>false</private> <constant>false</constant> <category>Class Variables</category> <attributes> <package>OldBrowsers</package> </attributes> <name>MethodMoveProtocol</name> <environment>Tools.MethodsBrowserHelper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>OldBrowsers</package> </attributes> <name>LastProtocol</name> <environment>Tools.ProtocolBrowserHelper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>OldBrowsers</package> </attributes> <name>Map</name> <environment>Tools.BrowserListEntry</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>OldBrowsers</package> </attributes> <methods> Tools.BrowserHelper <category>initialize</category>
initialize attribute:= self defaultAttribute. selectionId := self defaultSelectionId.
module: aModule module := aModule
</methods> <methods> Tools.BrowserHelper <category>accessing</category>
browser ^module browser
emphasizer ^self browser emphasizer
initialSelection ^nil
module ^module
nextModule ^module nextModule
selector ^nil
windowLabel ^(#UnknownBrowserType << #dialogs >> 'Unknown Browser type')
</methods> <methods> Tools.BrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#(#fileOut #hardcopy #remove)
actionsForNoSelect ^#()
augmentMenuBarMenu: menu menu menuItems do: [ :item | | aModule action | aModule := self menuHeader. item truePerformerBlock: [ :cont | cont performer truePerformerFor: aModule ]. item submenu == nil ifFalse: [ self augmentMenuBarMenu: item submenu ]. action := item value. action isSymbol ifTrue: [ item value: [:cont | cont performer browser module: aModule action: action ] ] ]
buildToolBar: aMenu
buildViewMenu: aMenu
flushMenus self browser notNil ifTrue: [self browser setListMenu: nil for: self; setMenuBarMenu: nil for: self]
getListMenu | theMenu | (theMenu := self browser getListMenuFor: self) == nil ifTrue: [theMenu := self class getListMenu. self browser setListMenu: theMenu for: self]. ^theMenu
getListMenu: forMenuBar | menu | menu := forMenuBar ifTrue: [self getMenuBarMenu] ifFalse: [self getListMenu]. menu == nil ifTrue: [menu := Menu new]. self setEnablement: menu. ^menu
getMenuBarMenu | theMenu | (theMenu := self browser getMenuBarMenuFor: self) == nil ifTrue: [theMenu := self class getListMenu. self browser setMenuBarMenu: theMenu for: self. self augmentMenuBarMenu: theMenu]. ^theMenu
menuHeader ^self class menuHeader
setEnablement: menu "Set the menu's items enabled/disabled state." "Any item that has an enablementSelector will override this." "Don't override a menu items particular enablement" menu enablementSelector == nil ifFalse: [ ^menu ]. self howManySelections = 0 ifTrue: [self menu: menu do: [:item | item disable]. self actionsForNoSelect do: [:nm | self enable: nm on: menu]] ifFalse: [self howManySelections = 1 ifTrue: [self menu: menu do: [:item | item enable]] ifFalse: [self menu: menu do: [:item | item disable]. self actionsForMultiSelect do: [:nm | self enable: nm on: menu]]]. ^menu
</methods> <methods> Tools.BrowserHelper <category>list accessing</category>
howManySelections ^module howManySelections
intializeListFull "if there is a speed problem follow the other examples that initialize the list wit setListSilently:" self updateListFull
selectedItem ^self selection
selection ^module selection
selectionChanged self browser batchUpdates: []
selections ^module selections
setNewList: newList ^module setNewList: newList
updateListFull ^self
</methods> <methods> Tools.BrowserHelper <category>actions</category>
broadcastUpdate: aspect module nextModule == nil ifFalse: [module nextModule broadcastUpdate: aspect]
spawnBrowser "Trigger the 'spawn' action, via a double-click. If there are more than one types of spawning, this may not necessarily be the same as the 'spawn' menu item." self spawn
</methods> <methods> Tools.BrowserHelper <category>text processing</category>
acceptDefinition: aText from: aController "Compiles random defintion." | thing | thing := [ | theThing | Cursor execute showWhile: [ theThing := self definitionCompilerClass new evaluate: aText string in: nil allowReceiver: false receiver: nil environment: self doItEnvironment notifying: aController ifFail: [^false] ]. SourceFileManager default logChange: aText string. theThing ] on: Object errorSignal do: [ :ex | ex willProceed ifTrue: [ (Dialog confirm: ((#IsnDoYouWantToContinueQ << #dialogs >> '<1s><n>Do you want to continue?') expandMacrosWith: ex errorString) for: self interfaceWindow) ifTrue: [ex proceed]] ifFalse: [Dialog warn: ex errorString for: self interfaceWindow]. ex returnWith: nil ]. (thing allowsSelfDefinition or: [thing isBindingReference]) ifTrue: [ thing isBehavior ifTrue: [ thing := thing instanceBehavior ]. self updateListForDefinedThing: thing. ^true] ifFalse: [^false]
acceptText: text from: textController "Indicate that we didn't even try." ^nil
definitionCompilerClass ^Compiler
doItEnvironment ^nil
doItReceiver ^nil
explainSpecial: string for: explainer "Answer with a string explaining the code view selection if it is displaying one of the special edit functions." ^nil
formatFor: aController ^self
text ^nil
updateListForDefinedThing: class ^nil
</methods> <methods> Tools.BrowserHelper <category>drag and drop</category>
addClientDataTo: anIdentityDict "If a drag is possible, add the current selection(s) to the dictionary and answer true. Otherwise answer false." ^false
canAcceptDropFrom: aDC self subclassResponsibility
doDrag: aController "Drag the currently selected category." | clientData data ds dm | clientData := IdentityDictionary new. (self addClientDataTo: clientData ) ifFalse:[^self]. data := DragDropData new. data key: self getDragDropKey. data contextWindow: self interfaceWindow. data contextWidget: aController view. data contextApplication: self browser. data contextApplicationType: self contextApplicationKey. data clientData: clientData. ds := DropSource new. dm := DragDropManager withDropSource: ds withData: data. dm doDragDrop
dragEnter: aDragContext "A drag has just entered" (self canAcceptDropFrom: aDragContext) ifFalse: [^#dropEffectNone]. aDragContext dropTarget clientData: self module initialListDropState. ^#dropEffectMove
dragLeave: aDragContext "A drag has left the category list of a normal browser. If the drag contains a class, we must restore the state of the category list." (self canAcceptDropFrom: aDragContext) ifFalse: [^#dropEffectNone]. self restoreListStateFrom: aDragContext dropTarget clientData. aDragContext dropTarget clientData: nil. ^#dropEffectNone
dragOver: aDragContext "A drag is over us " ^(self canAcceptDropFrom: aDragContext) ifTrue: [self showDropFeedbackFor: aDragContext. #dropEffectMove] ifFalse: [#dropEffectNone]
drop: aDragContext "A drop has occurred in the category list of a normal brower. If the drop contained a class, move the class to the category targetted. If the drop contained a category, the user has aborted a category drag. By default do nothing." ^#dropEffectNone
getDragDropKey "return the data key for the drag" self subclassResponsibility
initialListDropState ^self module initialListDropState
restoreListStateFrom: aDictionary self module restoreListStateFrom: aDictionary
showDropFeedbackFor: aDragContext self module showDropFeedbackFor: aDragContext
wantToDrag: aController ^self module list list size > 0
</methods> <methods> Tools.BrowserHelper <category>private</category>
changeRequest ^self browser changeRequest
decorate: item ^BrowserListEntry value: item type: nil
decorateForAnyType: item | type | type := nil. item isForNameSpace ifTrue: [type := #nameSpace]. item isBindingReference ifTrue: [type := #variable ]. ^BrowserListEntry value: item type: type
enable: itemName on: menu menu == nil ifTrue: [^false]. menu menuItems do: [:it | it nameKey = itemName ifTrue: [it enable. self menu: it submenu do: [:i | i enable]. ^true]. (self enable: itemName on: it submenu) ifTrue: [it enable]]. ^false
fileEncoding ^self browser fileEncoding
hardcopyStream: aStream Cursor wait showWhile: [aStream contents asComposedText hardcopy]
interfaceWindow ^self browser interfaceWindow
listBrowserClass ^FullSystemBrowser
logProtocolChange: aString "Add aString, which is an executable account of the last protocol change (rename, remove, selector move) to the changes file." SourceFileManager default logChange: aString
menu: menu do: aBlock menu == nil ifTrue: [^self]. menu menuItems do: [:it | aBlock value: it. it submenu == nil ifFalse: [self menu: it submenu do: aBlock]]
methodCollector ^self browser methodCollector
prompt: promptString initially: initialString "Prompt the user with the message question promptString, with initial answer initialString, and accept the answer either with the menu item accept or the keyboard press RETURN. Answer the string that the user provides." ^Dialog request: promptString initialAnswer: initialString for: self interfaceWindow
textEmphasisForItem: anItem "Supply the default emphasis for list items" ^#( #norm )
textForItem: aListEntry ^aListEntry displayString asText
</methods> <methods> Tools.BrowserHelper <category>selections</category>
attribute ^attribute
attribute: aSymbol "Set the attribute that this helper is responsible for selecting." attribute := aSymbol
category ^self selected: #category
currentParcel ^self selectedParcel
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." self subclassResponsibility
defaultSelectionId "Answer the default id used for making and querying selections." ^#default
environment ^self selected: #environment
selected: aSymbol "Answer the selected value for an atttirbute." ^self browser selected: aSymbol for: self selectionId
selectedClassOrNameSpace ^self selected: #classOrNameSpace
selectedParcel ^self browser selectedParcelFor: self selectionId
selectionId ^selectionId
selectionId: aSymbol "Set the id used for setting selections." selectionId := aSymbol
setSelection "Inform the browser that the selection has changed." self setSelection: self selectedItem.
setSelection: aValue "Inform the browser that the selection has changed." self browser setSelection: attribute for: selectionId to: aValue
setSelection: attr for: id to: aValue "Inform the browser that the selection has changed." self browser setSelection: attr for: id to: aValue
targetClass "Answer the browsers currently selected class, nil if no class selected" | obj | obj := self selectedClassOrNameSpace. ^( obj ~~ nil and: [ obj isForClass ] ) ifTrue: [ obj ]
targetClassOrNameSpace "Answer the browsers currently selected class, namespace or classes namespace." | obj | obj := self selected: #classOrNameSpace. ^( obj ~~ nil and: [ self browser isData ] ) ifTrue: [ obj asNameSpace ] ifFalse: [ obj ]
</methods> <methods> Tools.BrowserHelper <category>testing</category>
allowsMultiSelect ^true
hasSelections "Does the receiver have any selections?" ^self selections isEmpty not
isData ^module browser isData
isMeta ^module browser isMeta
</methods> <methods> Tools.BrowserHelper <category>drag and drop keys</category>
allowsMultiSelectKey ^self class allowsMultiSelectKey
categoryKey ^self class categoryKey
classOrNamespaceKey ^self class classOrNamespaceKey
contextApplicationKey ^self class contextApplicationKey
parcelKey ^self class parcelKey
protocolKey ^self class protocolKey
selectorOrStaticKey ^self class selectorOrStaticKey
</methods> <methods> Tools.BrowserHelper <category>utility</category>
findASomething: prompt "Repeatedly prompt the user for a name or pattern, allowing retries until the user cancel's or returns an empty string. Answer the obj or nil" | test | [ test := self pickASomething: prompt. ( test == false ) and: [ ( Dialog confirm: (#NoMatchingObjectTryAgainQ << #dialogs >> 'No matching object, try again?') for: self interfaceWindow ) ifFalse: [ ^nil ] ifTrue: [ true ] ] ] whileTrue. ^test
pickASomething: prompt "Choose a class, namespace or global name with a prompter." "Prompt the user for a name or pattern. Answer nil if the user cancelled. Answer the class/namespace, if there is only one class/namespace that matches. If there is more than one match, prompt the user with a choice of matches, and return the selected or an empty string. If there are no matches, answer the first global name that matches, or nil if there are none." | destName pick matches | destName := Dialog request: prompt for: self interfaceWindow. destName = '' ifTrue: [^nil]. Cursor execute showWhile: [| objects | objects := Root withAllNameSpacesAndAllClassesAndStatics. matches := objects select: [:mod | (destName includes: $.) ifFalse: [destName match: mod name] ifTrue: [destName match: mod fullName]]]. (matches == nil or: [matches size = 0]) ifTrue: [^false]. matches size = 1 ifTrue: [^matches first]. matches := matches asSortedCollection: [:a :b | a fullName < b fullName]. pick := PickASomethingDialog pickASomethingFrom: (matches collect: [:m | self decorateForAnyType: m]). ^pick value
</methods> <methods> Tools.BrowserHelper class <category>class initialization</category>
classMethodsChanged BrowserHelper flushMenus
flushMenus "Flush the receiver's menus. If the receiver is the abstract superclass then flush all subclasses too." "BrowserHelper flushMenus" self allInstancesDo: [:bh| bh flushMenus]. self == BrowserHelper ifTrue: [self allSubclassesDo: [:helperClass| helperClass flushMenus]]
instanceMethodsChanged BrowserHelper flushMenus
</methods> <methods> Tools.BrowserHelper class <category>resources</category>
listMenu ^nil
</methods> <methods> Tools.BrowserHelper class <category>menus accessing</category>
getListMenu | theMenu | theMenu := self listMenu. ^[theMenu augmentFrom: self to: BrowserHelper menuName: self listMenuName for: self] on: Error do: [:ex| theMenu]
listMenuName ^#listMenu
menuHeader ^self name
</methods> <methods> Tools.BrowserHelper class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Tools.BrowserHelper class <category>drag and drop keys</category>
allowsMultiSelectKey ^#allowsMultiSelect
categoryKey ^#category
classOrNamespaceKey ^#classOrNamespace
contextApplicationKey ^#vw_browser
parcelKey ^#parcel
protocolKey ^#protocol
selectorKey ^#selector
selectorOrStaticKey ^#selectorOrStatic
staticKey ^#static
</methods> <methods> Tools.MethodsBrowserHelper <category>accessing</category>
proposedWindowLabel ^self windowLabel
selector | def | self selection == nil ifTrue: [^nil]. ^(self definitionOf: self selection) isNil ifTrue:[ self selection ] ifFalse: [ ( def := self definitionOf: self selection ) isBindingReference ifTrue: [ nil ] ifFalse: [ def selector ] ]
</methods> <methods> Tools.MethodsBrowserHelper <category>menus accessing</category>
actionsForClassesOnly ^#( #allSenders #allImplementors #localSenders #localImplementors )
actionsForMultiSelect ^#(#fileOut #hardcopy #spawn #remove)
actionsForStaticsOnly ^#( #initializeStatic )
getListMenu: forMenuBar | menu sel md | menu := super getListMenu: forMenuBar. ( (sel := self selection) == nil ) ifTrue: [ md := nil ] ifFalse: [ md := self definitionOf: sel]. self enhance: menu for: md submenu: #allSenders sending: (md isBindingReference ifTrue:[#browseAllStaticReferences: ] ifFalse:[#browseAllReferences:]). self enhance: menu for: md submenu: #allImplementors sending: (#browseAllImplementors:). self enhance: menu for: md submenu: #localSenders sending: (#browseLocalReferences:). self enhance: menu for: md submenu: #localImplementors sending:(#browseLocalImplementors:). self enhance: menu for: md submenu: #initializeStatic sending: #initializeStatic. ^menu
setEnablement: menu "Set the menu's items enabled/disabled state." "Don't override a menu items particular enablement" menu enablementSelector == nil ifFalse: [ ^menu ]. super setEnablement: menu. self menu: menu do: [ :item | ( self actionsForStaticsOnly includes: item nameKey ) ifTrue: [ self isData ifTrue: [ item enabled: ( self selection ~~ nil ) ] ifFalse: [ item disable ] ] ]. ^menu
</methods> <methods> Tools.MethodsBrowserHelper <category>actions</category>
browseAllImplementors: aSelector | def realSelector mc | def := self definitionOf: self selection. realSelector := aSelector == nil ifTrue: [self chooseSelector: (#BrowseAllImplementors << #dialogs >> 'View all implementors<n>of which selector?') from: def] ifFalse: [aSelector]. realSelector == nil ifTrue: [^self]. mc := self methodCollector. ^mc browseSelect: (mc implementorsOf: realSelector)
browseAllReferences: aSelector | def realSelector mc | def := self definitionOf: self selection. realSelector := aSelector == nil ifTrue: [self chooseSelector: (#BrowseAllImplementors << #dialogs >> 'View all implementors<n>of which selector?') from: def] ifFalse: [aSelector]. realSelector == nil ifTrue: [^self]. mc := self methodCollector. ^mc browseSelect: (mc referencesTo: realSelector)
browseAllStaticImplementors: aStatic | mc | Cursor wait showWhile:[ mc := self methodCollector. mc browseSelect: (mc implementorsOf: (aStatic environment bindingFor: aStatic name ))]. " | def realSelector mc | def := self definitionOf: module selection. realSelector := aSelector == nil ifTrue: [self chooseSelector: 'View all implementors<n>of which selector?' from: def] ifFalse: [aSelector]. realSelector == nil ifTrue: [^self]. mc := self methodCollector. ^mc browseSelect: (mc implementorsOf: realSelector)"
browseAllStaticReferences: aStatic | mc | Cursor wait showWhile:[ mc := self methodCollector. mc browseSelect: (mc referencesTo: (aStatic environment bindingFor: aStatic name ))]
browseLocalImplementors: aSelector | def realSelector mc | def := self definitionOf: self selection. realSelector := aSelector == nil ifTrue: [self chooseSelector: (#ViewLocalImplementorsnOfWhichSelectorQ << #dialogs >> 'View local implementors<n>of which selector?') from: def] ifFalse: [aSelector]. realSelector == nil ifTrue: [^self]. mc := self methodCollector. ^mc browseSelect: (mc searchClassHierarchy: def implementingClass) & (mc implementorsOf: realSelector)
browseLocalReferences: aSelector | def realSelector mc | def := self definitionOf: self selection. realSelector := aSelector == nil ifTrue: [self chooseSelector: (#ViewLocalSendersnOfWhichSelectorQ << #dialogs >> 'View local senders<n>of which selector?') from: def] ifFalse: [aSelector]. realSelector == nil ifTrue: [^self]. mc := self methodCollector. ^mc browseSelect: (mc searchClassHierarchy: def implementingClass) & (mc referencesTo: realSelector)
browseLocalStaticImplementors: aSelector
browseLocalStaticReferences: aSelector
fileOut | fileName sel fileManager toBeSaved | toBeSaved := module selections collect: [:slctn | self definitionOf: slctn ]. toBeSaved first isBindingReference ifTrue:[^self fileOutStatic]. toBeSaved := toBeSaved select: [ :md | md method notNil ]. toBeSaved size = module selections size ifFalse: [Dialog warn: (#SomeMethodsDoNotExistNotFiledOut << #dialogs >> 'Some methods do not exist, and will not be filed out') for: self interfaceWindow]. toBeSaved isEmpty ifTrue: [ ^self ]. toBeSaved size = 1 ifTrue: [sel := toBeSaved first selector copyWithout: $:. sel := toBeSaved first implementingClass name, '-', sel, '.st'] ifFalse: [sel := 'methods.st']. fileName := Dialog requestNewFileName: (#FileOutAs << #dialogs >> 'File out as') default: (Filename filterFilename: sel). fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [ fileManager timeStamp. toBeSaved do: [ :md | fileManager fileOutMessages: ( Array with: md selector ) for: md implementingClass ] ] ensure: [ fileManager close ]
fileOutStatic | fileName fileManager nm toBeSaved | toBeSaved := self selections collect: [:slctn | self definitionOf: slctn ]. nm := module selection == nil ifTrue: [(#Definitions << #dialogs >> 'Definitions') asString] ifFalse: [(self textForItem: module selection) asString]. fileName := Dialog requestNewFileName: (#fileOutOn << #dialogs >> 'File out on') default: (Filename filterFilename: nm, '.st'). fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [fileManager timeStamp. fileManager deferInitializations. toBeSaved do: [:thing | thing fileOutSourceOn: fileManager. fileManager cr]. fileManager finishInitializations. fileManager cr] ensure: [fileManager close].
hardcopy "Print the method." | stream toBeSaved | toBeSaved := module selections collect: [:slctn | self definitionOf: slctn]. toBeSaved first isBindingReference ifTrue:[^self hardcopyStatic]. toBeSaved := toBeSaved select: [:md | md method notNil]. toBeSaved size = module selections size ifFalse: [Dialog warn: (#SomeMethodsDoNotExistNotBePrintedOut << #dialogs >> 'Some methods do not exist, and will not be printed out') for: self interfaceWindow]. toBeSaved isEmpty ifTrue: [^self]. stream := TextStream on: (String new: 1000). toBeSaved do: [:md | md implementingClass printMethod: md selector on: stream]. self hardcopyStream: stream
hardcopyStatic "Print the category." | stream toBePrinted | toBePrinted := module selections collect: [:slctn | self definitionOf: slctn ]. stream := TextStream on: (String new: 1000). toBePrinted do: [:thing | stream nextPutAll: thing definition. stream cr; cr]. self hardcopyStream: stream
initializeStatic module selections do: [:slctn | | def | def := self definitionOf: slctn. def isBindingReference ifTrue: [def initialize. SourceFileManager default putInitializeFor: def]]
move | newProtocol classPart destClass protStart moved destClassName selector def | self changeRequest ifFalse: [^self]. def := self definitionOf: self selection. def isBindingReference ifTrue:[ ^self moveStatic: def]. selector := def selector. MethodMoveProtocol == nil ifTrue: [MethodMoveProtocol := '']. newProtocol := self prompt: (#EnterTargetProtocolCopy << #dialogs >> 'Type destination protocol (Class>protocol will copy)') initially: MethodMoveProtocol. newProtocol isEmpty ifTrue: [^self]. MethodMoveProtocol := newProtocol. moved := false. (newProtocol includes: $>) ifTrue: ["copy to another class" classPart := newProtocol copyUpTo: $>. destClassName := classPart copyUpTo: Character space. destClass := destClassName asQualifiedReference valueOrDo: []. destClass isBehavior ifFalse: [ ^nil]. classPart size = destClassName size ifFalse: [(classPart size-destClassName size = 6 and: [(classPart copyFrom: classPart size - 5 to: classPart size) = ' class']) ifTrue: [destClass := destClass class] ifFalse: [^nil]]. protStart := classPart size + 2. [(newProtocol at: protStart) = $ ] whileTrue: [protStart := protStart + 1]. newProtocol := (newProtocol copyFrom: protStart to: newProtocol size) asSymbol. destClass == def implementingClass ifFalse: [moved := true. destClass compile: self text classified: newProtocol notifying: nil]] ifFalse: ["move within this class" destClass := def implementingClass. newProtocol := newProtocol asSymbol]. moved ifFalse: [(destClass organization categories includes: newProtocol) ifFalse: [destClass organization addCategory: newProtocol]. destClass classifySymbol: selector under: newProtocol. self logProtocolChange: ('<1p> organization classify: <2p> under: <3p>' expandMacrosWith: destClass with: selector with: newProtocol)]. module select: module selection whenFinished: [self browser updateLists].
moveStatic: aBindingReference | newProtocol moved classPart destClassName destClass protStart | MethodMoveProtocol == nil ifTrue: [MethodMoveProtocol := '']. newProtocol := self prompt: (#EnterTargetProtocolMove << #dialogs >> 'Type destination protocol (Class>protocol will move)') initially: MethodMoveProtocol. newProtocol isEmpty ifTrue: [^self]. MethodMoveProtocol := newProtocol. moved := false. (newProtocol includes: $>) ifTrue: ["copy to another class" classPart := newProtocol copyUpTo: $>. destClassName := classPart copyUpTo: Character space. destClass := destClassName asQualifiedReference valueOrDo: []. (destClass isBehavior or: [destClass isNameSpace]) ifFalse: [ ^nil]. protStart := classPart size + 2. [(newProtocol at: protStart) = Character space] whileTrue: [protStart := protStart + 1]. newProtocol := (newProtocol copyFrom: protStart to: newProtocol size) asSymbol. destClass == aBindingReference environment ifFalse: [moved := true. aBindingReference relocateTo: destClass. destClass asNameSpace classifySymbol: aBindingReference name under: newProtocol asSymbol]] ifFalse: ["move within this class" aBindingReference environment asNameSpace classifySymbol: aBindingReference name under: newProtocol asSymbol. destClass := aBindingReference environment. newProtocol := newProtocol asSymbol]. moved ifFalse: [self logProtocolChange: ('<1p> organization classify: <2p> under: <3p>' expandMacrosWith: destClass with: aBindingReference with: newProtocol)]. module select: self selection whenFinished: [module updateList].
remove | toBeSaved staticsToBeRemoved | toBeSaved := module selections collect: [:slctn | self definitionOf: slctn]. staticsToBeRemoved := toBeSaved select: [:each | (each respondsTo: #selector) not]. self removeStatics: staticsToBeRemoved. toBeSaved := toBeSaved select:[:each | (each respondsTo: #selector)]. toBeSaved isEmpty ifTrue: [^false]. toBeSaved := toBeSaved select: [:md | md method notNil]. (self changeRequest and: [Dialog confirm: (#AreYouCertainYouWantnRemoveMethodsQ << #dialogs >> 'Are you certain that you want<n>to remove these methods?') expandMacros for: self interfaceWindow]) ifTrue: [toBeSaved do: [:md | md implementingClass removeSelector: md selector]. module updateList. ^true]. ^false
removeStatics: staticCollection | bindings | self changeRequest ifFalse: [^false]. bindings := staticCollection asArray collect: [:ref | ref isDefined ifTrue: [ref] ifFalse: [Dialog warn: ((#CantRemoveObject1sNoLongerExists << #dialogs >> 'Can''t remove the object. <1s> no longer exists.') expandMacrosWith: ref simpleName asString) for: self interfaceWindow. nil]]. bindings := bindings copyWithout: nil. bindings isEmpty ifTrue: [^false]. bindings := SystemUtils sortForLoading: bindings. bindings reverseDo: [:varRef | (Dialog confirm: ((#DoYouWantToRemove1sQ << #dialogs >> 'Are you certain that you<n>want to remove <1s>?') expandMacrosWith: varRef asString) for: self interfaceWindow) ifTrue: [(varRef subrequisites size = 0 or: [Dialog confirm: ((#HasDependentObjectsRemoveItAnywayQ << #dialogs >> '<1s> has dependent objects. Remove it anyway?') expandMacrosWith: varRef asString) for: self interfaceWindow]) ifTrue: [varRef removeFromSystem. module updateList.]]]. ^false
spawn | toBeViewed | toBeViewed := module selections collect: [:slctn | self definitionOf: slctn]. toBeViewed := toBeViewed select:[:each | each isBindingReference ifTrue:[true] ifFalse:[each method notNil]]. toBeViewed size = module selections size ifFalse: [Dialog warn: (#SomeMethodsDoNotExistAndIncluded << #dialogs >> 'Some methods do not exist, and will not be included') for: self interfaceWindow]. toBeViewed isEmpty ifTrue: [^self]. self browser spawnForMethodsLabel:self proposedWindowLabel list: toBeViewed asSortedCollection asList initialSelection: nil.
</methods> <methods> Tools.MethodsBrowserHelper <category>text processing</category>
doItEnvironment | sel | sel := self selection. ^sel == nil ifTrue: [nil] ifFalse: [(self definitionOf: sel) isBindingReference ifTrue:[(self definitionOf: sel) environment ] ifFalse:[(self definitionOf: sel) method environment]]
doItReceiver | sel | sel := self selection. ^sel == nil ifTrue: [nil] ifFalse: [(self definitionOf: sel) implementingClass instanceBehavior]
explainerClass | def | ^self selection == nil ifTrue: [ nil ] ifFalse: [ ( def := self definitionOf: module selection ) isBindingReference ifTrue: [ nil ] ifFalse: [ def implementingClass ] ].
formatFor: aController "Format the text. Have the controller replace its contents with the new Text, or nil if the format operation was unsuccessful." | selectedClass aCompiler newText aText def | aText := aController text. def := self definitionOf: self selection. (def isBindingReference or: [def isNil]) ifTrue: [ ^self ]. selectedClass := def implementingClass. selectedClass isNil ifTrue: [^self]. aCompiler := selectedClass compilerClass new. newText := aCompiler format: aText in: selectedClass notifying: aController. newText == nil ifFalse: [newText := newText asText makeSelectorBoldIn: selectedClass]. newText == nil ifFalse: [aController selectFrom: 1 to: aController text size; deselect; replaceSelectionWith: newText asText; selectAt: 1. aController view selectionStopIndex: aController text size + 1. aController view invalidate]
text | choice | choice := self selection. ^choice == nil ifTrue: [self selections isEmpty ifTrue: [nil] ifFalse: [Text new]] ifFalse: [ | def | def := self definitionOf: choice. def isBindingReference ifTrue: [ ( def definitionIfAbsent: [ (#noSource << #dialogs >> 'no source') ] ) asText ] ifFalse: [ [ def sourceCode asText makeSelectorBoldIn: def implementingClass ] on: MethodDictionary keyNotFoundSignal do: [ :ex | ((#noSourceCodeFor1s << #dialogs >> 'no source code for <1s>') expandMacrosWith: def printString) asText emphasizeAllWith: #italic; yourself ] ] ]
</methods> <methods> Tools.MethodsBrowserHelper <category>private</category>
chooseSelector: label from: def | msgs | msgs := def method allSymbolLiterals asSortedCollection. ^Dialog choose: label expandMacros fromList: msgs values: msgs lines: 20 cancel: [] for: self interfaceWindow
decorate: item | obj type | obj := self definitionOf: item. type := obj isBindingReference ifTrue: [ #variable ] ifFalse: [ obj method resourceType]. ^BrowserListEntry value: item type: type
enhance: menu for: md submenu: nameKey sending: msg | item modName selector selectors submenu otherItem | modName := self menuHeader. item := menu atNameKey: nameKey. item isNil ifTrue: [^self]. md isBindingReference ifTrue: [(self actionsForStaticsOnly includes: nameKey) ifTrue: [item value: [:controller | self perform: msg]; submenu: nil. ^self ]. nameKey == #allSenders ifFalse: [^item disable; hidden: true]. item value: [:cont | cont performer module: modName action: msg with: md]. item rawLabel: (#ReferencesTo << #labels >> 'References to'). submenu := Menu new. submenu addItem: ((MenuItem labeled: (md name asSymbol contractTo: MaxMenuEntryWidth)) value: item value). item submenu: submenu] ifFalse: [(md == nil or: [md method == nil]) ifFalse: [selector := md selector. item hidden: false. nameKey == #allSenders ifTrue: [item rawLabel: (#Senders << #menus >> 'Senders')]. item value: [:cont | cont performer module: modName action: msg with: selector]. submenu := Menu new. "If selector is nil, then the ContextDefinition is a BlockContext whose source does not have the #unboundMethod selector. These types of contexts are typically created by CodeComponent and its #actionBlockFromString:. No use in augmenting a menu for selector that does not exist. Nor is there a real use for augmenting the menu for the #unboundMethod selector, however we will address that in the future." selector isNil ifFalse: [submenu addItem: ((MenuItem labeled: (selector contractTo: MaxMenuEntryWidth)) value: item value)]. selectors := md method allSymbolLiterals. selectors remove: selector ifAbsent: nil. selectors := selectors asSortedCollection. selectors isEmpty ifFalse: [otherItem := MenuItem labeled: (#AllItemsDot << #menus >> 'All Items...'). otherItem labelText: (Text string: otherItem rawLabel asString emphasis: #(#bold)). otherItem value: [:cont | cont performer module: modName action: msg with: nil]. submenu addLine; addItem: otherItem; addLine. selectors := selectors copyFrom: 1 to: (selectors size min: MaxSelectorSubMenuEntries). selectors do: [:sel | otherItem := MenuItem labeled: (sel contractTo: MaxMenuEntryWidth). otherItem value: [:cont | cont performer module: modName action: msg with: sel]. submenu addItem: otherItem]]. item submenu: submenu]]
open: editorName on: class selector: sel editorName isDefined ifFalse: [^Dialog warn: ((#HasNotBeenLoaded << #dialogs >> '<1s> has not been loaded') expandMacrosWith: editorName) for: self interfaceWindow]. editorName value new openOnClass: class andSelector: sel
</methods> <methods> Tools.MethodsBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#method
selectMethod: aSymbol module select: aSymbol whenFinished: [module updateList]
</methods> <methods> Tools.MethodsBrowserHelper <category>drag and drop</category>
addClientDataTo: anIdentityDict | theSelectors theStatics theClassOrNameSpace | self hasSelections ifFalse: [^false]. theStatics := self selections collect: [:slctn | self definitionOf: slctn]. theStatics := theStatics select: [:each | each isBindingReference]. theSelectors := self selections. theSelectors := theSelectors select: [:each | (self definitionOf: each) isBindingReference not]. (theClassOrNameSpace := self selectedClassOrNameSpace) isNil ifTrue: [^false]. theSelectors do: [:eachSel | (theClassOrNameSpace findSelector: eachSel) isNil ifTrue: [Dialog warn: ((#Selector1pNoLongerExists << #dialogs >> 'Selector <1p> no longer exists.') expandMacrosWith: self selection asString) for: self interfaceWindow. ^false]]. anIdentityDict at: #environment put: theClassOrNameSpace environment. anIdentityDict at: #selector put: theSelectors. anIdentityDict at: #class put: theClassOrNameSpace. anIdentityDict at: #protocol put: self protocols. anIdentityDict at: #meta put: self browser meta. anIdentityDict at: #category put: self category. anIdentityDict at: #data put: theStatics. ^true
canAcceptDropFrom: aDC ^false
getDragDropKey "return the data key for the drag" ^self selectorOrStaticKey.
</methods> <methods> Tools.MethodsBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Method << #menus >> '&Method') asString
</methods> <methods> Tools.ClassesBrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#(#fileOut #hardcopy #add #browseClass #move #remove)
buildViewMenu: aMenu | menu | menu := self class metaMenu. menu menuItems do: [:i | i labelImage: nil. i indication: self browser meta value == i nameKey]. aMenu addPart: menu. menu := self class defTypeMenu. menu menuItems do: [:i | i labelImage: nil. i indication: (self browser defType value = i value)]. aMenu addPart: menu
setEnablement: menu "Set the menu's items enabled/disabled state." "Don't override a menu items particular enablement" | item | menu enablementSelector == nil ifFalse: [ ^menu ]. super setEnablement: menu. ( self selection == nil or: [ self selectionIsClass ] ) ifFalse: [ self actionsForClassesOnly do: [:nm | ( item := menu atNameKey: nm ) == nil ifFalse: [ item disable ] ] ]. ^menu
</methods> <methods> Tools.ClassesBrowserHelper <category>list accessing</category>
selectedItem | thing | thing := self selection. ( self selectionIsClass and: [ self isMeta ] ) ifTrue: [ thing := thing class]. ^thing
selectionChanged module nextModule == nil ifTrue: [ ^super selectionChanged ]. self browser updateWindowLabel. self browser batchUpdates: [ self setSelection. self selection isNameSpace ifTrue:[ self browser metaShowDataSilently]. module nextModule updateList ]
selectionIsClass ^self selection notNil and: [ self selection isSymbol ifTrue:[ false ] ifFalse:[ module selection isForClass ] ]
selectionIsDefined ^self selection notNil and: [ self selection isSymbol not ]
</methods> <methods> Tools.ClassesBrowserHelper <category>actions</category>
browseClassReferences | calls mc filter | mc := self methodCollector. filter := mc nullFilter. self selections do: [ :obj | filter := filter | (mc referencesTo: obj name) | (mc referencesTo: ( obj environment bindingFor: obj name ) )]. calls := mc select: filter. calls isEmpty ifTrue: [Dialog warn: (#None << #dialogs >> 'None') for: self interfaceWindow. ^self]. ^mc openListBrowserOn: calls label: (self selection == nil ifTrue: [(#ReferencesToVariousVariables << #dialogs >> 'References to various variables')] ifFalse: [(#ReferencesTo1s << #dialogs >> 'References to <1s>') expandMacrosWith: self selection fullName]) initialSelection: (self selection == nil ifTrue: [nil] ifFalse: [self selection name])
browseClassVariables "Show a menu of all class variables of the currently selected class and its superclasses. Browse all methods which refer to the variable selected." | binding selectedClass mc | selectedClass := self selectedItem instanceBehavior. binding := self forClass: selectedClass showVariableMenu: [:class | class localBindings asSortedCollection] collect: [:bnd | bnd key]. binding notNil ifTrue: [mc := self methodCollector. mc browseSelect: (mc searchClassHierarchy: self selectedItem) & (mc referencesTo: binding)]
browseFieldReferences "Show a menu of all instance variables of the currently selected class and its superclasses. Browse all methods which refer to the variable selected." | name mc | name := self forClass: self selectedItem showVariableMenu: [:class | class instVarNames] collect: [:cname | cname]. name isNil ifTrue: [^self]. mc := self methodCollector. mc browseSelect: (mc searchBehaviorHierarchy: self selectedItem) & (mc instVarUse: name access: #readWrite).
fileOut | fileName fileManager nm | nm := self defaultFileName. fileName := Dialog requestNewFileName: (#fileOutOn << #dialogs >> 'File out on') default: (Filename filterFilename: nm, '.st'). fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [fileManager timeStamp. fileManager deferInitializations. self selectedThingsWithOrder: [:definedObjects | definedObjects do: [:thing | thing fileOutSourceOn: fileManager. fileManager cr]]. fileManager finishInitializations. fileManager cr] ensure: [fileManager close].
hardcopy "Print the category." | stream | stream := TextStream on: (String new: 1000). self selectedThingsWithOrder: [:definedObjects | definedObjects do: [:thing | thing printOutOn: stream. stream cr; nextPut: Character newPage; cr]]. self hardcopyStream: stream
move "Move the selected classes to a user provided category." | selectedCategory aString newCategory | self changeRequest ifFalse: [^self]. selectedCategory := self category. aString := self prompt: (#EnterNewCategoryName << #dialogs >> 'Enter new category name') initially: (selectedCategory isNil ifTrue: [(#NewCategory << #labels >> 'New Category') asString] ifFalse: [selectedCategory]). aString isEmpty ifTrue: [^self]. newCategory := aString asSymbol. newCategory = selectedCategory ifTrue: [^self]. module selections do: [:aClass | self environment classifySymbol: aClass name under: newCategory. ChangeSet changeClass: aClass]. self browser broadcastUpdate: #category -> newCategory
moveNameSpace | newSpace | newSpace := NameSpaceNavigator searchFrom: (self defaultEnvironment isNil ifTrue: [Smalltalk] ifFalse: [self defaultEnvironment]) label: (#MoveToWhichEnvironmentQ << #dialogs >> 'Move to which environment?'). newSpace == nil ifTrue: [^self]. module selections do: [:sel | sel relocateTo: newSpace]. module updateList
remove "Prompt the user to remove the current class. Answer if the class was removed or not." | objs parentEvironment | self changeRequest ifFalse: [^false]. objs := module selections asArray collect: [ :obj | obj isObsolete ifFalse: [ obj ] ifTrue: [Dialog warn: ((#CantRemoveObject1sNoLongerExists << #dialogs >> 'Can''t remove the object. <1s> no longer exists.') expandMacrosWith: obj fullName) for: self interfaceWindow. nil] ]. objs := objs copyWithout: nil. objs isEmpty ifTrue: [ ^false ]. objs := SystemUtils sortForLoading: objs. objs reverseDo: [ :obj | (Dialog confirm: ((#DoYouWantToRemove1sQ << #dialogs >> 'Are you certain that you<n>want to remove <1s>?') expandMacrosWith: obj fullName ) for: self interfaceWindow) ifTrue: [(obj subrequisites size = 0 or: [Dialog confirm: ((#HasDependentObjectsRemoveItAnywayQ << #dialogs >> '<1s> has dependent objects. Remove it anyway?') expandMacrosWith: obj fullName) for: self interfaceWindow]) ifTrue: [parentEvironment := obj environment. obj removeFromSystem]]]. module updateList. self browser class name = #FullNotebookSystemBrowser ifTrue:[ self browser setAndUpdateEnvironment: parentEvironment. self browser toggleNamespaceList ]. ^false
rename "Rename the currently selected thing, which can be (depending on the selection and the meta switch) either a class, or a metaclass, or a namespace." | newName target kind | self changeRequest ifFalse: [^self]. target := self selected: #classOrNameSpace. target isBehavior ifTrue: [kind := (#class << #labels >> 'class'). target := target instanceBehavior] ifFalse: [kind := (#namespace << #labels >> 'namespace')]. newName := self prompt: ((#EnterNew1sName << #dialogs >> 'Enter new <1s> name') expandMacrosWith: kind) initially: self selection name asString. newName isEmpty ifTrue: [^self]. newName := SystemUtils validateStaticVariableName: newName confirm: [:msg :nm | Dialog confirm: msg for: self interfaceWindow] warn: [:msg | Dialog warn: msg for: self interfaceWindow]. newName isNil ifTrue: [^self]. SmalltalkWorkbench rename: target to: newName asSymbol do: [:cls :nm | module select: cls whenFinished: [module updateList]] for: self interfaceWindow browser: self browser
spawn self selectedItem isNil ifTrue:[^self]. self browser spawnOnClass: (self selectedItem isMeta ifTrue:[ self selectedItem instanceBehavior] ifFalse:[ self selectedItem]).
spawnBrowser "Trigger the 'spawn' action, via a double-click. If there are more than one types of spawning, this may not necessarily be the same as the 'spawn' menu item." self selectionIsClass ifTrue: [SmalltalkWorkbench browseClass: self selectedItem] ifFalse: [self spawn]
spawnHierarchy self selectedItem isForNameSpace ifTrue:[^self]. self browser spawnOnClassHierarchy: (self selectedItem isMeta ifTrue:[self selectedItem instanceBehavior] ifFalse:[self selectedItem ]).
</methods> <methods> Tools.ClassesBrowserHelper <category>text processing</category>
acceptText: text from: textController self selection == nil ifTrue: [^nil]. (self browser defType value == #showHierarchy and: [self selectionIsClass]) ifTrue: [^false]. (self browser defType value == #showComment and: [self selectionIsDefined]) ifTrue: [self selection asNameSpace namedReferent comment: text. ^true]. ^self acceptDefinition: text from: textController
doItEnvironment ^self selectionIsClass ifTrue: [self selectedItem environment] ifFalse: [self environment]
doItReceiver ^self selectionIsClass ifTrue: [self selectedItem instanceBehavior] ifFalse: [nil]
explainerClass ^self selectionIsClass ifTrue: [self selectedItem] ifFalse: [nil]
text ^self selection == nil ifTrue: [self selections isEmpty ifTrue: [nil] ifFalse: [Text new]] ifFalse: [self textWhenSelected]
textWhenSelected "Boy I hate this 'architecture'." (self browser defType value == #showHierarchy and: [self selectionIsClass]) ifTrue: [^self isData ifTrue: [self selectedItem printHierarchyWithStatics] ifFalse: [self selectedItem printHierarchy]]. (self browser defType value == #showComment and: [self selectionIsDefined]) ifTrue: [ | comment | comment := self selection comment. ^comment isEmpty ifTrue: [self selection commentTemplateString] ifFalse: [comment]]. ^self selectionIsDefined ifTrue: [self selection definition]
updateListForDefinedThing: thing module select: thing whenFinished: [ module updateList ]
</methods> <methods> Tools.ClassesBrowserHelper <category>private</category>
decorate: item | type | type := nil. item isForNameSpace ifTrue: [type := #nameSpace]. ^BrowserListEntry value: item type: type
defaultEnvironment | all | all := module selections collect: [:i | i environment]. all := all asSet asArray. ^all size = 1 ifTrue: [all first] ifFalse: [Smalltalk]
defaultFileName "Answer a string as a suggested filename" ^self selection == nil ifTrue: [ (#Definitions << #labels >> 'Definitions') asString] ifFalse: [ ( self textForItem: self selection ) asString ].
definitionOfStatic: aVar self subclassResponsibility
forClass: aClass showVariableMenu: generatorBlock collect: valueBlock "Construct a menu of variable names supplied by the generatorBlock, with lines between classes in the superclass chain. Show the menu, returning the variable chosen by the user, or nil if no variable was chosen." | variables labels tab listW sd spec buttons | variables := OrderedCollection new. labels := SelectionInList new. tab := String with: Character tab. aClass withAllSuperclasses reverseDo: [:eachClass | | varList | varList := generatorBlock value: eachClass. varList isEmpty ifFalse: [labels list add: (Text string: eachClass name emphasis: #italic). labels selectionIndex: labels list size + 1. "we know this will be legal" variables add: nil. (generatorBlock value: eachClass) do: [:var | labels list add: tab, (valueBlock value: var). variables addLast: var]]]. variables isEmpty ifTrue: [^nil]. "Nothing to choose from" sd := SimpleDialog new. spec := (sd class interfaceSpecFor: #emptySpec). sd builder add: spec window. sd builder add: spec component. sd setInitialGap. sd addMessage: (#BrowseReferencesToWhichVariableQ << #dialogs >> 'Browse references<n>to which variable?') expandMacros centered: true. sd addGap: 8. listW := sd addList: labels lines: (20 min: variables size+2) validation: [labels selectionIndex > 0]. listW widget setValidTargetIndex: labels selectionIndex. sd addGap: 4. buttons := sd addOK: [labels selectionIndex ~= 0]. sd addGap: 6. sd bottomAlignLowerEdge: listW. sd bottomAlign: (Array with: buttons). labels selectionIndexHolder compute: [:v | (v > 0 and: [(variables at: v) == nil]) ifTrue: [labels selectionIndex: 0. listW widget targetIndex: 0]]. sd preOpen. sd builder openDialogWithExtent: sd builder window displayBox extent. ^sd accept value ifTrue: [variables at: labels selectionIndex] ifFalse: [nil]
selectedThingsWithOrder: aBlock aBlock value: ( SystemUtils sortForLoading: self selections ).
textEmphasisForItem: anItem ^self emphasizer emphasisForClassOrNameSpace: anItem for: self browser id: self selectionId
textForItem: aListEntry ^aListEntry name asText
</methods> <methods> Tools.ClassesBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#classOrNameSpace
</methods> <methods> Tools.ClassesBrowserHelper <category>drag and drop</category>
addClientDataTo: anIdentityDict self hasSelections ifFalse: [^false]. anIdentityDict at: self classOrNamespaceKey put: self selections. ^true
canAcceptDropFrom: aDC ^false
dragEnter: aDragContext "Typically a class pane doesn't accept drops" ^#dropEffectNone
dragLeave: aDragContext "Typically a class pane doesn't accept drops" ^#dropEffectNone
dragOver: aDragContext "Typically a class pane doesn't accept drops" ^#dropEffectNone
getDragDropKey "return the data key for the drag" ^self classOrNamespaceKey.
</methods> <methods> Tools.ClassesBrowserHelper class <category>resources</category>
commentIcon ^OpaqueImage figure: self commentIconColor shape: self commentIconMask
definitionIcon ^OpaqueImage figure: self definitionIconColor shape: self definitionIconMask
hierarchyIcon ^OpaqueImage figure: self hierarchyIconColor shape: self hierarchyIconMask
</methods> <methods> Tools.ClassesBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Class << #menus >> '&Class') asString
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>accessing</category>
windowLabel ^(#ClassBrowserOn << #labels >> 'Class Browser on <1p>') expandMacrosWith: self selection
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>list accessing</category>
generateListFull | env newList cat | env := self environment. cat := self category. newList := env == nil ifTrue: [ newList := cat == nil ifTrue: [ Root withAllNameSpacesAndAllClasses ] ifFalse: [ Root withAllNameSpacesAndAllClasses select: [:ea| ea category == cat ] ] ] ifFalse: [ newList := cat == nil ifTrue: [ env asNameSpace organization elements ] ifFalse: [ env asNameSpace organization listAtCategoryNamed: cat ]. newList := newList collect: [ :nm | | bind | ( bind := env bindingFor: nm ) isForGeneral not ifTrue: [ bind value ] ]. newList := newList reject: [ :ref | ref == nil ]. ]. ^newList.
updateListFull module setNewList: ( self generateListFull asSortedCollection: [ :a :b | a name < b name ] ) asList. module list list isEmpty ifTrue: [self broadcastUpdate: #classOrNameSpace -> self environment]
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>menus accessing</category>
actionsForNoSelect ^#(#add #addClassBytes #addClassFixedSize #addClassVariableSize)
enhance: menu for: md submenu: nameKey subMenuName: aName | item | item := menu atNameKey: nameKey. item isNil ifTrue: [^self]. ((nameKey == #spawnHierarchy )) ifTrue: [^self selection == nil ifTrue: [item disable] ifFalse: [self selection isForNameSpace ifTrue:[item disable] ifFalse:[item enable]]].
getListMenu: forMenuBar | menu | menu := super getListMenu: forMenuBar. self enhance: menu for: self selection submenu: #spawnHierarchy subMenuName: (#SpawnHierarchy << #menus >> 'Spawn Hierarchy') . ^menu
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>templates</category>
templateBinding: nameSpace category: category ^'<1s> defineSharedVariable: #<2s> private: false constant: false category: <3p> initializer: ''Array new: 5''' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfBinding << #browser >> 'NameOfBinding' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
templateClass: nameSpace category: category type: type | ns | ns := nameSpace == nil ifTrue: [ Smalltalk ] ifFalse: [ nameSpace ]. ^'<1p> defineClass: #<2s> superclass: #{<3s>} indexedType: #<4s> private: false instanceVariableNames: ''<5s>'' classInstanceVariableNames: '''' imports: '''' category: <6p>' expandMacrosWithArguments: (OrderedCollection new add: (ns namedReferent unambiguousName); add: #NameOfClass << #browser >> 'NameOfClass'; add: #NameOfSuperclass << #browser >> 'NameOfSuperclass'; add: type; add: (type == #bytes ifTrue: [''] ifFalse: [(#instVarName1InstVarName2 << #browser >> 'instVarName1 instVarName2')]); add: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString]); yourself)
templateNameSpace: nameSpace category: category ^'<1s> defineNameSpace: #<2s> private: false imports: '' <3s>.* private Smalltalk.* '' category: <4p>' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfPool << #browser >> 'NameOfPool' with: #OtherNameSpace << #browser >> 'OtherNameSpace' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>actions</category>
addBinding self browser defType value: #showDefinition. module deselect. self browser text value: (self templateBinding: self environment category: self category)
addClassBytes self browser defType value: #showDefinition. module deselect. self browser text value: (self templateClass: self environment category: self category type: #bytes)
addClassFixedSize self browser defType value: #showDefinition. module deselect. self browser text value: (self templateClass: self environment category: self category type: #none)
addClassVariableSize self browser defType value: #showDefinition. module deselect. self browser text value: (self templateClass: self environment category: self category type: #objects)
addNameSpace self browser defType value: #showDefinition. module deselect. self browser text value: (self templateNameSpace: self environment category: self category)
move | aString newCategory | self changeRequest ifFalse: [^self]. aString := self prompt: (#EnterNewCategoryName << #dialogs >> 'Enter new category name') initially: (self category isNil ifTrue:[(#NewCategory << #labels >> 'New Category') asString]ifFalse:[ self category]). aString isEmpty ifTrue: [^ self]. newCategory := aString asSymbol. newCategory == self category ifTrue: [^self]. module selections do: [ :selection | selection environment classifySymbol: selection name under: newCategory. selection isForClass ifTrue: [ ChangeSet changeClass: selection ] ifFalse: [ ChangeSet changeNameSpace: selection ]. ]. self browser broadcastUpdate: #category -> newCategory
moveNewParcel | newName currentParcel obj | self changeRequest ifFalse: [^self]. newName := Dialog request: (#EnterNameForNewParcel << #dialogs >> 'Enter name for the new parcel') initialAnswer: '' onCancel: [nil]. newName := Parcel normalizedNameFor: newName. (newName isNil or: [newName isEmpty]) ifTrue: [^self]. (Parcel parcelNamed: newName) notNil ifTrue: [Dialog warn: (#parcelExists << #dialogs >> 'A parcel with this name already exists'). ^self]. (currentParcel := Parcel createParcelNamed: newName) == nil ifTrue: [^self]. obj := self selection. obj isForClass ifTrue: [ currentParcel addEntiretyOfClass: obj ] ifFalse: [currentParcel addObject: obj ].
selectBehavior: aBehavior self setSelection: aBehavior. module select: aBehavior whenFinished: [module updateList]
spawn self selection isNil ifTrue: [^self]. self selectionIsClass ifTrue: [^super spawn]. self selection isForNameSpace ifTrue: [self browser spawnOnNameSpace: module selection]
</methods> <methods> Tools.NameSpaceCategoryBrowserHelper <category>private</category>
defaultEnvironment ^self environment
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>emphasis</category>
textEmphasisForItem: anItem anItem isSymbol ifTrue:[ ^Set new ]. ^self emphasizer emphasisForClassOrNameSpace: anItem for: self browser id: selectionId.
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>actions</category>
addBinding self browser parcelDefType value: #parcelDefintion. super addBinding.
addClassBytes self browser parcelDefType value: #parcelDefintion. super addClassBytes.
addClassFixedSize self browser parcelDefType value: #parcelDefintion. super addClassFixedSize.
addClassVariableSize self browser parcelDefType value: #parcelDefintion. super addClassVariableSize.
addNameSpace self browser parcelDefType value: #parcelDefintion. super addNameSpace.
addSelectionToParcel | obj | self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. obj := self selection. obj isForClass ifTrue: [ self currentParcel addEntiretyOfClass: obj ] ifFalse: [ self currentParcel addObject: obj ]. self browser updateLists
moveNewParcel | newName currentParcel obj | self changeRequest ifFalse: [^self]. newName := Dialog request: (#EnterNameForNewParcel << #dialogs >> 'Enter name for the new parcel') initialAnswer: '' onCancel: [nil]. newName := self browser manager normalizedNameFor: newName. (newName isNil or: [newName isEmpty]) ifTrue: [^self]. (self browser manager parcelNamed: newName) notNil ifTrue: [Dialog warn: (#parcelExists << #dialogs >> 'A parcel with this name already exists'). ^self]. (currentParcel := self browser manager createParcelNamed: newName) == nil ifTrue: [^self]. obj := self selection. obj isForClass ifTrue: [ currentParcel addEntiretyOfClass: obj ] ifFalse: [ currentParcel addObject: obj ]. self browser updateParcelLists. self module selection: currentParcel
removeSelectionFromParcel self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. self selection isForClass ifTrue: [self currentParcel removeEntiretyOfClass: self selection ] ifFalse: [self currentParcel removeNameSpace: self selection ]. self browser updateLists
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>Parcel actions</category>
moveSelectionToParcel: aParcel "Move the selected class into theParcel according to the current parcel and filtering. A Namespace move is not currently implemented." self changeRequest ifFalse: [ ^self ]. self browser saveParcelsForUndo. self selection isForClass ifTrue: [ self browser moveBehaviors: (Set with: self nonMetaClass with: self nonMetaClass class) toParcel: aParcel ] ifFalse: [ Dialog warn: (#NotImplemented << #dialogs >> 'Not implemented.') ]. self browser updateLists
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>menus accessing</category>
enhance: menu for: md submenu: nameKey subMenuName: aName | item | item := menu atNameKey: nameKey. item isNil ifTrue: [^self]. ((nameKey == #moveNewParcel )) ifTrue: [item enable ; hidden: false].
getListMenu: forMenuBar | selection menu | menu := super getListMenu: forMenuBar. selection := ( self selection == nil or: [ self selection isSymbol ] ) ifTrue: [ #() ] ifFalse: [ self selection ]. self enhance: menu for: self selection submenu: #moveNewParcel subMenuName: (#NewParcel << #menus >> 'New Parcel') . ^self browser addParceling: ( self browser manager parcelsForClassOrNameSpace: selection ) to: (menu) forHelper: self
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>list accessing</category>
intializeListFull | newList | "why no filtering with no category?" self category == nil ifTrue: [ ^super updateListFull ]. newList := (self generateListFull asSortedCollection: [ :a :b | a name < b name ]) asList. module setNewListSilently: ( self filter: newList )
updateListFull | newList | newList := (self generateListFull asSortedCollection: [ :a :b | a name < b name ]) asList. module setNewList: ( self filter: newList )
</methods> <methods> Tools.ParcelNameSpaceCategoryBrowserHelper <category>private</category>
decorate: item | type | type := nil. item class name == #Parcel ifTrue:[type := #parcel] ifFalse:[item isForNameSpace ifTrue: [type := #nameSpace]]. ^BrowserListEntry value: item type: type
filter: ClassNameSpaceList "Compute the list of things for the selected category. Things are either classes or nameSpaces. If the isInParcel filter is on and there is no selected parcel then display all classes in the category." | browser currentParcel manager | browser := self browser. manager := browser manager. currentParcel := self currentParcel. browser isUnparceledFilterOn ifTrue: [ ^ClassNameSpaceList select: [ :obj | obj isForClass ifTrue: [browser isUnparceledCodeInClass: obj currentParcel: currentParcel] ifFalse: [browser isUnparceledCodeInNameSpace: obj ] ] ]. browser isParcelFilterOn ifFalse: [^ClassNameSpaceList]. browser isConflictsFilterOn ifTrue: [| conflicts | conflicts := browser computeConflictsFor: ClassNameSpaceList within: (currentParcel notNil ifTrue: [Array with: currentParcel]). conflicts := conflicts last collect: [:class| class fullName]. ^ClassNameSpaceList select: [:obj| conflicts includes: obj fullName]]. currentParcel isNil ifTrue: [^ClassNameSpaceList select: [:ea| | | (manager parcelsForClassOrNameSpace: ea ) size > 0]]. ^ClassNameSpaceList select: [ :obj | obj isForClass ifTrue: [currentParcel definesOrExtendsClass: obj ] ifFalse: [currentParcel definesObject: obj] ]
nonMetaClass "Answer the class that is currently selected (nil if none), even if looking at the metaClass." | classOrNil | classOrNil := self selection. (self isMeta and: [classOrNil notNil]) ifTrue: [classOrNil := classOrNil instanceBehavior]. ^classOrNil
</methods> <methods> Tools.ParcelNameSpaceGlobalCategoryBrowserHelper <category>private</category>
textForItem: aListEntry ^aListEntry displayString asText
</methods> <methods> Tools.ParcelNameSpaceGlobalCategoryBrowserHelper <category>list accessing</category>
generateListFull | env newList | env := self environment. newList := env == nil ifTrue: [ newList := Root withAllNameSpacesAndAllClasses ] ifFalse: [ self category == nil ifTrue: [Root withAllNameSpacesAndAllClasses] ifFalse: [ newList := Root withAllNameSpacesAndAllClasses select:[:each | each category = self category]. ].]. ^newList.
</methods> <methods> Tools.SimpleBrowserModule <category>initialize</category>
browser: aBrowser browser := aBrowser
forceSelection: aSelection forcedValue := aSelection. self setSelection: aSelection
helper: aHelper aHelper module: self. helpers := List with: aHelper.
helpers: aList helpers := aList. aList do: [:i | i module: self].
helperType: aClass self helpers: (Array with: aClass new)
initialize list := self allowsMultiSelect ifTrue: [MultiSelectionInList new] ifFalse: [SelectionInList new]. list selectionIndexHolder onChangeSend: #selectionChanged to: self. specName := self defaultSpecName. deselectNext := true
nextModule: module nextModule := module
specName: name specName := name
</methods> <methods> Tools.SimpleBrowserModule <category>accessing</category>
allowsMultiSelect allowsMultiSelect == nil ifTrue: [ allowsMultiSelect := true ]. ^allowsMultiSelect.
allowsMultiSelect: aBoolean ^allowsMultiSelect := aBoolean
browser ^browser
cachedComponents ^cachedComponents
cachedComponents: aCollection cachedComponents := aCollection
currentHelper "Subclasses may choose another helper based on context." ^helpers at: 1
defaultSpecName ^self allowsMultiSelect ifTrue: [ #listSpec ] ifFalse: [ #listSpecSingleSelect ].
deselectNextModuleOnReselect ^deselectNext
deselectNextModuleOnReselect: aBoolean deselectNext := aBoolean == true
helpers ^helpers
initialSelection ^self currentHelper initialSelection
listSpec ^self class interfaceSpecFor: self specName
nextModule ^nextModule
numberOfLists ^forcedValue == nil ifTrue: [1] ifFalse: [0]
selectedEnvironment ^browser selectedNameSpaceFor: #default
specName ^specName
windowLabel ^self currentHelper windowLabel
</methods> <methods> Tools.SimpleBrowserModule <category>testing</category>
hasList ^forcedValue == nil
testChangeSelection: controller ^self changeRequest
</methods> <methods> Tools.SimpleBrowserModule <category>copying</category>
postCopy | old | super postCopy. builder := browser := nextModule := nil. helpers := helpers collect: [:i | i copy module: self]. old := list. list := self allowsMultiSelect ifTrue: [MultiSelectionInList new] ifFalse: [SelectionInList new]. list list: old list copy. self allowsMultiSelect ifTrue: [list selectionIndexes: old selectionIndexes copy] ifFalse: [list selectionIndex: old selectionIndex]. list selectionIndexHolder onChangeSend: #selectionChanged to: self.
</methods> <methods> Tools.SimpleBrowserModule <category>menus accessing</category>
buildMenuBar: aMenu | item | item := MenuItem labeled: self menuHeader. item submenu: [self getListMenu: true]. aMenu addItem: item
buildToolBar: aMenu self currentHelper buildToolBar: aMenu
buildViewMenu: aMenu self currentHelper buildViewMenu: aMenu
dispatch: selector ^self currentHelper perform: selector
dispatch: selector with: arg ^self currentHelper perform: selector with: arg
getListMenu: forMenuBar ^self currentHelper getListMenu: forMenuBar
listMenu ^[self getListMenu: false]
menuHeader "This doesn't change when the helper changes, so we bind it to the first one." ^helpers first menuHeader
module: mName action: action with: arg self dispatch: action with: arg
</methods> <methods> Tools.SimpleBrowserModule <category>list accessing</category>
checkVisibility | indices listView | self builder == nil ifTrue: [^self]. indices := self listSelectionIndexes asArray. listView := (builder componentAt: #list) widget. indices size = 1 ifTrue: [listView makeVisible: indices first]. "Complete kludge to get around lists that have been scrolled. This sort of nonsense won't happen in Pollock or new tools." listView fixScrollingOffset; invalidate
deselect self allowsMultiSelect ifTrue: [list selectionIndexes: Set new] ifFalse: [list selectionIndex: 0]
list ^list
postFilter: decoratedList | hasType | hasType := decoratedList inject: false into: [:b :ent | b or: [ent type notNil]]. hasType ifTrue: [decoratedList do: [:ent | ent type == nil ifTrue: [ent type: #normal]]]
select: selection whenFinished: updateBlock selectionCandidates := Set with: (self decorate: selection). updateBlock ensure: [selectionCandidates := nil]
selectAll: selections whenFinished: updateBlock selectionCandidates := selections asSet collect: [:selection | self decorate: selection]. updateBlock ensure: [selectionCandidates := nil]
selection | sels | sels := self listSelections. ^sels size = 1 ifTrue: [sels asArray first value] ifFalse: [nil]
selection: aValue self allowsMultiSelect ifTrue: [self list selections: (Set with: (self decorate: aValue))] ifFalse: [self list selection: (self decorate: aValue)]
selectionChanged list selectionIndexHolder retractInterestsFor: self. [self currentHelper selectionChanged] ensure: [list selectionIndexHolder onChangeSend: #selectionChanged to: self]. ^self
selectionIndex | indx | indx := self listSelectionIndexes. ^indx size = 1 ifTrue: [indx asArray first] ifFalse: [nil]
selections ^self listSelections collect: [:i | i value]
setNewList: newList | decoratedList | decoratedList := newList collect: [:item | self decorate: item]. self postFilter: decoratedList. self allowsMultiSelect ifTrue: [list setList: decoratedList selecting: (selectionCandidates == nil ifTrue: [list selections asSet] ifFalse: [selectionCandidates asSet])] ifFalse: [list setList: decoratedList selecting: (selectionCandidates == nil ifTrue: [list selection] ifFalse: [selectionCandidates asArray first])]. self checkVisibility
setNewListSilently: t1 | t2 | list selectionIndexHolder retractInterestsFor: self. t2 := t1 collect: [:t3 | self decorate: t3]. self postFilter: t2. self allowsMultiSelect ifTrue: [list setList: t2 selecting: (selectionCandidates == nil ifTrue: [list selections asSet] ifFalse: [selectionCandidates asSet])] ifFalse: [list setList: t2 selecting: (selectionCandidates == nil ifTrue: [list selection] ifFalse: [selectionCandidates asArray first])]. self checkVisibility. list selectionIndexHolder onChangeSend: #selectionChanged to: self. ^self
updateList ^forcedValue == nil ifTrue: [self currentHelper updateListFull] ifFalse: [self select: forcedValue whenFinished: [self setNewList: (List with: forcedValue)]].
</methods> <methods> Tools.SimpleBrowserModule <category>actions</category>
broadcastUpdate: aspect self currentHelper broadcastUpdate: aspect
intializeListFull self currentHelper intializeListFull
spawnBrowser "Trigger the 'spawn' action, via a double-click. If there are more than one types of spawning, this may not necessarily be the same as the 'spawn' menu item." self spawn
</methods> <methods> Tools.SimpleBrowserModule <category>text processing</category>
acceptText: text from: textController "Indicate that we didn't even try." ^self currentHelper acceptText: text from: textController
doItEnvironment ^self currentHelper doItEnvironment
doItReceiver ^self currentHelper doItReceiver
explainFor: aController "Try to shed some light on what kind of entity the controller's current selection is. The selection must be a single token or construct." | targetClass selector | (targetClass := self currentHelper explainerClass) == nil ifTrue: [targetClass := UndefinedObject]. (selector := self currentHelper selector) == nil ifTrue: [^self]. Explainer explain: aController selection string class: targetClass selector: selector methodText: self text for: self
explainSpecial: string for: explainer "Answer with a string explaining the code view selection if it is displaying one of the special edit functions." ^self currentHelper explainSpecial: string for: explainer
formatFor: aController self currentHelper formatFor: aController
text ^self currentHelper text
updateListForDefinedThing: class ^self currentHelper updateListForDefinedThing: class
</methods> <methods> Tools.SimpleBrowserModule <category>templates</category>
templateBinding: nameSpace category: category ^'<1s> defineSharedVariable: #<2s> private: false constant: false category: <3p> initializer: ''Array new: 5''' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfBinding << #browser >> 'NameOfBinding' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
templateNameSpace: nameSpace category: category ^'<1s> defineNameSpace: #<2s> private: false imports: '' <3s>.* private Smalltalk.* '' category: <4p>' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfPool << #browser >> 'NameOfPool' with: #OtherNameSpace << #browser >> 'OtherNameSpace' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
</methods> <methods> Tools.SimpleBrowserModule <category>drag and drop</category>
addControllerDataTo: dict "Answer the initial state of the list when a drag has begun within its bounds. The state will be used to re-establish the appearance of the list when a drag leaves." | ctrl | ctrl := (self builder componentAt: #list) widget controller. dict at: #ctrl put: ctrl. dict at: #targetIndex put: ctrl view targetIndex. dict at: #hasFocus put: ctrl view hasFocus. ctrl view hasFocus: true. ^dict
canAcceptDropFrom: aDC "Answer true if a drop can occur in the category list of a normal browser. Only accept drops from the same application for now." aDC data contextApplication == self browser ifFalse:[^false]. ^self currentHelper canAcceptDropFrom: aDC
doDrag: aController "Ask the helper to do the drag" self currentHelper doDrag: aController
dragEnter: aDragContext ^self currentHelper dragEnter: aDragContext
dragLeave: aDragContext ^self currentHelper dragLeave: aDragContext
dragOver: aDragContext ^self currentHelper dragOver: aDragContext
drop: aDragContext "A drop has occurred in the category list of a normal brower. If the drop contained a class, move the class to the category targetted. If the drop contained a category, the user has aborted a category drag. Do nothing." ^self currentHelper drop: aDragContext " ^#dropEffectNone"
initialListDropState "Answer the initial state of the list when a drag has begun within its bounds. The state will be used to re-establish the appearance of the list when a drag leaves." | dict ctrl | ctrl := (self builder componentAt: #list) widget controller. dict := IdentityDictionary new. dict at: #ctrl put: ctrl. dict at: #targetIndex put: ctrl view targetIndex. dict at: #hasFocus put: ctrl view hasFocus. ctrl view hasFocus: true. ^dict
restoreListStateFrom: aDictionary "Reset the state of the list" | ctrl | ctrl := aDictionary at: #ctrl. ctrl view targetIndex: (aDictionary at: #targetIndex). ctrl view hasFocus: (aDictionary at: #hasFocus)
showDropFeedbackFor: aDragContext self showDropFeedbackForList: #list in: aDragContext
showDropFeedbackForList: aSymbol in: aDragContext "Track the mouse with the target index while dragging in the list named aSymbol." | wrap | wrap := self builder componentAt: aSymbol. wrap isNil ifFalse: [wrap widget showDropFeedbackIn: aDragContext allowScrolling: true]
wantToDrag: aController "ask the helper if he wants to drag" ^self currentHelper wantToDrag: aController
</methods> <methods> Tools.SimpleBrowserModule <category>interface opening</category>
postBuildWith: aBuilder self setVisualBlocksWith: aBuilder
</methods> <methods> Tools.SimpleBrowserModule <category>private</category>
changeRequest ^browser changeRequest
decorate: item ^self currentHelper decorate: item
doesNotUnderstand: aMessage ^aMessage arguments size = 0 ifTrue: [ self dispatch: aMessage selector ] ifFalse: [ aMessage arguments size = 1 ifTrue: [ self dispatch: aMessage selector with: aMessage arguments first ] ifFalse: [ super doesNotUnderstand: aMessage ] ].
enable: itemName on: menu menu == nil ifTrue: [^false]. menu menuItems do: [:it | it nameKey = itemName ifTrue: [it enable. self menu: it submenu do: [:i | i enable]. ^true]. (self enable: itemName on: it submenu) ifTrue: [it enable]]. ^false
fileEncoding ^browser fileEncoding
hardcopyStream: aStream Cursor wait showWhile: [aStream contents asComposedText hardcopy]
interfaceWindow ^browser interfaceWindow
listBrowserClass ^FullSystemBrowser
logProtocolChange: aString "Add aString, which is an executable account of the last protocol change (rename, remove, selector move) to the changes file." SourceFileManager default logChange: aString
menu: menu do: aBlock menu == nil ifTrue: [^self]. menu menuItems do: [:it | aBlock value: it. it submenu == nil ifFalse: [self menu: it submenu do: aBlock]]
methodCollector ^browser methodCollector
prompt: promptString initially: initialString "Prompt the user with the message question promptString, with initial answer initialString, and accept the answer either with the menu item accept or the keyboard press RETURN. Answer the string that the user provides." ^Dialog request: promptString initialAnswer: initialString for: self interfaceWindow
selectedVisualBlock "Supply the block that determins the appearance for selected list entries." ^[ :view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry value. aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label:= listEntry displayLabel: aText) attributes: view textStyle; offset: label offset. label:= ReversingWrapper on: label. label reverse setValue: true. BoundedWrapper on: label]
visualBlock "Supply the block that determins the appearance for unselected list entries." ^[:view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry value. aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label := listEntry displayLabel: aText) attributes: view textStyle; offset: label offset. BoundedWrapper on: label]
</methods> <methods> Tools.SimpleBrowserModule <category>private-list</category>
howManySelections ^self listSelectionIndexes size
listSelectionIndexes ^self allowsMultiSelect ifTrue: [list selectionIndexes] ifFalse: [list selectionIndex = 0 ifTrue: [Set new] ifFalse: [Set with: list selectionIndex]]
listSelectionIndexes: aSet ^self allowsMultiSelect ifTrue: [list selectionIndexes: aSet] ifFalse: [aSet size > 1 ifTrue: [self error: (#TooManySelections << #dialogs >> 'too many selections')]. list selectionIndex: (aSet size = 0 ifTrue: [0] ifFalse: [aSet asArray first])]
listSelections ^self allowsMultiSelect ifTrue: [list selections] ifFalse: [list selectionIndex = 0 ifTrue: [OrderedCollection new] ifFalse: [OrderedCollection with: list selection]]
</methods> <methods> Tools.SimpleBrowserModule <category>private-emphasis</category>
setVisualBlocksWith: aBuilder "Set visual blocks to be used to determine the emphassis for list entries. Default implementation is to set-up the selected and unselected visual blocks." | component | (component := aBuilder componentAt: #list) isNil ifTrue: [^self]. component widget visualBlock: self visualBlock; selectedVisualBlock: self selectedVisualBlock
textEmphasisForItem: anItem ^self currentHelper textEmphasisForItem: anItem
textForItem: aListEntry ^self currentHelper textForItem: aListEntry
</methods> <methods> Tools.SimpleBrowserModule <category>release</category>
release super release. list selectionIndexHolder removeDependent: self. list selectionIndexHolder retractInterestsFor: self. list list:#(). self cachedComponents notNil ifTrue: [ self cachedComponents do: [ :ea | ea release ] ]. self browser: nil.
</methods> <methods> Tools.SimpleBrowserModule <category>validating</category>
currentSubCanvas ^self
</methods> <methods> Tools.SimpleBrowserModule <category>updating</category>
updateForSwapOut
</methods> <methods> Tools.SimpleBrowserModule class <category>interface specs</category>
preferredSpec ^self listSpec
preferredSpecName ^#listSpec
</methods> <methods> Tools.SimpleBrowserModule class <category>instance creation</category>
multiSelect "Answer an instance of the receiver set to multiple selection." ^self basicNew allowsMultiSelect: true; initialize; yourself.
singleSelect "Answer an instance of the receiver set to single selection." ^self basicNew allowsMultiSelect: false; initialize; yourself.
</methods> <methods> Tools.HierarchicalBrowserModule <category>accessing</category>
allowsMultiSelect ^false
defaultSpecName ^#listSpec
</methods> <methods> Tools.HierarchicalBrowserModule <category>list accessing</category>
currentNodeSelection ^list currentNodeSelection
selection: aValue self allowsMultiSelect ifTrue: [self list selections: (Set with: ( aValue))] ifFalse: [ self list selection: ( aValue)]
setNewList: newList | decoratedList | decoratedList := newList. list setTree: decoratedList selecting: (selectionCandidates == nil ifTrue: [list selection] ifFalse: [selectionCandidates asArray first]) childAccessor: #sortedChildren childNameAccessor: #key. self checkVisibility
setNewListSilently: aList | newlist | newlist := aList. list selectionIndexHolder retractInterestsFor: self. list setTree: newlist selecting: (selectionCandidates == nil ifTrue: [list selection] ifFalse: [selectionCandidates asArray first]) childAccessor: #sortedChildren childNameAccessor: #key. self checkVisibility. list selectionIndexHolder onChangeSend: #selectionChanged to: self. ^self
</methods> <methods> Tools.HierarchicalBrowserModule <category>actions</category>
doubleClick "Expand/collapse the current selection." self list toggleCurrent
setPresetWidthTo: anInteger self builder isNil ifTrue:[^self]. (self builder componentAt: #list ) widget presetWidth: anInteger
spawnBrowser "Since this is a hierachy check first to see if we have some thing selected that is spawnable. Trigger the 'spawn' action, via a double-click. If there are more than one types of spawning, this may not necessarily be the same as the 'spawn' menu item." " self halt." self selection isSymbol ifTrue:[self list toggleCurrent ]. self spawn
</methods> <methods> Tools.HierarchicalBrowserModule <category>copying</category>
postCopy | old | super postCopy. builder := browser := nextModule := nil. helpers := helpers collect: [:i | i copy module: self]. old := list. list := IndentedTreeSelectionInList new. list list: old list copy. self allowsMultiSelect ifTrue: [list selectionIndexes: old selectionIndexes copy] ifFalse: [list selectionIndex: old selectionIndex]. list selectionIndexHolder onChangeSend: #selectionChanged to: self.
</methods> <methods> Tools.HierarchicalBrowserModule <category>testing</category>
testChangeSelection: controller self changeRequest ifFalse: [^false]. nextModule == nil ifTrue: [self list selectionIndexes: Set new] ifFalse: [nextModule list selectionIndexes: Set new]. ^true
</methods> <methods> Tools.HierarchicalBrowserModule <category>private</category>
selectedVisualBlock "Supply the block that determins the appearance for selected list entries." ^[ :view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry . aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label:= Label with: listEntry ) attributes: view textStyle; offset: label offset. label:= ReversingWrapper on: label. label reverse setValue: true. BoundedWrapper on: label]
visualBlock "Supply the block that determins the appearance for unselected list entries." ^[:view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry . aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label := Label with: listEntry ) attributes: view textStyle; offset: label offset. BoundedWrapper on: label]
</methods> <methods> Tools.HierarchicalBrowserModule <category>initialize</category>
initialize list := IndentedTreeSelectionInList newEmptyInstance. " list := self allowsMultiSelect ifTrue: [MultiSelectionInList new] ifFalse: [SelectionInList new]." list selectionIndexHolder onChangeSend: #selectionChanged to: self. specName := self defaultSpecName
</methods> <methods> Tools.HierarchicalBrowserModule <category>release</category>
release self breakDependents. self releaseEventTable list selectionIndexHolder removeDependent: self. list selectionIndexHolder retractInterestsFor: self. self cachedComponents notNil ifTrue: [ self cachedComponents do: [ :ea | ea release ] ]. self browser: nil.
</methods> <methods> Tools.HierarchicalBrowserModule <category>private-emphasis</category>
postBuildWith: aBuilder super postBuildWith: aBuilder. self setPresetWidthTo: 500
</methods> <methods> Tools.MethodListBrowserHelper <category>initialize</category>
baseList: aList baseList := aList
initialSelection: aString initialSelection := aString
label: aLabel label := aLabel
</methods> <methods> Tools.MethodListBrowserHelper <category>accessing</category>
windowLabel ^label == nil ifTrue: [(#Methods << #dialogs >> 'Methods')] ifFalse: [label]
</methods> <methods> Tools.MethodListBrowserHelper <category>list accessing</category>
definitionOf: anItem ^anItem
updateListFull baseList := baseList select: [:md | md isBindingReference ifTrue:[true] ifFalse:[md method notNil]]. module setNewList: (List withAll: baseList)
</methods> <methods> Tools.MethodListBrowserHelper <category>text processing</category>
acceptText: text from: textController | selection newSelector newMethod | (selection := self selection) isBindingReference ifTrue: [^nil]. selection isNil ifTrue: [Dialog warn: (#SelectMethodAsExampleForNewMethod << #dialogs >> 'Select a method first. The new method will belong to the same class and protocol as the selected one.'). textController textHasChanged: true. ^false]. newSelector := selection implementingClass compile: text classified: selection protocol notifying: textController. newSelector == nil ifTrue: [^false]. newMethod := MethodDefinition class: selection implementingClass selector: newSelector. (baseList includes: newMethod) ifFalse: [baseList add: newMethod]. module select: newMethod whenFinished: [module updateList]. ^true
</methods> <methods> Tools.MethodListBrowserHelper <category>private</category>
initialSelection ^initialSelection
</methods> <methods> Tools.MethodListBrowserHelper <category>actions</category>
remove "Override to remember the nearest selection" | indices listSize max min choice result | indices := module listSelectionIndexes. listSize := module list list size. (indices isEmpty or: [indices size = listSize]) ifTrue: [^super remove]. indices := indices asSortedCollection. min := indices first. max := indices last. choice := max - min + 1 > indices size "must be an interior unselected element, use the first one as the next selection" ifTrue: [| priorEntries interior | priorEntries := 0. "Count of how many selections before the first interior unselected element" interior := (min to: max) detect: [:n| priorEntries := priorEntries + 1. (indices at: n - min + 1) ~= n]. interior - priorEntries] ifFalse: [max < listSize ifTrue: [min] "after removals min is the index of the entry after last selection" ifFalse: [min - 1]]. "no entries after last; choose one before first removal" (result := super remove) ifTrue: [module listSelectionIndexes: (Set with: choice)]. ^result
</methods> <methods> Tools.MethodListBrowserHelper <category>selections</category>
targetClass "Answer the browsers currently selected class." ^self selection implementingClass
targetClassOrNameSpace "Answer the browsers currently selected class, namespace or classes namespace." ^self selection isBindingReference ifTrue: [ self selection environment asNameSpace ] ifFalse: [ self targetClass ]
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>accessing</category>
searchChildNamespaces ^searchChildNamespaces isNil ifTrue:[searchChildNamespaces := false] ifFalse:[ searchChildNamespaces]
searchChildNamespaces: aBooleen searchChildNamespaces := aBooleen
selectCategory: categoryName module select: categoryName asSymbol whenFinished: [module updateList]
windowLabel ^module hasList ifTrue: [(#SystemBrowserOn << #labels >> 'System Browser on <1p>') expandMacrosWith: self environment] ifFalse: [(#CategoryBrowserOn1pIn2p << #labels >> 'Category Browser on <1p> in <2p>') expandMacrosWith: self selection with: self environment]
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#(#fileOut #hardcopy #add #remove #findClass)
actionsForNoSelect ^#(#add #findClass)
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>list accessing</category>
generateList ^self searchChildNamespaces ifTrue: [self allOrganizations] ifFalse: [self environment organization categories asList]
selectionChanged module nextModule == nil ifTrue: [^super selectionChanged]. self setSelection. self browser updateWindowLabel. self browser batchUpdates: [module nextModule updateList. module list list isEmpty ifTrue: [self broadcastUpdate: #classOrNameSpace->self environment]]
updateListFull | newList | newList := self environment == nil ifTrue: [self allOrganizations] ifFalse: [self generateList]. module setNewList: newList
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>actions</category>
addCategory "Prompt the user for a new category name. Insert the category into the class organization before the currently selected category." | newCategory indx env list association | self changeRequest ifFalse: [ ^self ]. list := (searchChildNamespaces ifTrue: [self environment withAllNameSpaces asSortedCollection: [:n1 :n2 | n1 name < n2 name]] ifFalse: [List with: self environment]). (association := SmalltalkWorkbench promptForCategoryAndNamespace: list from: self browser builder window) isNil ifTrue: [^self]. newCategory := association key. env := association value. env organization addCategory: newCategory before: self selection. env reorganize. indx := module selectionIndex. indx == nil ifTrue: [module list list add: (self decorate: newCategory)] ifFalse: [module list list add: (self decorate: newCategory) beforeIndex: indx]. module select: newCategory whenFinished: [module updateList].
broadcastUpdate: aspect aspect key == #category ifTrue: [ module hasList ifTrue: [module select: aspect value whenFinished: [module updateList]] ifFalse: [module forceSelection: aspect value. self setSelection: aspect value. "module nextModule secondaryObject: aspect value" ] ] ifFalse: [super broadcastUpdate: aspect]
fileOut | fileName fileManager nm | nm := self selection == nil ifTrue: [(#Definitions << #dialogs >> 'Definitions') asString] ifFalse: [module selection asString]. fileName := Dialog requestNewFileName: (#fileOutOn << #dialogs >> 'File out on') default: (Filename filterFilename: nm, '.st'). fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [fileManager timeStamp. fileManager deferInitializations. self selectedThingsWithOrder: [:definedObjects | definedObjects do: [:thing | thing fileOutSourceOn: fileManager. fileManager cr]]. fileManager finishInitializations. fileManager cr] ensure: [fileManager close].
findClass "Prompt for a class and position myself there." | obj | obj := self findASomething: (#FindClassColon << #dialogs >> 'Find class:'). obj == nil ifTrue: [^self]. self changeRequest ifFalse: [^self]. self browser setAndUpdateEnvironment: obj environment. obj isBindingReference ifTrue: [self browser batchUpdates: [self browser metaShowData. self browser selectCategory: obj environment category. self browser selectBehavior: obj environment. self browser selectProtocol: (obj environment asNameSpace categoryFor: obj name). self browser selectMethod: obj name]] ifFalse: [module select: obj category whenFinished: [module nextModule select: obj whenFinished: [module updateList]]]
hardcopy "Print the category." | stream lastItemWasBig first | stream := TextStream on: (String new: 1000). lastItemWasBig := false. first := true. self selectedThingsWithOrder: [:definedObjects | definedObjects do: [:thing || newItemIsBig | newItemIsBig := thing isBindingReference not. (first not and: [lastItemWasBig or: [newItemIsBig]]) ifTrue: [stream nextPut: Character newPage]. lastItemWasBig := newItemIsBig. first := false. thing printOutOn: stream. stream cr; cr]]. self hardcopyStream: stream
remove self changeRequest ifFalse: [^self]. self selectedThingsWithOrder: [:definedObjects | definedObjects size = 0 ifFalse: [(Dialog confirm: (#AreYouCertainRemoveAllDefinitionsInThisCategoryQ << #dialogs >> 'Are you certain that you want to remove all definitions in this category?') for: self interfaceWindow) ifFalse: [^self]. definedObjects reverseDo: [:thing | thing removeFromSystem]]]. self selections do: [ :category | ( self environmentsForCategory: category ) do: [ :env | env organization removeCategory: category. env reorganize ] ]. module listSelectionIndexes asSortedCollection reverseDo: [ :index | module list list removeAtIndex: index ]. module deselect
rename | aString newCategory envlist changed | self changeRequest ifFalse: [^self]. aString := self prompt: (#EnterNewCategoryName << #dialogs >> 'Enter new category name') initially: self selection. aString isEmpty ifTrue: [^self]. newCategory := aString asSymbol. (envlist := self environmentsForCategory: self selection) == nil ifTrue: [^self]. changed := false. envlist do: [:env | (env renameCategory: self selection to: newCategory) ifTrue: [changed := true]]. changed ifTrue: [module list list at: module list selectionIndexes asArray first put: (self decorate: newCategory). self browser updateText]
spawn | envlist | ( envlist := self environmentsForCategory: self selection ) == nil ifTrue: [ ^self ]. envlist isEmpty ifTrue: [ ^self ]. envlist do: [ :env | self browser spawnOnNameSpaces: env category: self selection ].
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>templates</category>
templateBinding: nameSpace category: category ^'<1s> defineSharedVariable: #<2s> private: false constant: false category: <3p> initializer: ''Array new: 5''' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfBinding << #browser >> 'NameOfBinding' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
templateClass: nameSpace category: category type: type ^'<1p> defineClass: #<2s> superclass: #{<3s>} indexedType: #<4s> private: false instanceVariableNames: ''<5s>'' classInstanceVariableNames: '''' imports: '''' category: <6p>' expandMacrosWithArguments: (OrderedCollection new add: (nameSpace namedReferent unambiguousName); add: #NameOfClass << #browser >> 'NameOfClass'; add: #NameOfSuperclass << #browser >> 'NameOfSuperclass'; add: type; add: (type == #bytes ifTrue: [''] ifFalse: [(#instVarName1InstVarName2 << #browser >> 'instVarName1 instVarName2')]); add: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString]); yourself)
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>text processing</category>
acceptText: text from: textController "Indicate that we didn't even try." ^self selection == nil ifTrue: [nil] ifFalse: [self acceptDefinition: text from: textController]
doItEnvironment ^self environment
explainerClass ^nil
text ^self selection == nil ifTrue: [self selections isEmpty ifTrue: [nil] ifFalse: [Text new]] ifFalse: [self browser meta value == #data ifTrue: [self templateBinding: self environment category: self selection] ifFalse: [self templateClass: self environment category: self selection type: #none]]
updateListForDefinedThing: class module nextModule updateListForDefinedThing: class
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>private</category>
allOrganizations | list env | list := IdentitySet new: 400. env := self environment isNil ifTrue: [Root] ifFalse: [self environment]. list addAll: env organization categories. env withAllNameSpaces do: [:nameSpace | nameSpace bindingsDo: [:i | i isForClass ifTrue: [list add: i value category]]]. self selection notNil ifTrue: [list add: self selection]. ^list asSortedCollection asList
environmentsForCategory: aCategory "Answer all of the environments for aCategory." | env | env := self environment. env == nil ifTrue: [ env := Root ]. searchChildNamespaces ifFalse: [ ^Array with: env ]. ^env withAllNameSpaces select: [ :ns | ns organization categories includes: aCategory ].
pickAClass: prompt "Choose a class or global name with a prompter." "Prompt the user for a name or pattern. Answer an empty string if that's what the user returned. Answer the class, if there is only one class that matches. If there is more than one class match, prompt the user with a choice of matches, and return the class selected or an empty string. If there are no class matches, answer the first global name that matches, or nil if there are none." | destClassName classes | destClassName := Dialog request: prompt for: self interfaceWindow. destClassName = '' ifTrue: [^'']. classes := OrderedCollection new. Cursor execute showWhile: [classes := self environment keys select: [ :cn | destClassName match: cn]]. classes := classes asSortedCollection. (classes == nil or: [classes size = 0]) ifTrue: [^nil] ifFalse: [classes size = 1 ifTrue: [destClassName := classes first] ifFalse: [destClassName := Dialog choose: (#ChooseAClass << #dialogs >> 'Choose a class') fromList: classes values: classes lines: 10 cancel: [^''] for: self interfaceWindow]]. ^destClassName
selectedNamesDo: aBlock "For every selected category, within every visible namespace, evaluate aBlock with the name & environment." self selections do: [ :category | ( self environmentsForCategory: category ) do: [ :env | ( env organization listAtCategoryNamed: category ) do: [ :key | aBlock value: key value: env ]. ] ].
selectedThingsWithOrder: aBlock | things | things := OrderedCollection new. module selections do: [ :category | ( self environmentsForCategory: category ) do: [ :env | ( env organization listAtCategoryNamed: category ) do: [ :key | | thing | thing := env bindingFor: key. thing := thing isForGeneral ifTrue: [BindingReference simpleName: key in: env] ifFalse: [thing value]. things add: thing ] ] ]. things := SystemUtils sortForLoading: things. aBlock value: things
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#category
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper <category>drag and drop</category>
addClientDataTo: anIdentityDict self hasSelections ifFalse: [^false]. anIdentityDict at: #category put: self selection. anIdentityDict at: #environment put: self environment. ^true
canAcceptDropFrom: aDC ^aDC key == self classOrNamespaceKey or: [ aDC key == self selectorOrStaticKey]
drop: aDragContext "A drop has occured in the category list of the browser. see if we can accept and if so move the class(es)." | ctrl idx cNameArray | (self canAcceptDropFrom: aDragContext) ifFalse:[^#dragEffectNone ]. self browser changeRequest ifFalse: [^#dropEffectNone]. "Locate the target category's index" ctrl := aDragContext clientData at: #ctrl. idx := ctrl view targetIndex. idx = 0 ifTrue: [^#dropEffectNone]. "If the data is not available in the correct format, do not drop." cNameArray := aDragContext sourceData clientData at: self classOrNamespaceKey ifAbsent: [^#dropEffectNone]. "Move the class or namspace to the new category" "The class name is in the clientData of the dropSource" cNameArray do:[:eachCName | eachCName environment classifySymbol: eachCName name under: (self module list list at: idx) value. ChangeSet changeClass: eachCName ]. "Restore the state of the list before leaving." self restoreListStateFrom: aDragContext clientData. aDragContext clientData: nil. self nextModule updateList. ^#dropEffectMove
getDragDropKey "return the data key for the drag" ^self categoryKey
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Category << #menus >> '&Category') asString
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>emphasis</category>
textEmphasisForItem: anItem ^self emphasizer emphasisForCategory: anItem in: self environment for: self browser id: self selectionId
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>menus accessing</category>
getListMenu: forMenuBar | parcels manager | parcels := IdentitySet new: 16. manager := self browser manager. self selections do: [ :selection | | parcelsOrNil | parcelsOrNil := manager parcelsForClassOrNameSpace: selection. nil == parcelsOrNil ifFalse: [ parcels addAll: parcelsOrNil ] ]. ^self browser addParceling: parcels to: ( super getListMenu: forMenuBar ) forHelper: self
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>private</category>
filter: allCategoriesList | env mgr browser currentParcel usedCategories filteredCategories orgCollection findBindingBlock | env := self environment isNil ifTrue:[Root] ifFalse:[self environment ]. orgCollection := OrderedCollection new: 100. self searchChildNamespaces ifTrue: [ env allNameSpaces do:[:each | orgCollection add: each organization]] ifFalse:[orgCollection add: env organization ]. findBindingBlock := [:aSymbol | | class | class := env at: aSymbol ifAbsent: nil. class isNil ifFalse:[ env allNameSpaces detect:[:each | | cls| cls := env at: aSymbol ifAbsent: nil. cls isNil ifFalse:[ class := cls. true] ifTrue:[false]] ifNone:[false]]]. mgr := (browser := self browser) manager. currentParcel := self selectedParcel. browser isUnparceledFilterOn ifTrue: [ filteredCategories := OrderedCollection new: 500. orgCollection do:[:eachOrg | filteredCategories addAll: (allCategoriesList select: [:cat| (eachOrg listAtCategoryNamed: cat) contains: [:cn| browser isUnparceledCodeInClass: (findBindingBlock value: cn) currentParcel: currentParcel]])]. ^filteredCategories ]. browser isParcelFilterOn ifFalse: [^allCategoriesList]. browser isConflictsFilterOn ifTrue: [| conflicts | conflicts := (browser computeConflictsFor: mgr multiplyParcelledThings within: (currentParcel notNil ifTrue: [Array with: currentParcel])) last. usedCategories := conflicts collect: [:class| class category]. ^allCategoriesList select: [:cat| usedCategories includes: cat]]. currentParcel == nil ifTrue: [ filteredCategories := OrderedCollection new: 500. orgCollection do:[:eachOrg | filteredCategories addAll: (allCategoriesList select: [:cat| (eachOrg listAtCategoryNamed: cat) contains: [:cn| (mgr parcelsForClassOrNameSpace: (findBindingBlock value: cn)) size > 0]])]. ^filteredCategories]. usedCategories := IdentitySet new. usedCategories addAll: currentParcel definedClasses; addAll: currentParcel extendedClasses. usedCategories := usedCategories collect: [:class| class category]. ^allCategoriesList select: [:categorySymbol | usedCategories includes: categorySymbol]
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>list accessing</category>
updateListFull | newList | newList := self environment == nil ifTrue: [List new] ifFalse: [self generateList]. module setNewList: (self filter: newList)
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>accessing</category>
selectCategory: categoryName module select: categoryName asSymbol whenFinished: ["module updateList"]
</methods> <methods> Tools.ParcelNameSpaceOrganizerBrowserHelper <category>actions</category>
addSelectionToParcel | currentParcel | self changeRequest ifFalse: [ ^self ]. self browser saveParcelsForUndo. currentParcel := self currentParcel. self selectedNamesDo: [ :name :env | | obj | ( obj := env at: name ) isForClass ifTrue: [ currentParcel addEntiretyOfClass: obj ] ifFalse: [ currentParcel addNameSpace: obj ] ]. self browser updateLists
moveSelectionToParcel: aParcel "Move the selected category into theParcel according to the current parcel and filtering." self changeRequest ifFalse: [ ^self ]. self browser saveParcelsForUndo. self selectedNamesDo: [ :name :env | | obj | ( obj := env at: name ) isForClass ifTrue: [ aParcel addEntiretyOfClass: obj ] ifFalse: [ aParcel addNameSpace: obj ] ]. self browser updateLists.
removeSelectionFromParcel | currentParcel | self changeRequest ifFalse: [ ^self ]. self browser saveParcelsForUndo. currentParcel := self currentParcel. self selectedNamesDo: [ :name :env | | obj | ( obj := env at: name ) isForClass ifTrue: [ currentParcel removeEntiretyOfClass: obj ] ifFalse: [ currentParcel removeNameSpace: obj ] ]. self browser updateLists
</methods> <methods> Tools.DebugContextsBrowserHelper <category>text processing</category>
acceptText: aText from: aController "Recompile the method of the selected context." | classOfMethod newSelector newMethod context selector | context := self selection. context == nil ifTrue: [^ false]. selector := (self definitionOf: context) selector. classOfMethod := context mclass. newSelector := classOfMethod parserClass new parseSelector: aText. newSelector ~~ selector ifTrue: [self notify: (#SelectorMustNotChange << #dialogs >> 'selector must not change')]. Cursor execute showWhile: [newSelector := classOfMethod compile: aText classified: ClassOrganizer defaultProtocol notifying: aController]. newSelector == nil ifTrue: [^ false]. Cursor execute showWhile: [newMethod := classOfMethod compiledMethodAt: newSelector. self replaceContext: context forSelector: newSelector class: classOfMethod]. ^ true
replaceContext: context forSelector: selector class: aClass | newMethod newContext pHandle | pHandle := self browser processHandle. newMethod := aClass compiledMethodAt: selector. newContext := self homeContext: context. pHandle cutbackTo: newContext. newContext := newContext resizedWith: newMethod. pHandle topContext: newContext. pHandle interrupted: true. module select: newContext whenFinished: [ module updateList ].
</methods> <methods> Tools.DebugContextsBrowserHelper <category>menus accessing</category>
actionsForNoSelect ^#(#moreStack #proceed #copyStack)
getListMenu: forMenuBar | menu | menu := super getListMenu: forMenuBar. (menu atNameKey: #moreStack) enabled: self showsEverything not. ^menu
</methods> <methods> Tools.DebugContextsBrowserHelper <category>actions</category>
copyStack ^self browser copyStack
moreStack "If showing a short stack, expand the stack to include twice as many contexts." self showsEverything ifFalse: [stackSize := stackSize * 2]. module updateList
proceed ^self browser proceed
restart ^self browser restart
send ^self browser send
skipToCaret ^self browser skipToCaret
step ^self browser step
</methods> <methods> Tools.DebugContextsBrowserHelper <category>testing</category>
isTopContextSelected ^module list selectionIndex = 1
showsEverything ^stackSize = SmallInteger maxVal
</methods> <methods> Tools.DebugContextsBrowserHelper <category>initialize</category>
initialize super initialize. stackSize := 50
</methods> <methods> Tools.DebugContextsBrowserHelper <category>list accessing</category>
updateListFull | ctxts c n | self browser processHandle == nil ifTrue: [^module setNewList: List new]. ctxts := List new: 100. c := self browser processHandle topContext. n := 0. [c == nil or: [(n := n+1) > stackSize]] whileFalse: [ctxts add: c. c := c sender]. c == nil ifTrue: [stackSize := SmallInteger maxVal]. module setNewList: ctxts
</methods> <methods> Tools.DebugContextsBrowserHelper <category>private</category>
definitionOf: aContext ^ContextDefinition new context: aContext
homeContext: context | method ctx | context isBlockContext ifTrue: [method := context method homeMethod. ctx := context sender. [ctx == nil] whileFalse: [ctx method == method ifTrue: [^ctx]. ctx := ctx sender]. self error: (#BlockHomeNotOnStack << #dialogs >> 'Unable to restart: block''s home context not on the current process''s stack.')]. ^context
</methods> <methods> Tools.DebugContextsBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#context
</methods> <methods> Tools.DebugContextsBrowserHelper class <category>resources</category>
listMenu | menu | menu := self baseListMenu. (menu atNameKey: #send) enablementSelector: #isTopContextSelected. ^menu
</methods> <methods> Tools.DebugContextsBrowserHelper class <category>menus accessing</category>
listMenuName ^#contextMenu
menuHeader ^(#_Debug << #menus >> '&Debug') asString
</methods> <methods> Tools.SelectorBrowserHelper <category>accessing</category>
proposedWindowLabel | writeStream | self selection isNil ifFalse: [^(#Ip2sMessageBrowser << #dialogs >> '<1p>>><2s> Message Browser') expandMacrosWith: self selectedClassOrNameSpace with: self selection]. writeStream := (String new: 30) writeStream. self protocols do: [:protocol | writeStream nextPutAll: protocol; space]. ^(#Ip2sMessageCategoryBrowser << #dialogs >> '<1p> {<2s>} Message Category Browser') expandMacrosWith: self selectedClassOrNameSpace with: writeStream contents
protocols "This replaces #protocol from the older code now that multiple selection is supported. It answers a collection of selected protocols, or an empty collection; never nil. The original #protocol is obsolete and its use is discouraged." | protocols | protocols := self selected: #protocol. ^protocols isNil ifTrue: [#()] ifFalse: [protocols]
windowLabel | stream | stream := String new writeStream. self protocols do: [ :p | stream nextPutAll: p ] separatedBy: [ stream nextPutAll: ', ' ]. ^(#Ip2sMessageCategoryBrowser << #dialogs >> '<1p> {<2s>} Message Category Browser') expandMacrosWith: self selectedClassOrNameSpace with: stream contents
</methods> <methods> Tools.SelectorBrowserHelper <category>list accessing</category>
definitionOf: anItem | target | target := self selectedClassOrNameSpace. target == nil ifTrue: [ ^nil ]. ^( self isData or: [ target isForNameSpace ] ) ifTrue: [ BindingReference simpleName: anItem in: target ] ifFalse: [ MethodDefinition class: target selector: anItem ]
updateListFull | protocolList target newList | protocolList := self protocols. target := self targetClassOrNameSpace. (target isNil or: [protocolList isNil or: [protocolList isEmpty]]) ifTrue: [^module setNewList: List new]. newList := (target organization listAtCategoriesNamed: protocolList) asSortedCollection. target isForNameSpace ifTrue: [ newList := newList select: [ :key | ( target bindingFor: key ) isForGeneral ] ]. module setNewList: newList asList
</methods> <methods> Tools.SelectorBrowserHelper <category>text processing</category>
acceptTextForData: text from: textController ^Compiler evaluate: text notifying: textController logged: true
acceptTextForMethod: text from: textController "If more than one protocol is selected, guess the one to use as follows: if there is a selector selected, put the new method in the same protocol, else ask the user. This preserves the protocol of already existing methods." | protocol | self protocols size = 0 ifTrue: [protocol := nil]. self protocols size = 1 ifTrue: [protocol := self protocols first]. self protocols size > 1 ifTrue: [protocol := self targetClassOrNameSpace organization categoryOfElement: self selector. protocol isNil ifTrue: [protocol := Dialog choose: (#PutMethodInColon << #dialogs >> 'Put the method in:') fromList: self protocols values: self protocols lines: 8 cancel: [^nil]]]. ^self targetClass compile: text classified: protocol notifying: textController.
</methods> <methods> Tools.SelectorBrowserHelper <category>obsolete</category>
protocol "This method was used to return the selected protocol or nil. Now that multiple selection of protocols is allowed, it is being sunset in favour of #protocols. Ideally, all users of this method should switch to using #protocols. For now, it is here to prevent things from breaking but it returns only the first selected protocol." | protocols | protocols := self protocols. ^protocols isEmpty ifTrue: [nil] ifFalse: [protocols first]
</methods> <methods> Tools.BrowserTabApplication <category>components</category>
windowLabel ^components isEmpty ifTrue: [(#FullBrowser << #labels >> 'Full Browser')] ifFalse: [components first windowLabel]
</methods> <methods> Tools.BrowserTabApplication <category>accessing subcanvases</category>
getCanvas self subclassResponsibility
</methods> <methods> Tools.BrowserTabApplication <category>release</category>
release canvas == nil ifFalse: [ self canvas release ]. self components do:[:each | each release].
</methods> <methods> Tools.BrowserTabApplication <category>initialize</category>
initialize self buildComponentArray.
initializeForClass: aClass self subclassResponsibility
initializeForClassHierarchy: aClass self subclassResponsibility
initializeForMethodsLabel: labelString list: aCollection initialSelection: selector self subclassResponsibility
initializeForNameSpace: aNameSpace self subclassResponsibility
initializeForNameSpaces self subclassResponsibility
initializeForNameSpaces: aNameSpace category: aCategory self subclassResponsibility
initializeNull components := #() copy
</methods> <methods> Tools.BrowserTabApplication <category>componentBuilding</category>
buildComponentArray self buildComponentList. self setComponentIds: components. self linkComponentsInArray: components. self linkFirstComponentToSubcanvas.
buildComponentList components := List new. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent.
categoriesComponent self subclassResponsibility
classesComponent self subclassResponsibility
componentId ^#default
protocolsComponent self subclassResponsibility
selectorsComponent self subclassResponsibility
setComponentIds components do: [ :comp | comp helpers do: [ :h | h selectionId: self componentId ] ]
setComponentIds: aComponentList aComponentList do: [ :comp | comp helpers do: [ :h | h selectionId: self componentId ] ]
</methods> <methods> Tools.BrowserTabApplication <category>menus</category>
buildToolBar: aMenu canvas buildToolBar: aMenu. self components do: [ :comp | comp buildToolBar: aMenu ]
buildViewMenu: aMenu canvas buildViewMenu: aMenu. self components do: [ :comp | comp buildViewMenu: aMenu ]
</methods> <methods> Tools.BrowserTabApplication <category>spawning</category>
spawnForMethodsLabel: aLabel list: list initialSelection: selection with: aTabApplication TabApplicationSystemBrowser initializeForMethodsLabel: aLabel list: list initialSelection: selection with: NamespaceTabApplication
spawnOnClass: aClass with: aTabApplication TabApplicationSystemBrowser openOnClass: aClass with: NamespaceTabApplication
spawnOnClass: aClass with: aTabApplication protocol: aSelection TabApplicationSystemBrowser openOnClass: aClass with: NamespaceTabApplication protocol: aSelection
spawnOnClassHierarchy: aClass TabApplicationSystemBrowser openOnClassHierarchy: aClass with: NamespaceTabApplication
spawnOnClassHierarchy: aClass with: aTabApplication TabApplicationSystemBrowser openOnClassHierarchy: aClass with: NamespaceTabApplication
spawnOnNameSpace: aNamespace with: aTabApplication TabApplicationSystemBrowser openOnNameSpace: aNamespace with: NamespaceTabApplication
spawnOnNameSpace: aNamespace with: aTabApplication category: aCategory TabApplicationSystemBrowser openOnNameSpace: aNamespace with: NamespaceTabApplication on: aCategory
</methods> <methods> Tools.BrowserTabApplication <category>private</category>
eraseBackgroundOnImage: anImage | pix im2 imageMask sourceImage | "inactiveMasks := masks := nil." " rule result 0 0 1 D bitAnd: S 2 D bitInvert bitAnd: S 3 S 4 D bitAnd: S bitInvert 5 D 6 D bitXor: S 7 D bitOr: S 8 D bitInvert bitAnd: S bitInvert 9 D bitXor: S bitInvert <----- This is the rule we use to get the resulting interiror figure 10 D bitInvert 11 D bitInvert bitOr: S 12 S bitInvert 13 D bitOr: S bitInvert 14 D bitInvert bitOr: S bitInvert 15 1 " imageMask := nil. " imageMask := self masks at: anImage hash ifAbsent: [nil]." " we have precomputed masks so we don't have to do this all the time" "The mask is in the shape of the figure so the rest can be the back ground color" imageMask == nil ifTrue: [sourceImage := anImage asImage. pix := sourceImage atPoint: 0@0. "Take the Pixel at 0@0 as the one you want to be the background sourounding the figure" imageMask := Image extent: sourceImage extent depth: 1 palette: CoveragePalette monoMaskPalette. "find and write the interiror shape" 0 to: sourceImage width-1 do: [:x | 0 to: sourceImage height-1 do: [:y | (sourceImage atPoint: x@y) = pix ifFalse: [imageMask atPoint: x@y put: 1]]]. "get the exteriror mess" im2 := imageMask filledShapeAround: 0@0. "now combine the two according to rule 9 the D bitXor: S bitInvert" imageMask copy: imageMask bounds from: 0@0 in: im2 rule: 9. imageMask := CachedImage on: imageMask. "self masks at: anImage hash put: imageMask"]. " self inactiveMasks at: anImage hash ifAbsent: [self inactiveMasks at: anImage hash put: (self masks at: anImage hash)]." "Return the neat class the knows how to display himself with the background left untouched according to the mask we just built" "^OpaqueImageWithEnablement figure: anImage shape: imageMask inactiveMask: (self inactiveMasks at: anImage hash)." ^OpaqueImageWithEnablement figure: anImage shape: imageMask inactiveMask: (imageMask).
linkComponentsInArray: aCollection 1 to: aCollection size - 1 do: [:i | (aCollection at: i) browser: self browser; nextModule: (aCollection at: i + 1)]. aCollection last browser: self browser. self browser currentTabApplication: self. aCollection first intializeListFull
linkFirstComponentToSubcanvas self canvas browser: self browser. self canvas nextModule: self components first. " self canvas updateList."
</methods> <methods> Tools.BrowserTabApplication <category>accessing</category>
blankCategoryCanvas ^blankCategoryCanvas isNil ifTrue:[blankCategoryCanvas := BlankUI new] ifFalse:[blankCategoryCanvas ]
browser ^browser
browser: aBrowser browser := aBrowser
canvas ^canvas isNil ifTrue:[canvas := self getCanvas] ifFalse:[canvas]
categoriesLabel ^(#NoCategories << #labels >> 'No Categories')
categoryIcon ^categoryIcon isNil ifTrue:[ categoryIcon := self eraseBackgroundOnImage: self class categoryIcon] ifFalse:[categoryIcon ]
components components == nil ifTrue:[ self buildComponentArray ]. ^components
defaultEmphasizer ^Emphasizer new.
emphasizer emphasizer == nil ifTrue: [emphasizer := self defaultEmphasizer]. ^emphasizer
emphasizer: anEmphasizer emphasizer := anEmphasizer
icon ^icon isNil ifTrue:[ icon := self class blankIcon] ifFalse:[icon ]
indexOfCategoryCanvas " I am defauling this to 0 so teamworks code will run on entry. 0 means there is no categories component" ^indexOfCategoryCanvas isNil ifTrue:[ indexOfCategoryCanvas := 0] ifFalse:[indexOfCategoryCanvas ]
indexOfCategoryCanvas: aNumber "index in the compnents array of the categories subcanvas" indexOfCategoryCanvas:= aNumber
label ^self class label
rightHandComponents ^components copyFrom: 2 to: components size
subCanvasSpec ^canvas listSpec "^#listSpec"
systemBrowserComponents ^self components
</methods> <methods> Tools.BrowserTabApplication <category>updating</category>
intializeListFull self canvas intializeListFull. ^self
refreshLists
swapIn
swapOut
updateList self canvas updateList
</methods> <methods> Tools.BrowserTabApplication <category>canvases</category>
categoryTabCanvas "By default this is blank. if a subclass has a categories view then they nee to supply one with this by setting indexOfCategoryCanvas" ^self indexOfCategoryCanvas == 0 ifTrue:[self blankCategoryCanvas ] ifFalse:[components at: self indexOfCategoryCanvas ]
</methods> <methods> Tools.BrowserTabApplication <category>testing</category>
isNamspaceTabApp ^false
</methods> <methods> Tools.BrowserTabApplication <category>selection utlity</category>
selectBehavior: aBehavior (self components at: components size - 2) currentHelper selectBehavior: aBehavior
selectCategory: aCategory (self components at: components size - 3) currentHelper selectCategory: aCategory
selectMethod: aSymbol (self components at: components size) currentHelper selectMethod: aSymbol
selectProtocol: aProtocol (self components at: components size - 1) currentHelper selectProtocol: aProtocol
</methods> <methods> Tools.BrowserTabApplication class <category>instance creation</category>
basicNewOnBrowser: aBrowser | inst | inst := self basicNew. inst browser: aBrowser. inst initializeNull. ^inst
newOnBrowser: aBrowser | inst | inst := self basicNew. inst browser: aBrowser. inst initialize. ^inst
</methods> <methods> Tools.BrowserTabApplication class <category>accessing</category>
label self subclassResponsibility
</methods> <methods> Tools.ParcelTabApplication <category>menus</category>
addParceling: parcelSet to: aMenu forHelper: aBrowserHelper ^self class addParceling: parcelSet to: aMenu forHelper: aBrowserHelper
</methods> <methods> Tools.ParcelTabApplication <category>parcel Specific accessing </category>
behaviorStatus: aBehavior currentParcel: aParcel "Compute the status for a Behavior (class or metaclass)." | parcels status definedCount extendedCount | status := Set new: 4. aBehavior isNil ifTrue: [^status "shouldn't happen"]. parcels := self manager parcelsForClassOrNameSpace: aBehavior. nil == parcels ifFalse: [definedCount := extendedCount := 0. parcels do: [:parcel| (parcel definesClass: aBehavior) ifTrue: [definedCount := definedCount + 1. status add: (parcel == aParcel ifTrue: [#defined] ifFalse: [#definedByOther]). (parcel == aParcel and: [| defined selectors | "This is a performance-critical piece of code since it dominates computing category emphases for categories that are entirely defined by a Parcel. Hence there is some effort to optimize the comparison of defined and implemented selectors." defined := parcel definedSelectorsFor: aBehavior. selectors := aBehavior organization elements. defined size = selectors size and: [nil == (selectors detect: [:sel| (defined includes: sel) not] ifNone: [])]]) ifTrue: [status add: #entirelyDefined]]. (parcel extendsBehavior: aBehavior) ifTrue: [extendedCount := extendedCount + 1. status add: (parcel == aParcel ifTrue: [#extended] ifFalse: [#extendedByOther])]]. (definedCount > 1 "more than one parcel defines the behavior" or: [definedCount + extendedCount > 1 "may be multiply parcelled selectors - go check" and: [(self computeConflictsFor: (Array with: aBehavior) within: nil) first size > 0]]) ifTrue: [status add: #conflict]]. ^status
classDataStatus: aClass currentParcel: aParcel "Compute the status for a Class's static variables." | parcels status definedCount names | status := Set new: 4. aClass isNil ifTrue: [^status "shouldn't happen"]. names := aClass asNameSpace localBindingNames. names isEmpty ifTrue: [(aParcel ~~ nil and: [aParcel definesClass: aClass]) ifTrue: [status add: #entirelyDefined]. ^status]. parcels := manager parcelsForClassOrNameSpace: aClass. nil == parcels ifTrue: [^status]. definedCount := 0. parcels do: [:parcel| | defined | (defined := parcel definedNamesFor: aClass) size > 0 ifTrue: [definedCount := definedCount + 1. parcel == aParcel ifTrue: ["This is a performance-critical piece of code since it dominates computing category emphases for categories that are entirely defined by a Parcel. Hence there is some effort to optimize the comparison of defined and implemented names." status add: (((parcel definesClass: aClass) and: [defined size = names size and: [nil == (names detect: [:name| (defined includes: name) not] ifNone: nil)]]) ifTrue: [#entirelyDefined] ifFalse: [#defined])] ifFalse: [status add: #extendedByOther]]. (definedCount > 1 "more than one parcel defines data in aClass" and: [(self computeDataConflictsFor: (Array with: aClass) within: nil) first size > 0]) ifTrue: [status add: #conflict]]. ^status
classNameStatus: aClass environment: environment currentParcel: aParcel "Compute the status for a class name (class and its metaclass)." | classStatus metaclassStatus entirelyDefined | aClass isBehavior ifFalse: [^self definedThingStatus: aClass currentParcel: aParcel]. classStatus := self behaviorStatus: aClass currentParcel: aParcel. metaclassStatus := self behaviorStatus: aClass class currentParcel: aParcel. entirelyDefined := (classStatus includes: #entirelyDefined) and: [metaclassStatus includes: #entirelyDefined]. classStatus addAll: metaclassStatus. entirelyDefined ifFalse: [classStatus remove: #entirelyDefined ifAbsent: nil]. ^classStatus
currentParcel ^self canvas currentParcel
currentParcelsFor: aClass currentParcel: aParcel "Answer the current set of relevant parcels. If the currentParcel is selected then this is simply the set containing the currentParcel. Otherwise it is the set of parcels that define or extend aClass." | parcels | ^aParcel isNil ifTrue: [(parcels := self manager parcelsForClassOrNameSpace: aClass) isNil ifTrue: [IdentitySet new] ifFalse: [parcels]] ifFalse: [IdentitySet with: aParcel]
dataKeyStatus: aKey class: aClass currentParcel: aParcel "Compute the status for a data key in a given class/namespace with respect to the parcels in manager and aParcelOrNil." | status parcels count | status := Set new: 4. (nil == aClass or: [nil == aKey]) ifTrue: [^status]. nil == (parcels := manager parcelsForClassOrNameSpace: aClass) ifFalse: [count := 0. parcels do: [:p| (p definesName: aKey in: aClass) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])]]. count > 1 ifTrue: [status add: #conflict]]. ^status
dataProtocolStatus: aSymbol class: aClass currentParcel: aParcel "Compute the status for a data protocol in a class." | thingsInProtocol status parcels | status := Set new: 4. nil == aClass ifTrue: [^status]. thingsInProtocol := aClass asNameSpace organization listAtCategoryNamed: aSymbol. (thingsInProtocol isEmpty or: [nil == (parcels := manager parcelsForClassOrNameSpace: aClass)]) ifTrue: [^status]. "Assume entirely defined; search for exceptions in the loop below." (aParcel notNil and: [parcels includes: aParcel]) ifTrue: [status add: #entirelyDefined]. thingsInProtocol do: [:aThing| | count | count := 0. parcels do: [:p| (p definesName: aThing in: aClass) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])] ifFalse: [aParcel == p ifTrue: [status remove: #entirelyDefined ifAbsent: nil]]]. count > 1 ifTrue: [status add: #conflict]]. ^status
dataStatus: aBinding class: aClass currentParcel: aParcel "Compute the status for aBinding in a given class with respect to the parcels in manager and aParcelOrNil." ^self dataKeyStatus: aBinding key class: aClass currentParcel: aParcel
isUnparceledCodeInBehavior: aBehavior currentParcel: aParcel "Answer if there is any unparceled code in aBehavior (either it is undefined or contains methods that are undefined) for the currently 'relevant' parcels." | parcels selectors | "This also needs to account for unparcelled statics" aParcel isNil ifTrue: [parcels := manager parcelsForClassOrNameSpace: aBehavior. parcels isNil ifTrue: [^true]. parcels := parcels asArray] ifFalse: [parcels := Array with: aParcel]. parcels do: [:p| (p definesClass: aBehavior) ifFalse: [^true]]. "This is performance critical. So we unroll the loop and use the class's organization. Code should be equivalent to ^class selectors contains: [:sel| parcels contains: [:p| (p definesSelector: sel forClass: class) not]]" selectors := aBehavior organization elements. 1 to: selectors size do: [:si| | sel | sel := selectors at: si. 1 to: parcels size do: [:pi| ((parcels at: pi) definesSelector: sel forClass: aBehavior) ifFalse: [^true]]]. ^false
isUnparceledCodeInClass: aClass currentParcel: aParcel "Answer if there is any unparceled code in aClass (either it is undefined or contains methods that are undefined) for the currently 'relevant' parcels." ^(self isUnparceledCodeInBehavior: aClass currentParcel: aParcel) or: [self isUnparceledCodeInBehavior: aClass class currentParcel: aParcel]
isUnparceledCodeInNameSpace: aNamespace "This isn't implemented yet." ^false
manager ^manager
mapStatusToEmphasis: statusSet "Compute the emphasis for aSet. aSet has the following members #entirelyDefined #defined #definedByOther #extended #extendedByOther #conflict" | emphasis | emphasis := Set new: 4. statusSet do: [:status| (#extended == status or: [#defined == status]) ifTrue: [emphasis add: #bold] ifFalse: [ #entirelyDefined == status ifTrue: [emphasis add: #bold; add: #underline] ifFalse: [ (#definedByOther == status or: [#extendedByOther == status]) ifTrue: [emphasis add: #italic] ifFalse: [ #conflict == status ifTrue: [emphasis add: #color->ColorValue red] ifFalse: [ #notFound == status ifFalse: [Transcript cr; print: status; endEntry]. emphasis add: #strikeout "as an error indication"]]]]]. ^emphasis asArray
selectorStatus: aSelector class: aClass currentParcel: aParcel "Compute the status for a selector in a given classwith respect to the parcels in manager and aParcelOrNil." | status parcels count | status := Set new: 4. (nil == aClass or: [nil == aSelector]) ifTrue: [^status]. nil == (parcels := manager parcelsForClassOrNameSpace: aClass) ifFalse: [count := 0. parcels do: [:p| (p definesSelector: aSelector forClass: aClass) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])]]. count > 1 ifTrue: [status add: #conflict]]. ^status
</methods> <methods> Tools.ParcelTabApplication <category>parcel emphassis</category>
computeConflictsFor: aSetOfClasses within: aSetOfParcelsOrNil "Answer a triple of a Set of MethodDefinitions identifying all methods that are multiply parcelled, a Set of statics that are multiply parcelled, and a Set of classes that either contain multiply parcelled methods or are themselves multiply parcelled. If aSetOfParcelsOrNil is non-nil then only include conflicts that are parcelled within aSetOfParcels Express the triple as an Array, method definitions first, bindings next, classes last." | methods bindings classes | methods := Set new: 64. bindings := IdentitySet new: 8. classes := IdentitySet new: 4. aSetOfClasses do: [:class| | parcels | (parcels := manager parcelsForClassOrNameSpace: class) notNil ifTrue: [| instanceSelectorBag classSelectorBag staticBag classBag | instanceSelectorBag := Bag identityNew: 32. classSelectorBag := Bag identityNew: 32. staticBag := Bag identityNew: 4. classBag := Bag identityNew: 2. parcels do: [:parcel| (parcel definesClass: class) ifTrue: [classBag add: class]. instanceSelectorBag addAll: (parcel definedSelectorsFor: class). classSelectorBag addAll: (parcel definedSelectorsFor: class class). staticBag addAll: (parcel definedBindingsFor: class)]. instanceSelectorBag valuesAndCountsDo: [:sel :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesSelector: sel forClass: class]]]) ifTrue: [classes add: class. methods add: (MethodDefinition class: class selector: sel)]]. classSelectorBag valuesAndCountsDo: [:sel :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesSelector: sel forClass: class class]]]) ifTrue: [classes add: class. methods add: (MethodDefinition class: class class selector: sel)]]. classBag valuesAndCountsDo: [:clss :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [classes add: class]]. staticBag valuesAndCountsDo: [:binding :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [bindings add: binding. classes add: class]]]]. ^Array with: methods with: bindings with: classes
definedThingStatus: anObject currentParcel: aParcel "Compute the status for a Static." | status definedCount | status := Set new: 4. anObject isNil ifTrue: [^status "shouldn't happen"]. definedCount := 0. manager parcels do: [:parcel| (parcel definesObject: anObject) ifTrue: [definedCount := definedCount + 1. status add: (parcel == aParcel ifTrue: [#defined] ifFalse: [#definedByOther]). (parcel == aParcel) ifTrue: [status add: #entirelyDefined]]]. (definedCount > 1 "more than one parcel defines the behavior") ifTrue: [status add: #conflict]. ^status
</methods> <methods> Tools.ParcelTabApplication <category>parcel actions</category>
moveSelectionToParcel: aParcel self changeRequest ifFalse: [^self]. self saveParcelsForUndo; moveSelectors: ( IdentitySet with: self selection ) inClass: self targetClass fromParcel: self selectedParcel toParcel: aParcel; updateLists
openParcelProperties PackagePropertiesDialog on: self currentParcel
parcelComment self parcelTextMode: #parcelComment
parcelDanglingReferences self parcelTextMode: #parcelDanglingReferences
parcelDefinition "Fake parcel mode so we can accept class defs with only the parcel selected." self parcelTextMode: #parcelDefintion
parcelSummary self parcelTextMode: #parcelSummary
selectParcel: aParcel | newSelection | newSelection := aParcel notNil ifTrue: [aParcel]. self canvas module select: newSelection whenFinished:[self canvas module updateList].
updateBrowser self canvas updateLists. self updateWindowLabel. manager flushClassParcelMap
updateLists self browser batchUpdates: [| theParcel | "Remember the currentParcel because updating the parcel list will change the currentParcel." theParcel := self currentParcel. self canvas updateListFull. ((self components) at:1 ) updateListFull. ((self components) at: 2 ) updateList. self selectParcel: theParcel. self browser updateWindowLabel]
updateListsForParcels self browser batchUpdates: [ self components first updateListFull ].
</methods> <methods> Tools.ParcelTabApplication <category>private-parcel operations</category>
addClassToParcel | thing | self changeRequest ifFalse: [^self]. self saveParcelsForUndo. thing := self selectedThing. thing == nil ifFalse: [thing isBehavior ifTrue: [ self currentParcel addEntiretyOfClass: thing] ifFalse: [self currentParcel addObject: thing]]. self updateBrowser
canUndo "Answer if the receiver can do an undo." ^savedParcels notNil
clearUndoState "Free the Parcel copies for undo." savedParcels := nil
doUndo "Restore the previous set of Parcels prior to the last parcelling operation and clear the history." (Dialog confirm: (#UndoLastParcellingQ << #dialogs >> 'Undo last parcelling?')) ifTrue: [savedParcels notNil ifTrue: [savedParcels do: [:parcel| manager replaceParcel: parcel]. savedParcels := nil. self updateLists]]
moveBehaviors: aBehaviorSet toParcel: theParcelOrNil "Move the classes in aBehaviorSet into theParcelOrNil according to the current filtering and selected parcel. Read the comment in moveSelectors:inClass:toParcel: for a specification." | classesToMove theClasses parcels | (self currentParcel notNil and: [unparceledFilterOn]) ifTrue: [^Screen default ringBell]. "First move the selectors..." aBehaviorSet do: [:aBehavior| self moveSelectors: aBehavior selectors inClass: aBehavior toParcel: theParcelOrNil]. "Now handle class definitions..." theClasses := (aBehaviorSet collect: [:ea| ea instanceBehavior]) asSet. classesToMove := IdentitySet new. parcels := theClasses inject: IdentitySet new into: [:set :aClass| | ps | (ps := manager parcelsForClass: aClass) isNil ifFalse: [set addAll: ps]. set]. parcelFilterOn ifTrue: [conflictsFilterOn ifTrue: [parcels size > 1 ifTrue: "optimization - only conflicts if more than 1 parcel" [theClasses do: [:aClass| | count | count := 0. parcels do: [:p| (p definesClass: aClass) ifTrue: [count := count + 1]]. count > 1 ifTrue: [self currentParcel isNil ifTrue: [classesToMove add: aClass. parcels do: [:p| p undefineClass: aClass]] ifFalse: [(self currentParcel definesClass: aClass) ifTrue: [classesToMove add: aClass. self currentParcel undefineClass: aClass]]]]]] ifFalse: [self currentParcel notNil ifTrue: [parcels := IdentitySet with: self currentParcel]. theClasses do: [:aClass| parcels do: [:p| (p definesClass: aClass) ifTrue: [classesToMove add: aClass. p undefineClass: aClass]]]]] ifFalse: [unparceledFilterOn ifTrue: [theClasses do: [:aClass| (parcels contains: [:p| p definesClass: aClass]) ifFalse: [classesToMove add: aClass]]] ifFalse: [theClasses do: [:aClass| classesToMove add: aClass. parcels do: [:p| p undefineClass: aClass]]]]. theParcelOrNil notNil ifTrue: [classesToMove do: [:aClass| theParcelOrNil addClass: aClass]]
moveClassesAndNameSpaces: aSet toParcel: theParcelOrNil "Move the classes in aSet into theParcelOrNil according to the current filtering and selected parcel. Read the comment in moveSelectors:inClass:toParcel: for a specification." self notImplemented.
moveData: aKeySet inNameSpace: theNameSpace fromParcel: fromParcel toParcel: theParcelOrNil self notYetImplemented. "Move the methods in aSelectorSet into theParcel according to the following rules. If no Parcel is selected ... - If filtering is off then move all the methods to theParcelOrNil and remove all the methods from all other parcels. - If filtering is on then move all the methods that are defined by other parcels into theParcelOrNil, and remove just those methods from all other parcels. - If conflict filtering is on then move all the methods that are defined by more than one parcel into theParcelOrNil, and remove just those methods from all other parcels. - if unparcelled filtering is on then add only code that is unparcelled. This is a noop if theParcelOrNil is nil. If a Parcel is selected ... move as described above, but only code that is defined by the selected parcel. If aParcelOrNil is nil then the effect is simply to remove the methods from other parcels as described above. This is used in e.g. removing conflicts."
moveSelectors: aSelectorSet inClass: theClass fromParcel: fromParcel toParcel: theParcelOrNil "Move the methods in aSelectorSet into theParcel according to the following rules. If no Parcel is selected ... - If filtering is off then move all the methods to theParcelOrNil and remove all the methods from all other parcels. - If filtering is on then move all the methods that are defined by other parcels into theParcelOrNil, and remove just those methods from all other parcels. - If conflict filtering is on then move all the methods that are defined by more than one parcel into theParcelOrNil, and remove just those methods from all other parcels. - if unparcelled filtering is on then add only code that is unparcelled. This is a noop if theParcelOrNil is nil. If a Parcel is selected ... move as described above, but only code that is defined by the selected parcel. If aParcelOrNil is nil then the effect is simply to remove the methods from other parcels as described above. This is used in e.g. removing conflicts." | selectorsToMove parcels | "Here's the state space: MA = move all/move any MU = move unparcelled MCP = move only in current MCC = move only conflicts in current MAC = move any conflicts MAP = move any parcelled filter: none x unparcelled x parcelled x multiply parcelled current parcel MA nop MAC MCC no current parcel MA MU MAP MAC" (fromParcel notNil and: [unparceledFilterOn]) ifTrue: [^Screen default ringBell]. selectorsToMove := IdentitySet new: aSelectorSet size. parcels := manager parcelsForClassOrNameSpace: theClass. nil == parcels ifTrue: [parcels := IdentitySet new]. parcelFilterOn ifTrue: [conflictsFilterOn ifTrue: [parcels size > 1 ifTrue: "optimization - only conflicts if more than 1 parcel" [aSelectorSet do: [:sel| | count | count := 0. parcels do: [:p| (p definesSelector: sel forClass: theClass) ifTrue: [count := count + 1]]. count > 1 ifTrue: [fromParcel isNil ifTrue: [selectorsToMove add: sel. parcels do: [:p| p removeSelector: sel forClass: theClass]] ifFalse: [(fromParcel definesSelector: sel forClass: theClass) ifTrue: [selectorsToMove add: sel. fromParcel removeSelector: sel forClass: theClass]]]]]] ifFalse: [fromParcel notNil ifTrue: [parcels := IdentitySet with: fromParcel]. aSelectorSet do: [:sel| parcels do: [:p| (p definesSelector: sel forClass: theClass) ifTrue: [selectorsToMove add: sel. p removeSelector: sel forClass: theClass]]]]] ifFalse: [unparceledFilterOn ifTrue: [aSelectorSet do: [:sel| (parcels contains: [:p| p definesSelector: sel forClass: theClass]) ifFalse: [selectorsToMove add: sel]]] ifFalse: [aSelectorSet do: [:sel| selectorsToMove add: sel. parcels do: [:p| p removeSelector: sel forClass: theClass]]]]. theParcelOrNil notNil ifTrue: [selectorsToMove do: [:aSelector| theParcelOrNil addSelector: aSelector forClass: theClass]]. self updateListsForParcels.
moveSelectors: aSelectorSet inClass: theClass toParcel: theParcelOrNil "Move the methods in aSelectorSet into theParcel according to the following rules. If no Parcel is selected ... - If filtering is off then move all the methods to theParcelOrNil and remove all the methods from all other parcels. - If filtering is on then move all the methods that are defined by other parcels into theParcelOrNil, and remove just those methods from all other parcels. - If conflict filtering is on then move all the methods that are defined by more than one parcel into theParcelOrNil, and remove just those methods from all other parcels. - if unparcelled filtering is on then add only code that is unparcelled. This is a noop if theParcelOrNil is nil. If a Parcel is selected ... move as described above, but only code that is defined by the selected parcel. If aParcelOrNil is nil then the effect is simply to remove the methods from other parcels as described above. This is used in e.g. removing conflicts." | selectorsToMove parcels | "Here's the state space: MA = move all/move any MU = move unparcelled MCP = move only in current MCC = move only conflicts in current MAC = move any conflicts MAP = move any parcelled filter: none x unparcelled x parcelled x multiply parcelled current parcel MA nop MAC MCC no current parcel MA MU MAP MAC" (self currentParcel notNil and: [unparceledFilterOn]) ifTrue: [^Screen default ringBell]. selectorsToMove := IdentitySet new: aSelectorSet size. parcels := manager parcelsForClassOrNameSpace: theClass. nil == parcels ifTrue: [parcels := IdentitySet new]. parcelFilterOn ifTrue: [conflictsFilterOn ifTrue: [parcels size > 1 ifTrue: "optimization - only conflicts if more than 1 parcel" [aSelectorSet do: [:sel| | count | count := 0. parcels do: [:p| (p definesSelector: sel forClass: theClass) ifTrue: [count := count + 1]]. count > 1 ifTrue: [self currentParcel isNil ifTrue: [selectorsToMove add: sel. parcels do: [:p| p removeSelector: sel forClass: theClass]] ifFalse: [(self currentParcel definesSelector: sel forClass: theClass) ifTrue: [selectorsToMove add: sel. self currentParcel removeSelector: sel forClass: theClass]]]]]] ifFalse: [self currentParcel notNil ifTrue: [parcels := IdentitySet with: self currentParcel]. aSelectorSet do: [:sel| parcels do: [:p| (p definesSelector: sel forClass: theClass) ifTrue: [selectorsToMove add: sel. p removeSelector: sel forClass: theClass]]]]] ifFalse: [unparceledFilterOn ifTrue: [aSelectorSet do: [:sel| (parcels contains: [:p| p definesSelector: sel forClass: theClass]) ifFalse: [selectorsToMove add: sel]]] ifFalse: [aSelectorSet do: [:sel| selectorsToMove add: sel. parcels do: [:p| p removeSelector: sel forClass: theClass]]]]. theParcelOrNil notNil ifTrue: [selectorsToMove do: [:aSelector| theParcelOrNil addSelector: aSelector forClass: theClass]]. self updateListsForParcels
saveParcelsForUndo "Compute a set of Parcel copies for undo." manager broadcastClearUndoStateFrom: self. savedParcels := manager parcels collect: [:ea| ea copy]
</methods> <methods> Tools.ParcelTabApplication <category>private parcel</category>
computeDataConflictsFor: aSetOfClasses within: aSetOfParcelsOrNil "Answer a Set of statics that are multiply parcelled return and Array with a Set of statics that have conflicts" | bindings | bindings := IdentitySet new: 8. aSetOfClasses do: [:class| | parcels | (parcels := manager parcelsForClassOrNameSpace: class) notNil ifTrue: [| staticBag | staticBag := Bag identityNew: 4. parcels do: [:parcel| staticBag addAll: (parcel definedBindingsFor: class)]. staticBag valuesAndCountsDo: [:binding :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [bindings add: binding]]]]. ^Array with: bindings
isConflictsFilterOn ^conflictsFilterOn
isParcelFilterOn "Determine if filtering by Parcel is in effect." ^parcelFilterOn or: [conflictsFilterOn]
isUnparceledFilterOn "Determine if filtering by Parcel is in effect." ^unparceledFilterOn
parcelTextMode: aSymbol self changeRequest ifFalse: [ ^self ]. components do: [ :comp | comp deselect ]. parcelDefType value: aSymbol. self browser updateText
parcelTextMode: aSymbol value: aText self changeRequest ifFalse: [ ^self ]. components do: [ :comp | comp deselect ]. parcelDefType value: aSymbol. self browser text value: aText
toggleConflicts "Toggle multiply parcelled code filtering." self changeRequest ifFalse: [^false]. conflictsFilterOn ifTrue: [conflictsFilterOn := false] ifFalse: [unparceledFilterOn := false. parcelFilterOn := conflictsFilterOn := true]. self updateBrowser. self updateLists.
toggleParceled "Toggle by-Parcel code filtering." self changeRequest ifFalse: [^false]. parcelFilterOn ifTrue: [parcelFilterOn := conflictsFilterOn := false] ifFalse: [unparceledFilterOn := false. parcelFilterOn := true]. self updateBrowser
toggleUnparceled "Toggle Unparceled code filtering." self changeRequest ifFalse: [^false]. unparceledFilterOn ifTrue: [unparceledFilterOn := false] ifFalse: [unparceledFilterOn := true. parcelFilterOn := conflictsFilterOn := false]. self updateBrowser. self updateLists
turnOffParcelFilters parcelFilterOn := unparceledFilterOn := conflictsFilterOn := false.
updateWindowLabel (self browser builder notNil and: [self browser builder window notNil]) ifTrue: [self browser builder window label: self windowLabel]
windowLabel ^components isEmpty ifTrue: [(#ParcelBrowser << #labels >> 'Parcel Browser')] ifFalse: [self canvas windowLabel asString, ' ', (components at: 2) windowLabel asString]
</methods> <methods> Tools.ParcelTabApplication <category>updating</category>
update: anAspectSymbol with: aParameter from: aSender browser currentTabApplication == self ifFalse: [ ^super update: anAspectSymbol with: aParameter from: aSender ]. #parcels == anAspectSymbol ifTrue: [ ^self ~~ aSender ifTrue: [ self clearUndoState. self updateList ]. ]. #clearUndoState == anAspectSymbol ifTrue: [ ^self ~~ aSender ifTrue: [ self clearUndoState ] ]. ^super update: anAspectSymbol with: aParameter from: aSender
</methods> <methods> Tools.ParcelTabApplication <category>initialize</category>
addDependents self manager addDependent: self.
initialize manager := Parcel. parcelFilterOn := unparceledFilterOn := conflictsFilterOn := false. parcelDefType := #parcelComment asValue. self addDependents. super initialize.
initializeForClassHierarchy: aClass | cls | self browser meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). cls := aClass instanceBehavior. components := List new. components add: self parcelsComponent. components add: self classHierarchyComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponentsInArray: components. self linkFirstComponentToSubcanvas. self browser updateLists. self setClassOrNameSpaceFor: #default to: aClass. components first updateList; selection: ( cls fullyQualifiedReference ).
release super release. self removeDependents.
removeDependents self manager removeDependent: self.
</methods> <methods> Tools.ParcelTabApplication <category>componentBuilding</category>
allCategoriesComponent ^SimpleBrowserModule singleSelect specName: #listSpecSingleSelect; helpers: (Array with: (ParcelNameSpaceOrganizerBrowserHelper new searchChildNamespaces: true) ).
allClassesComponent ^SimpleBrowserModule new helperType: ParcelNameSpaceGlobalCategoryBrowserHelper; yourself
buildComponentArray super buildComponentArray. self indexOfCategoryCanvas: 1.
categoriesComponent ^self browser searchChildNamespaces ifTrue: [self allCategoriesComponent] ifFalse: [(SimpleBrowserModule singleSelect) specName: #listSpecSingleSelect; helperType: ParcelNameSpaceOrganizerBrowserHelper]
classesComponent ^self browser searchChildNamespaces ifTrue: [self allClassesComponent] ifFalse: [ SimpleBrowserModule new helperType: ParcelNameSpaceCategoryBrowserHelper; yourself]
componentId ^#parcelTab
protocolsComponent ^SimpleBrowserModule singleSelect specName: #listSpecProtocolsSingleSelect; helperType: ParcelProtocolBrowserHelper; yourself
selectorsComponent ^SimpleBrowserModule new helperType: ParcelSelectorBrowserHelper; yourself
</methods> <methods> Tools.ParcelTabApplication <category>accessing subcanvases</category>
getCanvas | module | module := self parcelsComponent. module browser: self browser. ^module
parcelsComponent ^SimpleBrowserModule singleSelect deselectNextModuleOnReselect: false; helperType: ParcelListBrowserHelper; yourself
</methods> <methods> Tools.ParcelTabApplication <category>accessing</category>
categoriesLabel ^self browser selectedEnvironment notNil ifTrue: [ self categoryTabCanvas selection notNil ifTrue:[self categoryTabCanvas selection ] ifFalse:[(#ParcelCategories << #labels >> 'Parcel Categories') asString]] ifFalse: [(#ParcelCategories << #labels >> 'Parcel Categories') asString]
defaultEmphasizer ^ParcelEmphasizer new.
icon ^icon isNil ifTrue:[ icon := self eraseBackgroundOnImage: (self class parcelIcon)] ifFalse:[icon ]
label ^self canvas selection == nil ifTrue: [ self class label ] ifFalse: [ self canvas selection name ]
parcelDefType ^parcelDefType
</methods> <methods> Tools.ParcelTabApplication class <category>accessing</category>
label ^(#Parcels << #menus >> 'Parcels') asString
</methods> <methods> Tools.ParcelTabApplication class <category>menus</category>
addParceling: parcelSet to: aMenu forHelper: aBrowserHelper "Add the various parcelling operations and undo to aMenu. Make sure the various actions refer to parcels weakly so as not to prevent clean unloading." | parcelMenuItem parcelSubMenu submenu locateParcels locateList locateNames moveToParcels moveToList moveToNames | parcelMenuItem := aMenu atNameKey: #parcelSubMenu. parcelMenuItem == nil ifTrue: [parcelMenuItem := (MenuItem labeled: (#Parcel << #menus >> 'Parcel')) nameKey: #parcelSubMenu; submenu: self parcelSubMenu. aMenu addItem: parcelMenuItem atPosition: 33.01]. parcelSubMenu := parcelMenuItem submenu. 1 to: parcelSubMenu numberOfItems - 2 do: "add to, remove from, move to" [:i| (parcelSubMenu menuItemAt: i) nameKey = #parcelAddTo ifTrue:[(parcelSubMenu menuItemAt: i) enabled: (aBrowserHelper selectedParcel notNil and:[(aBrowserHelper selectedParcel definesClass: aBrowserHelper selection) not]) ] ifFalse:[ (parcelSubMenu menuItemAt: i) enabled: aBrowserHelper selectedParcel notNil]]. locateParcels := parcelSubMenu atNameKey: #parcelLocate. locateList := (parcelMenuItem isEnabled and: [parcelSet size > 0]) ifTrue: [(parcelSet asSortedCollection: [:p1 :p2| p1 name <= p2 name])] ifFalse: [#()]. locateList isEmpty ifTrue: [locateParcels disable; submenu: nil] ifFalse: [locateNames := (locateList collect: [:ea| ea name]) asArray. locateList := WeakArray withAll: locateList. submenu := (Menu labelArray: locateNames values: ((1 to: locateList size) collect: [:i| [| p | ((p := locateList at: i) ~= locateList tombstone and: [p ~= nil]) ifTrue: [Cursor execute showWhile: [aBrowserHelper browser selectParcel: p]]]])). locateParcels submenu: submenu; enable]. moveToParcels := parcelSubMenu atNameKey: #parcelMoveTo. moveToList := parcelMenuItem isEnabled ifTrue: [(aBrowserHelper browser manager parcels asSortedCollection: [:p1 :p2| p1 name <= p2 name])] ifFalse: [#()]. moveToList isEmpty ifTrue: [moveToParcels disable; submenu: nil] ifFalse: [moveToNames := (moveToList collect: [:ea| ea name]) asArray. moveToList := WeakArray withAll: moveToList. submenu := (Menu labelArray: moveToNames values: ((1 to: moveToList size) collect: [:i| [| p | ((p := moveToList at: i) ~= moveToList tombstone and: [p ~= nil]) ifTrue: [Cursor execute showWhile: [aBrowserHelper moveSelectionToParcel: p]]]])). moveToParcels submenu: submenu; enable]. aBrowserHelper augmentMenuBarMenu: parcelSubMenu. ^aMenu
</methods> <methods> Tools.Emphasizer <category>private-status</category>
classOrNameSpaceStatus: anObject criteria: criteria ^anObject isForClass ifTrue: [ self classStatus: anObject criteria: criteria ] ifFalse: [ self nameSpaceStatus: anObject criteria: criteria ]
dataDefinitionStatus: aStaticDef criteria: package ^#( ) "the default highlighting is none."
methodDefinitionStatus: aMethodDef criteria: package ^self selectorStatus: aMethodDef selector class: aMethodDef implementingClass criteria: package
</methods> <methods> Tools.Emphasizer <category>api</category>
emphasisForCategory: aCategory for: aBrowser id: selectionId "Answer the emphasis set for aCategory displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self categoryStatus: aCategory in: nil criteria: criteria ).
emphasisForCategory: aCategory in: anEnvironment for: aBrowser id: selectionId "Answer the emphasis set for aCategory displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self categoryStatus: aCategory in: anEnvironment criteria: criteria ).
emphasisForClassButtons: aBehavior for: aBrowser id: selectionId "Answer an array of emphasis sets for aBehavior (class or metaclass) for the instance, class and static buttons." | criteria ref | ( ( ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ) or: [ aBehavior == nil ] ) ifTrue: [ ^#( #( #norm ) #( #norm ) #( norm ) ) ]. ref := aBehavior isForNameSpace ifTrue: [ aBehavior namedReferent ] ifFalse: [ aBehavior ]. ^ref isForNameSpace ifTrue: [ Array with: #( #norm ) with: #( #norm ) with: ( self mapStatusToEmphasis: ( self classDataStatus: ref criteria: criteria ) ) ] ifFalse: [ ^Array with: ( self mapStatusToEmphasis: ( self behaviorStatus: ref instanceBehavior criteria: criteria ) ) with: ( self mapStatusToEmphasis: ( self behaviorStatus: ref classBehavior criteria: criteria ) ) with: ( self mapStatusToEmphasis: ( self classDataStatus: ref instanceBehavior criteria: criteria ) ) ]
emphasisForClassOrNameSpace: aClassOrNameSpace for: aBrowser id: selectionId "Answer the emphasis set for aClassOrNameSpace displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self classOrNameSpaceStatus: aClassOrNameSpace criteria: criteria ).
emphasisForMethodDefinition: aMethodDef for: aBrowser id: selectionId "Answer the emphasis set for aMethodDef displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self methodDefinitionStatus: aMethodDef criteria: criteria )
emphasisForProtocol: aProtocol for: aBrowser id: selectionId "Answer the emphasis set for aProtocol displayed in aBrowser with a selectionId." | criteria owner status | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ( owner := aBrowser selectedClassOrNameSpaceFor: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. status := ( owner isForNameSpace or: [ aBrowser isData ] ) ifTrue: [ self dataProtocolStatus: aProtocol owner: owner criteria: criteria ] ifFalse: [ self methodProtocolStatus: aProtocol class: owner criteria: criteria ]. ^self mapStatusToEmphasis: status.
emphasisForSelector: aSelector for: aBrowser id: selectionId "Answer the emphasis set for aSelector displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self selectorStatus: aSelector class: ( aBrowser selectedClassOrNameSpaceFor: selectionId ) criteria: criteria )
emphasisForSelectorProtocol: aProtocol for: aBrowser id: selectionId "Answer the emphasis set for aProtocol displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self methodProtocolStatus: aProtocol class: ( aBrowser selectedClassOrNameSpaceFor: selectionId ) criteria: criteria )
emphasisForStaticDefinition: aStaticDef for: aBrowser id: selectionId "Answer the emphasis set for aStaticDef displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self dataDefinitionStatus: aStaticDef criteria: criteria )
emphasisForStaticKey: aStaticKey for: aBrowser id: selectionId "Answer the emphasis set for aStaticKey displayed in aBrowser with a selectionId." | criteria | ( criteria := self currentCriteria: aBrowser id: selectionId ) == nil ifTrue: [ ^#( #norm ) ]. ^self mapStatusToEmphasis: ( self dataKeyStatus: aStaticKey owner: ( aBrowser selectedClassOrNameSpaceFor: selectionId ) criteria: criteria )
</methods> <methods> Tools.Emphasizer <category>private</category>
currentCriteria: aBrowser id: selectionId "Answer what we are highlighting based on." ^nil "Ensures that the default Emphasizer adds no emphasis."
emphasisForAttribute: status "Answer an array of emphasis for a status. Default mapping is: #entirelyDefined bold & underline #defined bold #definedByOther italic #extended bold #extendedByOther italic #conflict red " ( ( #extended == status ) or: [ #defined == status] ) ifTrue: [ ^#( bold ) ]. #entirelyDefined == status ifTrue: [ ^#( #bold #underline ) ]. ( ( #definedByOther == status ) or: [ #extendedByOther == status ] ) ifTrue: [ ^( #italic ) ]. #conflict == status ifTrue: [ ^Array with: ( #color->ColorValue red ) ] . #notFound == status ifFalse: [ Transcript cr; print: status; endEntry ]. ^#( #strikeout ) "as an error indication"
manager self subclassResponsibility
mapStatusToEmphasis: statusSet "Answer an array of emphasis for statusSet. Status is: #entirelyDefined #defined #definedByOther #extended #extendedByOther #conflict" | emphasis | emphasis := Set new: 4. statusSet do: [ :status | emphasis addAll: ( self emphasisForAttribute: status ) ]. ^emphasis asArray
</methods> <methods> Tools.ProtocolBrowserHelper <category>accessing</category>
meta ^self browser meta
windowLabel ^module hasList ifTrue: [(#xpBrowser << #labels >> '<1p> Browser') expandMacrosWith: self selectedClassOrNameSpace ] ifFalse: [(#xpxsMessageCategoryBrowser << #labels >> '<1p> {<2s>} Message Category Browser') expandMacrosWith: self selectedClassOrNameSpace with: self selection]
</methods> <methods> Tools.ProtocolBrowserHelper <category>list accessing</category>
selectionChanged module nextModule == nil ifTrue: [^super selectionChanged]. self selection == nil ifFalse: [LastProtocol := self selection]. self setSelection. self browser batchUpdates: [ module nextModule updateList ]
updateListFull | newList target | ( target := self targetClassOrNameSpace ) == nil ifTrue: [ newList := List new ] ifFalse: [ newList := target organization categories asList ]. module setNewList: newList
</methods> <methods> Tools.ProtocolBrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#(#fileOut #hardcopy #add #remove #findMethod)
actionsForNoSelect ^self targetClassOrNameSpace == nil ifTrue: [#()] ifFalse: [#(#add #findMethod )]
getListMenu "Items in the list are either method protocols or static categories. We need to be sure the label of the 'Find...' menu item makes sense. (So the label of that item in the resource spec on the class side does not actually matter.)" | menu target | menu := super getListMenu. target := self targetClassOrNameSpace. (menu menuItemWithValue: #findMethod) rawLabel: ((target isNil or: [target isForNameSpace]) ifTrue: [(#FindVariable << #menus >> 'Find Variable...')] ifFalse: [(#FindMethod << #menus >> 'Find Method...')]). ^menu
</methods> <methods> Tools.ProtocolBrowserHelper <category>actions</category>
add | aString newProtocol target | self changeRequest ifFalse: [^self]. aString := self prompt: (#EnterNewCategoryName << #dialogs >> 'Enter new category name') initially: (LastProtocol == nil ifTrue: [(#protocolName << #dialogs >> 'protocol name') asString] ifFalse: [LastProtocol]). aString isEmpty ifTrue: [^ self]. newProtocol := aString asSymbol. target := self targetClassOrNameSpace. target organization addCategory: newProtocol before: self selection. SourceFileManager default logChange: ('<1p> organization addCategory: <2p> before: <3p>' expandMacrosWith: target with: newProtocol with: module selection). target reorganize. module select: newProtocol whenFinished: [module updateList]
broadcastUpdate: aspect aspect key == #classOrNameSpace ifTrue: [self setSelection: aspect key for: self selectionId to: aspect value. module hasList ifTrue: [module select: aspect value whenFinished: [module updateList]] ifFalse: [module forceSelection: aspect value. self setSelection: aspect value]] ifFalse: [super broadcastUpdate: aspect]
fileOut | target suggestion fileName fileManager | target := self selectedClassOrNameSpace. suggestion := self selection isNil ifTrue: ['-protocols.st'] ifFalse: [self selections size > 1 ifTrue: ['-protocols.st'] ifFalse: ['-', self selection, '.st']]. fileName := target name, suggestion. fileName := Dialog requestNewFileName: (#FileOutAs << #dialogs >> 'File out as') default: ( Filename filterFilename: fileName ). fileName isEmpty ifTrue: [ ^nil ]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [fileManager timeStamp. fileManager deferInitializations. self selections do: [:protocol | (target isForNameSpace or: [self isData]) ifTrue: [(target asNameSpace organization listAtCategoryNamed: protocol) do: [:key | | ref | ref := target asNameSpace fullyQualifiedReferenceOf: key. fileManager storeObjectDefinition: ref. ref binding hasInitializer ifTrue: [fileManager initializeThisObject: ref]]] ifFalse: [fileManager fileOutMessages: (target organization listAtCategoryNamed: protocol) for: target]]. fileManager finishInitializations] ensure: [ fileManager close ]
findMethod "Show a list of the methods implemented by this class, OR a list of statics. Select the chosen one." | collection target prompt chosen | ( target := self targetClassOrNameSpace ) == nil ifTrue: [ ^self ]. self changeRequest ifFalse: [ ^self ]. prompt := target isForNameSpace ifTrue: [ (#FindWhichSharedVariableQ << #dialogs >> 'Find which shared variable?') ] ifFalse: [ (#FindWhichMethodQ << #dialogs >> 'Find which method?') ]. ( collection := target organization elements asSortedCollection ) size = 0 ifTrue: [ ^self ]. chosen := Dialog choose: prompt fromList: collection values: collection lines: 20 cancel: [nil] for: self interfaceWindow. chosen isNil ifFalse: [module select: ( target organization categoryOfElement: chosen ) whenFinished: [module nextModule select: chosen whenFinished: [module updateList]]].
hardcopy "Print out protocol." | stream | stream := TextStream on: (String new: 1000). self selections do: [ :protocol | self targetClassOrNameSpace printOutCategory: protocol on: stream ]. self hardcopyStream: stream
remove "Remove the selected protocol if the user confirms. Answer a Boolean indicating whether a protocol has indeed been removed." | keys target | self changeRequest ifFalse: [ ^false ]. target := self targetClassOrNameSpace. keys := Set new. module selections do: [ :protocol | keys addAll: ( target organization listAtCategoryNamed: protocol ) ]. keys isEmpty ifFalse: [ ( Dialog confirm: (#YouWantToRemoveMethodsInCategoriesQ << #dialogs >> 'Are you certain that you want to<n>remove all methods in these categories?') expandMacros for: self interfaceWindow) ifFalse: [ ^false ]. target isForNameSpace ifTrue: [ keys do: [ :key | | ref | ref := BindingReference simpleName: key in: target namedReferent. (target includesKey: key) ifTrue: [ref removeFromSystem]]] ifFalse: [ keys do: [:sel | target removeSelector: sel ] ] ]. module selections do: [ :protocol | target organization removeCategory: protocol. self logProtocolChange: ('<1p> organization removeCategory: <2p>' expandMacrosWith: target with: protocol)]. target reorganize. module updateList. ^true
rename | aString newProtocol target | self changeRequest ifFalse: [^self]. target := self targetClassOrNameSpace. aString := self prompt: (#EnterNewCategoryName << #dialogs >> 'Enter new category name') initially: self selection. aString isEmpty ifTrue: [^ self]. newProtocol := aString asSymbol. ( target renameCategory: module selection to: newProtocol) ifTrue: [self logProtocolChange: ('<1p> organization renameCategory: <2p> to: <3p>' expandMacrosWith: target with: self selection with: newProtocol). module select: newProtocol whenFinished: [module updateList]]
selectProtocol: aSymbol module select: aSymbol whenFinished: [module updateList]
spawn | target | ( target := self targetClassOrNameSpace ) isForClass ifTrue: [ self browser spawnOnClass: target protocol: self selection ] ifFalse: [ self browser spawnOnNameSpace: target protocol: self selection ]
</methods> <methods> Tools.ProtocolBrowserHelper <category>text processing</category>
doItEnvironment | target | ( target := self selectedClassOrNameSpace ) == nil ifTrue: [ ^nil ]. ^target isForNameSpace ifTrue: [ target ] ifFalse: [ target environment ]
doItReceiver | target | ( target := self selectedClassOrNameSpace ) == nil ifTrue: [ ^nil ]. ^target isForNameSpace ifTrue: [ target ] ifFalse: [ target instanceBehavior ]
explainerClass ^self selectedClassOrNameSpace
formatFor: aController "Format the text. Have the controller replace its contents with the new Text, or nil if the format operation was unsuccessful." | selectedClass aCompiler newText aText | selectedClass := self targetClassOrNameSpace. ( selectedClass isNil or: [ selectedClass isForNameSpace ] ) ifTrue: [ ^self ]. aText := aController text. aCompiler := selectedClass compilerClass new. newText := aCompiler format: aText in: selectedClass notifying: aController. newText == nil ifFalse: [ newText := newText asText makeSelectorBoldIn: selectedClass ]. newText == nil ifFalse: [ aController selectFrom: 1 to: aController text size; deselect; replaceSelectionWith: newText asText; selectAt: 1 ]
text | target | target := self targetClassOrNameSpace. ^( ( self selection == nil ) | ( target == nil ) ) ifTrue: [ self selections isEmpty ifTrue: [ nil ] ifFalse: [ Text new ] ] ifFalse: [ ^( target isForClass ifTrue: [ target sourceCodeTemplate ] ifFalse: [ self module templateBinding: target category: self selection ] ) asText ].
</methods> <methods> Tools.ProtocolBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#protocol
setSelection "Inform the browser that the selection has changed; unlike the superclass allow multiple selections." self setSelection: self selections
</methods> <methods> Tools.ProtocolBrowserHelper <category>drag and drop</category>
addClientDataTo: anIdentityDict self hasSelections ifFalse: [^false]. anIdentityDict at: #class put: self targetClassOrNameSpace. anIdentityDict at: #protocol put: self selections. anIdentityDict at: #meta put: self meta. anIdentityDict at: #category put: self category. ^true
canAcceptDropFrom: aDC ^aDC key == self selectorOrStaticKey or: [ aDC key == self protocolKey]
drop: aDragContext "A drop has occured in the protocol list of the browser. see if we can accept and if so move the methods." | ctrl idx prot protUnder protocolList selectors statics | (self canAcceptDropFrom: aDragContext) ifFalse: [^#dropEffectNone]. "Locate the target protocol's index" aDragContext clientData isNil ifTrue: [aDragContext clientData: self module initialListDropState]. ctrl := aDragContext clientData at: #ctrl ifAbsent: [self module addControllerDataTo: aDragContext clientData. ctrl := aDragContext clientData at: #ctrl]. (idx := ctrl view targetIndex) = 0 ifTrue: [^#dropEffectNone]. protocolList := self module list list. "If a protocol has been dropped, do not do a move unless from the same browser." aDragContext key == self protocolKey ifTrue: [ prot := aDragContext sourceData clientData at: #protocol. idx := ctrl view elementIndexFor: ctrl sensor cursorPoint. protUnder := idx < protocolList size ifTrue: [protocolList at: idx]. "Ignore other browsers" aDragContext data contextApplication ~~ self module browser ifTrue: [^#dropEffectNone]. prot do:[:eachProtocol | self selectedClassOrNameSpace organization addCategory: eachProtocol value before: protUnder value.]. (self selectedClassOrNameSpace) reorganize; logOrganizationChange. self module updateList. ^#dropEffectMove]. "If there are changes to the text, prompt before discarding them" self changeRequest ifFalse: [^#dropEffectNone]. "If the data is not available in the correct format, do not drop." selectors := aDragContext sourceData clientData at: #selector ifAbsent: [#()]. statics := aDragContext sourceData clientData at: #data ifAbsent: [#()]. (selectors isEmpty and: [statics isEmpty]) ifTrue: [^#dropEffectNone]. "Move the selector to the new protocol. The selector is in the clientData of the dropSource" selectors do:[:eachSelector | self moveSelector: eachSelector intoProtocol: ((protocolList at: idx) value)]. statics do: [:eachStatic | eachStatic environment asNameSpace classifySymbol: eachStatic name under: ((protocolList at: idx) value)]. "Restore the state of the protocol list before leaving." self restoreListStateFrom: aDragContext clientData. aDragContext clientData: nil. self module updateList. self module nextModule updateList. ^#dropEffectMove
getDragDropKey "return the data key for the drag" ^self protocolKey
moveSelector: aSelectorSymbol intoProtocol: aProtocolSymbol "Move aSelectorSymbol to protocol named aProtocolSymbol." | destClass | destClass := self targetClassOrNameSpace. destClass classifySymbol: aSelectorSymbol under: aProtocolSymbol. self module logProtocolChange: destClass fullName , ' organization classify: ' , aSelectorSymbol storeString , ' under: ' , aProtocolSymbol storeString. Transcript cr; show: ((#MethodInNewProtocol << #dialogs >> '<1s>%>%><2s> <nt>moved from protocol ''<3s>'' to protocol ''<4s>''') expandMacrosWith: destClass printString with: aSelectorSymbol asString with: self selection asString with: aProtocolSymbol asString). self nextModule updateList
</methods> <methods> Tools.ProtocolBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Protocol << #menus >> '&Protocol') asString
</methods> <methods> UI.TabbedDialog <category>initialize-release</category>
initialize super initialize. list := SelectionInList new. list list: self masterList. list selectionIndexHolder value: 1. list selectionIndexHolder onChangeSend: #updatePreferences to: self. (disturbed := false asValue) onChangeSend: #enableButtons to: self
</methods> <methods> UI.TabbedDialog <category>top level</category>
preferenceChoice ^list selectionIndexHolder
preferenceMasterList ^list
preferenceTopMenu | menuList | menuList := list list. ^Menu labelArray: (menuList collect: [:item | item key]) values: (1 to: menuList size)
updatePreferences "Update the subcanvas for the currently selected preference item. Answer the receiver." self rebuild. self setFocus
</methods> <methods> UI.TabbedDialog <category>events</category>
requestForWindowClose builder window keyboardProcessor requestGlobalAutoAccept. ^self requestSliceChange
</methods> <methods> UI.TabbedDialog <category>accessing</category>
disturbed ^disturbed value
</methods> <methods> UI.TabbedDialog <category>private</category>
disturb disturbed value: true. ^true
enableButtons | button | (button := subBuilder namedComponents at: #resetButton ifAbsent: []) notNil ifTrue: [self disturbed ifTrue: [button enable] ifFalse: [button disable]]. (button := subBuilder namedComponents at: #acceptButton ifAbsent: []) notNil ifTrue: [self disturbed ifTrue: [button enable] ifFalse: [button disable]]
helpAction | sh | sh := SimpleHelp helpString: self helpString. sh class openOn: sh
helpString ^self perform: (self class tabSpecsAndHelpSelectors at: list selectionIndex) last.
masterList ^self class masterList.
rebuild | canvas next | canvas := builder componentAt: #activeComponents. (next := (self class tabSpecsAndHelpSelectors at: list selectionIndex) first) == #textSizeBSpec ifTrue: [Cursor execute showWhile: [canvas widget client: self spec: next builder: (subBuilder := self builder newSubBuilder)]] ifFalse: [canvas widget client: self spec: next builder: (subBuilder := self builder newSubBuilder)]
requestSliceChange | win | builder notNil ifTrue: [win := builder window]. self disturbed ifTrue: [(Dialog confirm: (#alteredNotAccepted << #dialogs >> 'Settings have been altered but not accepted. Do you wish to discard the changes?') for: win) ifTrue: [self resetForSlice. ^true] ifFalse: [^false]] ifFalse: [^true]
resetForSlice (subBuilder componentAt: #resetButton) widget model value: true. self undisturb
setFocus "Set the keyboard input focus to be the first text input widget on the focus chain." | newFocus | newFocus := builder keyboardProcessor keyboardConsumers detect: [:aWidget | aWidget isKindOf: ComposedTextView] ifNone: [^self]. builder keyboardProcessor setActive: newFocus controller. (newFocus isKindOf: TextEditorView) ifTrue: [newFocus controller selectEntireText]. newFocus invalidate
undisturb disturbed value: false
</methods> <methods> UI.TabbedDialog <category>interface opening</category>
postOpenWith: aBuilder | canvas | canvas := builder componentAt: #notebook. canvas isNil ifTrue: [^self]. canvas widget client: self spec: #activeAreaSpec builder: builder. builder window keyboardProcessor keyboardHook: [:ev :ctrlr | self disturb. ev]. self updatePreferences
</methods> <methods> UI.TabbedDialog class <category>interface specs</category>
windowSpec ^( UISettings preferenceFor: #notebookStyle ) == #notebook ifTrue: [ self windowNotebookSpec ] ifFalse: [ self windowMenuSpec ]
</methods> <methods> UI.TabbedDialog class <category>constants</category>
windowLabel "Answer a string for the window label." self subclassResponsibility
</methods> <methods> UI.TabbedDialog class <category>accessing</category>
developmentTabLabels ^developmentTabLabels
masterList ^DeploymentOptionsSystem isDevelopment ifTrue: [self developmentTabLabels] ifFalse: [self runtimeTabLabels]
runtimeTabLabels ^runtimeTabLabels
tabSpecsAndHelpSelectors ^tabSpecsAndHelpSelectors
</methods> <methods> Tools.HierarchyBrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#()
actionsForNoSelect ^#(#find)
</methods> <methods> Tools.HierarchyBrowserHelper <category>list accessing</category>
addCategoryTreeToTree: aTree | categoryTree | categoryTree := AssociationTreeWithParent key: (#Categories << #dialogs >> 'Categories') value: #category. aTree addChild: categoryTree.
addChildNamespace: aNamespace to: namespaceTree aNamespace bindingsDo:[:var | |namespaceChild | var isForNameSpace ifTrue:[ namespaceChild := (AssociationTreeWithParent key: var value name value: var value). namespaceTree addChild: namespaceChild. self addChildNamespace: var value to: namespaceChild.]].
addNamespaceTreeToTree: aTree | namespaceTree | namespaceTree := AssociationTreeWithParent key: 'Root' value: Root. aTree addChild: namespaceTree. self addChildNamespace: Root to: namespaceTree.
addParcelNamespaceTreeToTree: aTree | namespaceTree | namespaceTree := AssociationTreeWithParent key: (#Namespaces << #dialogs >> 'Namespaces') value: #parcelNamespaces. aTree addChild: namespaceTree. self addChildNamespace: Root to: namespaceTree.
addParcelTreeToTree: aTree | parcelTree | parcelTree := AssociationTreeWithParent key: (#Parcels << #dialogs >> 'Parcels') value: #parcels. aTree addChild: parcelTree. Parcel parcels do: [ :each | | parcelChild | parcelChild := AssociationTreeWithParent key: each listEntry value: each. parcelTree addChild: parcelChild. self addParcelNamespaceTreeToTree: parcelChild. ].
currentNodeSelection ^module currentNodeSelection
getEnvironmentForSelection (self currentNodeSelection == nil or: [self currentNodeSelection parent == nil]) ifTrue: [ ^nil ]. self selectionIsParcel ifTrue:[ ^self environment ]. self selectionIsNamespace ifTrue:[ ^self selection ]. ^self environment
intializeListFull | tree | tree := AssociationTreeWithParent key: (#Filters << #dialogs >> 'Filters') value: #filters. self addNamespaceTreeToTree: tree. self addParcelTreeToTree: tree. self addCategoryTreeToTree: tree. module setNewListSilently: tree
selectedItem | thing | thing := self selection . (self selectionIsClass and: [self browser meta value == #class]) ifTrue: [thing := thing class]. ^thing
selectionChanged module nextModule == nil ifTrue: [^super selectionChanged]. self browser batchUpdates: [ | env | env := self getEnvironmentForSelection. self setSelection: env. module nextModule currentHelper searchChildNamespaces: env isNil. module nextModule updateList. self browser updateWindowLabel; updateButtonLabels]
selectionIsClass ^(self selection notNil and:[ self selection isSymbol not]) and: [self selection binding isForClass]
selectionIsDefined ^(self selection notNil and:[ self selection isSymbol not]) and: [self selection binding isForGeneral not]
selectionIsNames ^(self selection notNil and:[ self selection isSymbol not]) and: [self selection binding isForClass or: [self selection binding isForNameSpace]]
selectionIsNamespace ^(self selection notNil and:[ self selection isSymbol not]) and: [self selection isNameSpace]
selectionIsParcel ^(self selection notNil and:[ self selection isSymbol not]) and: [self selection class name == #Parcel]
selectionIsSymbol ^self selection isSymbol
updateListFull | tree | tree := AssociationTreeWithParent key: (#Filters << #dialogs >> 'Filters') value: #filters. self addNamespaceTreeToTree: tree. self addParcelTreeToTree: tree. self addCategoryTreeToTree: tree. module setNewList: tree
</methods> <methods> Tools.HierarchyBrowserHelper <category>private</category>
defaultEnvironment ^Smalltalk
selectedThingsWithOrder: aBlock | things | things := OrderedCollection new. things add: self selection. things addAll: (self selection allClasses ). things addAll: (self selection allNameSpaces ). things := SystemUtils sortForLoading: things. aBlock value: things
</methods> <methods> Tools.HierarchyBrowserHelper <category>templates</category>
addClassType: type "Display a template for adding a class of type type." | env cat | ( env:= self selectedNameSpace ) == nil ifTrue: [ env := Smalltalk ]. cat := self category. self browser defType value: #showDefinition. module nextModule nextModule deselect. "next module is categories...." self browser text value: ( self templateClass: env category: cat type: type )
templateBinding: nameSpace category: category ^'<1s> defineSharedVariable: #<2s> private: false constant: false category: <3p> initializer: ''Array new: 5''' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfBinding << #browser >> 'NameOfBinding' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
templateClass: nameSpace category: category type: type ^'<1p> defineClass: #<2s> superclass: #{<3s>} indexedType: #<4s> private: false instanceVariableNames: ''<5s>'' classInstanceVariableNames: '''' imports: '''' category: <6p>' expandMacrosWithArguments: (OrderedCollection new add: (nameSpace namedReferent unambiguousName); add: #NameOfClass << #browser >> 'NameOfClass'; add: #NameOfSuperclass << #browser >> 'NameOfSuperclass'; add: type; add: (type == #bytes ifTrue: [''] ifFalse: [(#instVarName1InstVarName2 << #browser >> 'instVarName1 instVarName2')]); add: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString]); yourself)
templateNameSpace: nameSpace category: category ^'<1s> defineNameSpace: #<2s> private: false imports: '' <3s>.* private Smalltalk.* '' category: <4p>' expandMacrosWith: (nameSpace namedReferent unambiguousName) with: #NameOfPool << #browser >> 'NameOfPool' with: #OtherNameSpace << #browser >> 'OtherNameSpace' with: (category == nil ifTrue: [NameSpaceOrganizer defaultProtocol asString] ifFalse: [category asString])
</methods> <methods> Tools.HierarchyBrowserHelper <category>actions</category>
addBinding | env cat | ( env:= self selectedNameSpace ) == nil ifTrue: [ env := Smalltalk ]. cat := self category. self browser defType value: #showDefinition. module nextModule nextModule deselect. "next module is categories...." self browser text value: ( self templateBinding: env category: cat )
addClassBytes "Display a template for adding a class of type bytes." self addClassType: #bytes
addClassFixedSize "Display a template for adding a class of type fixed size (none)." self addClassType: #none
addClassVariableSize "Display a template for adding a class of type bytes." self addClassType: #objects
addNameSpace | env cat | ( env:= self selectedNameSpace ) == nil ifTrue: [ env := Smalltalk ]. cat := self category. self browser defType value: #showDefinition. module nextModule nextModule deselect. "next module is categories...." self browser text value: ( self templateNameSpace: env category: cat )
fileOut | fileName fileManager nm | nm := self selection == nil ifTrue: [(#Definitions << #dialogs >> 'Definitions') asString] ifFalse: [self selection name asString]. fileName := Dialog requestNewFileName: (#fileOutOn << #dialogs >> 'File out on') default: (Filename filterFilename: nm, '.st'). fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName encoding: self fileEncoding. [fileManager timeStamp. fileManager deferInitializations. self selectedThingsWithOrder: [:definedObjects | definedObjects do: [:thing | thing fileOutSourceOn: fileManager. fileManager cr]]. fileManager finishInitializations. fileManager cr] ensure: [fileManager close].
find "Prompt for a name and position myself there." | obj | self changeRequest ifFalse: [^self]. obj := self findASomething: (#FindColon << #labels >> 'Find:'). obj == nil ifTrue: [^self]. obj isBindingReference ifTrue: [self browser batchUpdates: [self browser metaShowData. obj environment environment isNil ifTrue: [self module setSelection: nil] ifFalse: [self module selection: obj environment environment]. self browser selectCategory: obj environment category. self browser selectBehavior: obj environment. self browser selectProtocol: (obj environment asNameSpace categoryFor: obj name). self browser selectMethod: obj name]] ifFalse: [self module selection: obj environment. module nextModule select: obj category whenFinished: [module nextModule nextModule select: obj whenFinished: [module nextModule updateList]]]
moveTo | newSpace | newSpace := NameSpaceNavigator searchFrom: self defaultEnvironment label: (#MoveToWhichEnvironmentQ << #dialogs >> 'Move to which environment?'). newSpace == nil ifTrue: [^self]. module selections do: [ :sel | sel relocateTo: newSpace]. module updateList
remove "Prompt the user to remove the namespace. Answer if the namespace was removed or not." | bindings parentEvironment| self changeRequest ifFalse: [^false]. bindings := module selections asArray collect: [:nm | | ref | (ref := ((BindingReference simpleName: nm name) home: nm environment)) isDefined ifTrue: [ref] ifFalse: [Dialog warn: ((#CantRemoveObject1sNoLongerExists << #dialogs >> 'Can''t remove the object. <1s> no longer exists.') expandMacrosWith: nm asString) for: self interfaceWindow. nil]]. bindings := bindings copyWithout: nil. bindings isEmpty ifTrue: [^false]. bindings := SystemUtils sortForLoading: bindings. bindings reverseDo: [:varRef | (Dialog confirm: ((#DoYouWantToRemove1sQ << #dialogs >> 'Are you certain that you<n>want to remove <1s>?') expandMacrosWith: varRef asString) for: self interfaceWindow) ifTrue: [(varRef subrequisites size = 0 or: [Dialog confirm: ((#HasDependentObjectsRemoveItAnywayQ << #dialogs >> '<1s> has dependent objects. Remove it anyway?') expandMacrosWith: varRef asString) for: self interfaceWindow]) ifTrue: [parentEvironment := varRef environment. varRef removeFromSystem. module updateListFull.]]]. self browser setAndUpdateEnvironment: parentEvironment. module list toggleSelection. ^false
renameAs | aString newName | self changeRequest ifFalse: [^self]. aString := self prompt: (#EnterNewName << #dialogs >> 'Enter new name') initially: self selection name asString. aString = '' ifTrue: [^self]. aString := SystemUtils validateStaticVariableName: aString for: self interfaceWindow. aString == nil ifTrue: [^self]. newName := aString asSymbol. SmalltalkWorkbench rename: module selection to: newName do: [:cls :nm | module select: cls whenFinished: [module updateList]] for: self interfaceWindow browser: self browser
spawn self selectionIsSymbol ifTrue: [^self]. self selectionIsClass ifTrue: [^super spawn]. self selectionIsNamespace ifTrue: [self browser spawnOnNameSpace: module selection]
</methods> <methods> Tools.HierarchyBrowserHelper <category>text processing</category>
acceptText: text from: textController "Indicate that we didn't even try." ^self selection == nil ifTrue: [nil] ifFalse: [self acceptDefinition: text from: textController]
text | item | ^( item := self selectedNameSpace ) == nil ifTrue: [ Text new ] ifFalse: [ item definition asText ]
updateListForDefinedThing: thing thing isForNameSpace ifTrue:[self module updateList]. self module selection: (thing isForNameSpace ifTrue:[thing] ifFalse:[thing environment]). module nextModule updateListForDefinedThing: thing
</methods> <methods> Tools.HierarchyBrowserHelper <category>accessing</category>
selectedNameSpace ^self selection == nil ifTrue: [ nil ] ifFalse: [ self selection isSymbol ifTrue: [ Root ] ifFalse: [ self selection ] ]
windowLabel ^(#NameSpaceHierarchyBrowserOn1p << #dialogs >> 'NameSpaceHierarchy Browser on <1p>') expandMacrosWith: self selection value
</methods> <methods> Tools.HierarchyBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#environment
</methods> <methods> Tools.HierarchyBrowserHelper <category>drag and drop</category>
canAcceptDropFrom: aDC ^false
</methods> <methods> Tools.HierarchyBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Namespace << #menus >> '&Namespace') asString
</methods> <methods> Tools.NameSpaceHierarchyBrowserHelper <category>list accessing</category>
intializeListFull | tree | tree := AssociationTreeWithParent key: (#Filters << #dialogs >> 'Filters') value: #filters. self addNamespaceTreeToTree: tree. module setNewListSilently: tree. "Lets be nice and show all namespaces within Smalltalk" module list deepOpenCurrentTo:3.
selectionIsClass ^self selection isBehavior
updateListFull | tree | tree := AssociationTreeWithParent key: (#Filters << #dialogs >> 'Filters') value: #filters. self addNamespaceTreeToTree: tree. module setNewList: tree
</methods> <methods> Tools.NameSpaceHierarchyBrowserHelper <category>drag and drop</category>
canAcceptDropFrom: aDC ^aDC key == self classOrNamespaceKey
drop: aDragContext "A drop has occured in the Namespace l list of the browser. see if we can accept and if so move the class(es)." | ctrl idx cNameArray | (self canAcceptDropFrom: aDragContext) ifFalse:[^#dragEffectNone ]. self browser changeRequest ifFalse: [^#dropEffectNone]. "Locate the target namspace's index" ctrl := aDragContext clientData at: #ctrl. idx := ctrl view targetIndex. idx = 0 ifTrue: [^#dropEffectNone]. "If the data is not available in the correct format, do not drop." cNameArray := aDragContext sourceData clientData at: self classOrNamespaceKey ifAbsent: [^#dropEffectNone]. "Move the class or namspace to the new Namespace" "The class name is in the clientData of the dropSource" cNameArray do:[:eachCName | eachCName relocateTo: (self module list selectionForIndex: idx). ChangeSet changeClass: eachCName ]. "Restore the state of the list before leaving." self restoreListStateFrom: aDragContext clientData. aDragContext clientData: nil. self nextModule updateList. ^#dropEffectMove
</methods> <methods> Tools.NameSpaceHierarchyBrowserHelper <category>text processing</category>
doItEnvironment | selection | (selection := self selection) isNil ifTrue: [^nil]. ^selection environment = Root ifTrue: [self defaultEnvironment] ifFalse: [selection environment]
doItReceiver "The receiver's selection can be nil, and that is an acceptable receiver for evaluation." ^self selection
</methods> <methods> Tools.FullSystemBrowser <category>text processing</category>
batchUpdates: aBlock | old | old := inBatchMode. inBatchMode := true. aBlock ensure: [inBatchMode := old]. old ifFalse: [self updateText].
doItEnvironment "Answer the object that should be informed of the result of evaluating a text selection." ^self tryAll: [:c | c doItEnvironment] default: [ nil]
doItReceiver "Answer the object that should be informed of the result of evaluating a text selection." ^self tryAll: [:c | c doItReceiver] default: [nil]
explainSpecial: string for: explainer "Answer with a string explaining the code view selection if it is displaying one of the special edit functions." ^nil
text ^text
textAccepted: textController "First try the receiver's components to see if any of them can accept this text." | compilerClass result | result := self tryAll: [:c | c acceptText: textController text from: textController] default: [nil]. result notNil ifTrue: [^self]. "None of the Helpers could do anything with it." compilerClass := (self selectedClassOrNameSpaceFor: #default) isNil ifTrue: [self class compilerClass] ifFalse: [(self selectedClassOrNameSpaceFor: #default) compilerClass]. compilerClass evaluate: textController text notifying: textController logged: true
textAction: aMessage self currentTextEditor dispatchMenuSelection: aMessage
textCancelled self updateText
updateText | sel tv | text value: (self tryAll: [:c | c text] default: [Text new]). (sel := components first initialSelection) == nil ifFalse: [builder == nil ifFalse: [tv := (builder componentAt: #text) widget. tv deselect. tv controller find: sel. tv displaySelection: true. tv selectAndScroll]]
</methods> <methods> Tools.FullSystemBrowser <category>components</category>
broadcastUpdate: aspect self components first broadcastUpdate: aspect
component1 ^self visibleComponentAt: 1
component2 ^self visibleComponentAt: 2
component3 ^self visibleComponentAt: 3
component4 ^self visibleComponentAt: 4
component5 ^self visibleComponentAt: 5
list1 ^self component1 listSpec
list2 ^self component2 listSpec
list3 ^self component3 listSpec
list4 ^self component4 listSpec
list5 ^self component5 listSpec
menuBar | menu | menu := Menu new addPart: self class menuBarStart. coordinator == nil ifFalse: [coordinator buildMenuBar: menu]. components do: [:comp | comp buildMenuBar: menu]. menu addPart: self class menuBarEnd. (menu atNameKey: #edit) submenu: self remoteTextMenu. (menu atNameKey: #view) submenu: [self viewMenu]. ^menu
resetToolBar | menu | menu := Menu new. coordinator == nil ifFalse: [coordinator buildToolBar: menu]. components do: [:comp | comp buildToolBar: menu]. toolBar value: menu
toolBar toolBar value == nil ifTrue: [self resetToolBar]. ^toolBar
viewMenu | menu | menu := Menu new. coordinator == nil ifFalse: [coordinator buildViewMenu: menu]. components do: [:comp | comp buildViewMenu: menu]. ^menu
windowLabel ^components isEmpty ifTrue: [(#SystemBrowser << #labels >> 'System Browser')] ifFalse: [components first windowLabel]
</methods> <methods> Tools.FullSystemBrowser <category>private-components</category>
allCategoriesComponent ^SimpleBrowserModule new helpers: (Array with: (NameSpaceOrganizerBrowserHelper new searchChildNamespaces: true) ).
allClassesComponent ^SimpleBrowserModule new helperType: NameSpaceGlobalCategoryBrowserHelper; yourself
categoriesComponent ^SimpleBrowserModule new helperType: NameSpaceOrganizerBrowserHelper.
classesComponent ^SimpleBrowserModule new helperType: NameSpaceCategoryBrowserHelper; yourself
classHierarchyComponent ^SimpleBrowserModule new helperType: ClassHierarchyBrowserHelper; yourself
currentTextEditor "A subclass with more than one text widget needs to override this to answer the controller of the one that is currently being used, or nil. This is needed by commands that work on the current text selection, such as 'Explain' or 'Format'." ^(builder componentAt: #text) widget controller
parcelsComponent "do a parcels componet later ight now return the systems Component because it handles everything" | comp | comp := self systemComponent. comp currentHelper attribute: #parcel. ^comp.
protocolsComponent ^SimpleBrowserModule new specName: #listSpecProtocols; helperType: ProtocolBrowserHelper; yourself
selectorsComponent ^SimpleBrowserModule new helperType: SelectorBrowserHelper; yourself
systemComponent ^HierarchicalBrowserModule new helperType: HierarchyBrowserHelper
systemNotebookComponent ^HierarchicalBrowserModule new helperType: HierarchyBrowserHelper
</methods> <methods> Tools.FullSystemBrowser <category>selections</category>
behaviorStatus: aBehavior currentParcel: aParcel "Compute the status for a Behavior (class or metaclass)." | parcels status definedCount extendedCount | status := Set new: 4. aBehavior isNil ifTrue: [^status "shouldn't happen"]. parcels := self manager parcelsForClassOrNameSpace: aBehavior. nil == parcels ifFalse: [definedCount := extendedCount := 0. parcels do: [:parcel| (parcel definesClass: aBehavior) ifTrue: [definedCount := definedCount + 1. status add: (parcel == aParcel ifTrue: [#defined] ifFalse: [#definedByOther]). (parcel == aParcel and: [| defined selectors | "This is a performance-critical piece of code since it dominates computing category emphases for categories that are entirely defined by a Parcel. Hence there is some effort to optimize the comparison of defined and implemented selectors." defined := parcel definedSelectorsFor: aBehavior. selectors := aBehavior organization elements. defined size = selectors size and: [nil == (selectors detect: [:sel| (defined includes: sel) not] ifNone: [])]]) ifTrue: [status add: #entirelyDefined]]. (parcel extendsBehavior: aBehavior) ifTrue: [extendedCount := extendedCount + 1. status add: (parcel == aParcel ifTrue: [#extended] ifFalse: [#extendedByOther])]]. (definedCount > 1 "more than one parcel defines the behavior" or: [definedCount + extendedCount > 1 "may be multiply parcelled selectors - go check" and: [(self computeConflictsFor: (Array with: aBehavior) within: nil) first size > 0]]) ifTrue: [status add: #conflict]]. ^status
classNameStatus: aClass environment: environment currentParcel: aParcel "Compute the status for a class name (class and its metaclass)." | classStatus metaclassStatus entirelyDefined | aClass isForClass ifFalse: [^self definedThingStatus: aClass currentParcel: aParcel]. classStatus := self behaviorStatus: aClass currentParcel: aParcel. metaclassStatus := self behaviorStatus: aClass class currentParcel: aParcel. entirelyDefined := (classStatus includes: #entirelyDefined) and: [metaclassStatus includes: #entirelyDefined]. classStatus addAll: metaclassStatus. entirelyDefined ifFalse: [classStatus remove: #entirelyDefined ifAbsent: nil]. ^classStatus
selected: attribute for: id "Answer the currently selected value for an attribute within an id." | selection | selection := selectionDictionary at: id ifAbsent: [ id == #default ifFalse: [ ^self selected: attribute for: #default ] ] . ^selection isNil ifTrue: [nil ] ifFalse:[ selection at: attribute ifAbsent: [ id == #default ifFalse: [ self selected: attribute for: #default ] ]].
selectedCategoryFor: id "Answer the currently selected category within an id." ^self selected: #category for: id
selectedClassOrNameSpaceFor: id "Answer the currently selected class within an id." ^self selected: #classOrNameSpace for: id.
selectedEnvironment ^self selectedNameSpaceFor: #default
selectedMethodFor: id "Answer the currently selected method within an id." ^self selected: #method for: id
selectedNameSpaceFor: id "Answer the currently selected namespace within an id." ^self selected: #environment for: id
selectedParcelFor: id "Answer the currently selected parcel within an id." ^self selected: #parcel for: id
selectedProtocolFor: id "Answer the currently selected protocol within an id." ^self selected: #protocol for: id
setCategoryFor: id to: aValue "Set the currently selected category within an id." ^self setSelection: #category for: id to: aValue
setClassOrNameSpaceFor: id to: aValue "Set the currently selected class within an id." ^self setSelection: #classOrNameSpace for: id to: aValue
setMethodFor: id to: aValue "Set the currently selected method within an id." ^self setSelection: #method for: id to: aValue
setNameSpaceFor: id to: aValue "Set the currently selected namespace within an id." ^self setSelection: #environment for: id to: aValue
setParcelFor: id to: aValue "Set the currently selected parcel within an id." ^self setSelection: #parcel for: id to: aValue
setProtocolFor: id to: aValue "Set the currently selected method within an id." ^self setSelection: #protocol for: id to: aValue
setSelection: attribute for: id to: aValue ^( selectionDictionary at: id ifAbsentPut: [ IdentityDictionary new ] ) at: attribute put: aValue
</methods> <methods> Tools.FullSystemBrowser <category>accessing</category>
browser ^self
componentDictionary ^componentDictionary isNil ifTrue:[componentDictionary := Dictionary new] ifFalse:[componentDictionary ]
components ^components
coordinator ^coordinator
defType ^defType
disableBatchUpdates ^disableBatchUpdates isNil ifTrue:[ disableBatchUpdates := false] ifFalse:[disableBatchUpdates]
ignoreNamepaceChanges ^ignoreNamepaceChanges isNil ifTrue:[ignoreNamepaceChanges := false] ifFalse:[ignoreNamepaceChanges ]
ignoreNamepaceChanges: aBooleen ignoreNamepaceChanges := aBooleen
meta ^meta
remoteTextMenu | menu | menu := self textMenu. menu menuItems do: [:item | | action | action := item value. item value: [:cntrl | cntrl performer textAction: action]]. ^menu
setAndUpdateEnvironment: anEnvironment self ignoreNamepaceChanges ifFalse: [ self setNameSpaceFor: #default to: anEnvironment ]
spawningBrowser ^FullSystemBrowser new
textMenu ^Menu new addPart: self class editGroup; addPart: self class evaluateGroup; addPart: (self class acceptCancel: #(#accept #textCancelled)); addPart: self class textMenuExtras; addPart: self class hardcopyGroup; yourself
</methods> <methods> Tools.FullSystemBrowser <category>initialize</category>
components: aList components := aList. self linkComponents
initialize super initialize. inBatchMode := false. components := List new. text := String new asValue. meta := #instance asValue. meta onChangeSend: #updateProtocolLists to: self. defType := #showDefinition asValue. defType onChangeSend: #updateText to: self. toolBar := nil asValue. selectionDictionary := IdentityDictionary new. self initializeForNameSpace: Smalltalk.
initializeForAllNameSpaces self setNameSpaceFor: #default to: Root. self ignoreNamepaceChanges: true. components := List new. components add: self allCategoriesComponent. components add: self allClassesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents
initializeForClass: aClass self meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). components := List new. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self setClassOrNameSpaceFor: #default to: aClass. self linkComponents. components first forceSelection: aClass; updateList
initializeForClass: aClass protocol: aProtocol self meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). components := List new. components add: self protocolsComponent. components add: self selectorsComponent. self setClassOrNameSpaceFor: #default to: aClass. self setProtocolFor: #default to: aProtocol. self linkComponents. components first forceSelection: aProtocol; updateList
initializeForClassHierarchy: aClass | cls | self meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). cls := aClass instanceBehavior. self setClassOrNameSpaceFor: #default to: aClass. components := List new. components add: self classHierarchyComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents. components first selection: cls
initializeForMethodsLabel: labelString list: aCollection initialSelection: selector | helper module | helper := MethodListBrowserHelper new. helper label: labelString; baseList: aCollection asList; initialSelection: selector. module := SimpleBrowserModule new helpers: (Array with: helper). components := List new. components add: module. self linkComponents
initializeForNameSpace: aNameSpace components := List new. self setNameSpaceFor: #default to: aNameSpace. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents
initializeForNameSpace: aClassOrNameSpace protocol: aProtocol | cns | self meta value: #instance. components := List new. components add: self protocolsComponent. components add: self selectorsComponent. cns := aClassOrNameSpace asNameSpace namedReferent. "just checking" self setClassOrNameSpaceFor: #default to: cns. self setProtocolFor: #default to: aProtocol. self linkComponents. components first forceSelection: aProtocol; updateList
initializeForNameSpaces components := List new. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents
initializeForNameSpaces: aNameSpace category: aCategory components := List new. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self setNameSpaceFor: #default to: aNameSpace. self setCategoryFor: #default to: aCategory. self linkComponents. components first forceSelection: aCategory; updateList
initializeForParcels components := List new. components add: self parcelsComponent. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents. components first updateList
initializeForSystem components := List new. components add: self systemComponent. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponents. components first updateList
release | oldBrowserSize | meta removeDependent: self. defType removeDependent: self. "If closing the last browser, which might be part of a packaging step, release all the menus that are stored in class variables. Allow for the possibility that RB is missing. If old browsers are missing then this code shouldn't exist any more " #{Refactory.Browser.RefactoringBrowser} ifDefinedDo: [:rb | "First, do the cheapest test" Screen default allScheduledControllersDo: [:each | each model class == rb ifTrue: [^self]]. rb allInstances size > 0 ifTrue: [^self]]. oldBrowserSize := FullSystemBrowser allGeneralInstances size. oldBrowserSize <= 1 ifTrue: [BrowserHelper flushMenus]
</methods> <methods> Tools.FullSystemBrowser <category>coordination</category>
computeDisplayString: aThing ^coordinator == nil ifTrue: [aThing simpleDisplayString] ifFalse: [coordinator computeDisplayString: aThing]
getListMenuFor: aHelper "Answer the listMenu for a particular helper, or nil" ^listMenuMap ~~ nil ifTrue: [listMenuMap at: aHelper class ifAbsent: []]
getMenuBarMenuFor: aHelper "Answer the menuBarMenu for a particular helper, or nil" ^menuBarMenuMap ~~ nil ifTrue: [menuBarMenuMap at: aHelper class ifAbsent: []]
setListMenu: aMenu for: aHelper "Set the listMenu for a particular helper, or nil" listMenuMap == nil ifTrue: [listMenuMap := IdentityDictionary new]. listMenuMap at: aHelper class put: aMenu
setMenuBarMenu: aMenu for: aHelper "Set the menuBarMenu for a particular helper, or nil" menuBarMenuMap == nil ifTrue: [menuBarMenuMap := IdentityDictionary new]. menuBarMenuMap at: aHelper class put: aMenu
</methods> <methods> Tools.FullSystemBrowser <category>spawning</category>
spawnForMethodsLabel: aLabel list: list initialSelection: selection |newBrowser| newBrowser := self spawningBrowser. newBrowser initializeForMethodsLabel: aLabel list: list initialSelection: selection. list size = 1 ifTrue: [newBrowser components first forceSelection: list first. newBrowser updateLists]. newBrowser open
spawnOnClass: aClass | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForClass: aClass. newBrowser open.
spawnOnClass: aClass protocol: aSelection | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForClass: aClass protocol: aSelection. newBrowser open.
spawnOnClassHierarchy: aClass | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForClassHierarchy: aClass. newBrowser open.
spawnOnNameSpace: aNamespace | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForNameSpace: aNamespace. newBrowser open
spawnOnNameSpace: aClassOrNameSpace protocol: aSelection | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForNameSpace: aClassOrNameSpace protocol: aSelection. newBrowser open.
spawnOnNameSpaces: aNamespace category: aCategory | newBrowser | newBrowser := self spawningBrowser. newBrowser initializeForNameSpaces: aNamespace category: aCategory. newBrowser open.
tearOffMethod: methodDefinition | newBuilder targetEditor sourceEditor | sourceEditor := self currentTextEditor. sourceEditor isNil ifTrue: [^self]. newBuilder := TabApplicationSystemBrowser initializeForMethodsLabel: methodDefinition printString list: (List with: methodDefinition) initialSelection: methodDefinition with: NamespaceTabApplication. targetEditor := newBuilder source currentTextEditor. targetEditor view editText: sourceEditor view displayContents. sourceEditor accepted ifFalse: [targetEditor notAccepted]. self textCancelled
</methods> <methods> Tools.FullSystemBrowser <category>actions</category>
displayHelp VisualLauncher openHelpBrowser
explain "Try to shed some light on what kind of entity the controller's current selection is. The selection must be a single token or construct." | aController | aController := self currentTextEditor. aController isNil ifTrue: [^self]. self components reverseDo: [:c | c selection notNil ifTrue: [^c explainFor: aController]]. "Nobody cares, but try to explain at least something." Explainer explain: aController selection string for: self
format "Format the text view's text." | aController | aController := self currentTextEditor. aController isNil ifTrue: [^self]. self components reverseDo: [ :c | c selection notNil ifTrue: [ ^c formatFor: aController ] ].
metaOff self changeRequest ifFalse: [ ^self ]. meta value: #instance
metaOn self changeRequest ifFalse: [ ^self ]. meta value: #class
metaShowData self changeRequest ifFalse: [ ^self ]. meta value: #data
metaShowDataSilently meta retractInterestsFor: self. meta value: #data. meta onChangeSend: #updateProtocolLists to: self.
module: moduleName action: action (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator perform: action]. components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
module: moduleName action: action with: value (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator dispatch: action with: value]. components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action with: value]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
showComment self defType value: #showComment
showDefinition self defType value: #showDefinition
showHierarchy self defType value: #showHierarchy
tearOff "Tearing off is a special kind of spawning that creates a new standalone browser on the method, with unsaved code changes if any, and cancels any code changes in the debugger." | selectorHelper selection methodDefinition | selectorHelper := self components last currentHelper. selection := selectorHelper selection. selection isNil ifTrue: [^self]. methodDefinition := selectorHelper definitionOf: selection. methodDefinition notNil ifTrue: [self tearOffMethod: methodDefinition]
truePerformerFor: moduleName "Answer the module that is responsible for performing menu actions for moduleName. Answer the receiver if none." ( coordinator notNil and: [ coordinator menuHeader = moduleName ] ) ifTrue: [ ^coordinator ]. components do: [ :comp | comp menuHeader = moduleName ifTrue: [ ^comp ] ]. ^nil
updateLists components first updateList
updateMeta self changeRequest ifFalse: [ ^self ]. self updateLists.
</methods> <methods> Tools.FullSystemBrowser <category>testing</category>
isClass ^meta value == #class
isData ^meta value == #data
isInstance ^meta value == #instance
isMeta ^meta value == #class
</methods> <methods> Tools.FullSystemBrowser <category>copying</category>
postCopy super postCopy. builder := nil. inBatchMode := false. text := text value asValue. meta := meta value asValue. meta onChangeSend: #updateProtocolLists to: self. defType := defType value asValue. defType onChangeSend: #updateText to: self. toolBar := nil asValue. self components: (self components collect: [:i | i copy]).
</methods> <methods> Tools.FullSystemBrowser <category>events</category>
noticeOfWindowClose: aWindow ^self release
</methods> <methods> Tools.FullSystemBrowser <category>change</category>
updateButtonLabels
updateProtocolLists self components size > 3 ifTrue:[(self components at: (self components size - 2 )) updateList ] ifFalse:[self updateLists ]
updateWindowLabel (builder notNil and: [builder window notNil]) ifTrue: [builder window label: self windowLabel]
</methods> <methods> Tools.FullSystemBrowser <category>private</category>
changeRequest | w | builder == nil ifTrue: [^true]. w := builder componentAt: #text. ^w == nil or: [w widget updateRequest]
fileEncoding ^#Source
interfaceName ^#(windowSpec0 windowSpec1 windowSpec2 windowSpec3 windowSpec4 windowSpec5) at: self numberOfLists+1
interfaceWindow ^self builder == nil ifTrue: [nil] ifFalse: [self builder window]
labelFor: aKey "Return an instance of a non-abstract subclass of CharacterArray, that will be used as a label for a widget. Check the label registry if no implementation has been provided." ^self application messageNotUnderstoodSignal handle: [:ex | | sel | sel := ex parameter selector. (sel == aKey) ifTrue: [ex returnWith: (self application labelFor: aKey)] ifFalse: [ex reject]] do: [self perform: aKey].
linkComponents 1 to: components size-1 do: [:i | (components at: i) browser: self; nextModule: (components at: i+1)]. components last browser: self. self updateLists
methodCollector ^MethodCollector new browser: self
model: aValueHolder choose: aValue ^(PluggableAdaptor on: aValueHolder) getBlock: [:b | b value = aValue] putBlock: [:b :v | b value: aValue] updateBlock: [:b :a :p | true]
numberOfLists | n | n := coordinator == nil ifTrue: [0] ifFalse: [coordinator numberOfLists]. ^components inject: n into: [:i :comp | i + comp numberOfLists]
openInterface "Open the ApplicationModel's user interface, using the specification resource of the standard name." ^self openInterface: self interfaceName
postBuildWith: aBuilder (aBuilder componentAt: #text) widget controller autoAccept: false; supportCodeEditingFeels: true; flushFeels.
specificationFor: aKey ^self perform: aKey
tryAll: testBlock default: defaultBlock components reverseDo: [:comp | | val | val := testBlock value: comp. val == nil ifFalse: [^val]]. ^defaultBlock value
visibleComponentAt: index | n | n := 0. coordinator == nil ifFalse: [n := n + coordinator numberOfLists. n >= index ifTrue: [^coordinator]]. components do: [:comp | n := n + comp numberOfLists. n >= index ifTrue: [^comp]]. ^self error: ((#Component1pNotFound << #dialogs >> 'Component <1p> not found') expandMacrosWith: index)
</methods> <methods> Tools.FullSystemBrowser <category>selection utlity</category>
selectBehavior: aBehavior (self components at: (components size - 2)) currentHelper selectBehavior:aBehavior
selectCategory: aCategory (self components at: (components size - 3)) currentHelper selectCategory: aCategory
selectMethod: aSymbol (self components at: (components size)) currentHelper selectMethod: aSymbol
selectProtocol: aProtocol (self components at: (components size - 1)) currentHelper selectProtocol:aProtocol
</methods> <methods> Tools.FullSystemBrowser class <category>private</category>
interfaceSpecFor: aSymbol | spec | spec := super interfaceSpecFor: aSymbol. spec window toolBar: #toolBar. ^spec
isVisualStartable "Used by UIFinder to divine that the application will respond to Start" ^true
listBrowserClass ^FullSystemBrowser
openOn: anInstance "Create a running instance of the application and open its user interface using the specification resource of the standard name." ^self openOn: anInstance withSpec: anInstance interfaceName
</methods> <methods> Tools.FullSystemBrowser class <category>resources</category>
acceptCancel: values | menu | menu := self acceptCancel. menu menuItems with: values do: [:it :val | it value: val]. ^menu
</methods> <methods> Tools.FullSystemBrowser class <category>actions</category>
openOnAllNamespaces " self openOnAllNamespaces" ^self new initializeForAllNameSpaces; open
openOnNameSpace: aNameSpace "self openOnNameSpace: TeamWorks" ^self new initializeForNameSpace: aNameSpace; open.
</methods> <methods> Tools.FullSystemBrowser class <category>interface specs</category>
windowSpec ^self windowSpec4
</methods> <methods> Tools.FullNotebookSystemBrowser <category>components</category>
broadcastUpdate: aspect self currentSubCanvas broadcastUpdate: aspect
menuBar | menu | menu := Menu new addPart: self class menuBarStart. coordinator == nil ifFalse: [coordinator buildMenuBar: menu]. self currentSubCanvas notNil ifTrue:[self currentSubCanvas buildMenuBar: menu.]. components do: [:comp |comp buildMenuBar: menu]. menu addPart: self class menuBarEnd. (menu atNameKey: #edit) submenu: self remoteTextMenu. (menu atNameKey: #view) submenu: [self viewMenu]. ^menu
menuBarForCategories | menu | menu := Menu new addPart: self class menuBarStart. coordinator == nil ifFalse: [coordinator buildMenuBar: menu]. self currentTabApplication categoryTabCanvas notNil ifTrue:[self currentTabApplication categoryTabCanvas buildMenuBar: menu.]. components do: [:comp |comp buildMenuBar: menu]. menu addPart: self class menuBarEnd. (menu atNameKey: #edit) submenu: self remoteTextMenu. (menu atNameKey: #view) submenu: [self viewMenu]. ^menu
resetToolBar | menu menuBar | self builder isNil ifTrue:[ ^self]. menu := self menuBar. menuBar := self builder window keyboardProcessor menuBar. menuBar menuChannel: menu.
resetToolBarForCategories | menu menuBar | self builder isNil ifTrue:[ ^self]. menu := self menuBarForCategories. menuBar := self builder window keyboardProcessor menuBar. menuBar menuChannel: menu.
viewMenu | menu | menu := Menu new. self labelApplicationDictionary keysAndValuesDo: [ :key :appTab | appTab buildToolBar: menu ]. currentTabApplication buildViewMenu: menu. ^menu
windowLabel ^self currentTabApplication notNil ifTrue:[self currentTabApplication windowLabel] ifFalse:[(#FullSystemBrowser << #labels >> 'Full System Browser') ]
</methods> <methods> Tools.FullNotebookSystemBrowser <category>change</category>
changedMajorTab | tabApplication | self majorTabs selection isNil ifTrue: [^nil]. self selectionIsTabApplicationCategory ifTrue: [self updateMajorTabsListFor: self currentTabApplication. self setSubCanvasToCategory. self resetToolBarForCategories] ifFalse: [tabApplication := self tabApplicationForLabel: self majorTabs selection. self updateMajorTabsListFor: tabApplication. self currentTabApplication notNil ifTrue: [self currentTabApplication swapIn]. self currentTabApplication: tabApplication. self currentTabApplication swapOut. self setSubCanvas. self swapoutVisualComponents. self resetToolBar. self updateWindowLabel. self currentTabApplication refreshLists]
selectionIsTabApplicationCategory ^(self labelApplicationDictionary detect: [:ea | ea label = self majorTabs selection or: [self majorTabs selection = 'Root']] ifNone: [nil]) isNil
setSubCanvas self currentSubCanvas notNil ifTrue: [ self currentSubCanvas updateForSwapOut ]. self setSubCanvas: self currentSubCanvas spec: self currentTabApplication subCanvasSpec.
setSubCanvasToCategory self currentSubCanvas notNil ifTrue: [ self currentSubCanvas updateForSwapOut ]. self setSubCanvas: self currentTabApplication categoryTabCanvas spec: self currentTabApplication categoryTabCanvas specName.
swapoutVisualComponents | theSelection componentList tabApplication | (self builder isNil or: [(theSelection := self majorTabs selection) isNil]) ifTrue: [^self]. tabApplication := self tabApplicationForLabel: theSelection. componentList := tabApplication rightHandComponents. 1 to: componentList size do: [:index | | widgetWrapper compsubcanvas compClient | (widgetWrapper := self builder componentAt: (self componentIDs at: index)) notNil ifTrue: [compsubcanvas := widgetWrapper widget. compClient := componentList at: index. compClient builder isNil ifTrue: [compsubcanvas client: compClient spec: compClient specName] ifFalse: [compsubcanvas client: compClient spec: compClient specName builder: compClient builder]]]. components := componentList
updateButtonLabels self updateMajorTabsListFor: self currentTabApplication
updateMajorTabsList | newLabels newIcons | newLabels := self labels asOrderedCollection. newLabels add: (self currentTabApplication notNil ifTrue: [self currentTabApplication categoriesLabel] ifFalse: [(#NoCategories << #labels >> 'No Categories')]). newIcons := self icons. newIcons add: self currentTabApplication categoryIcon. self majorTabs setListSilently: newLabels
updateMajorTabsListFor: tabApplication | newLabels newIcons | newLabels := self labels asOrderedCollection. newLabels add: tabApplication categoriesLabel. newIcons := self icons. newIcons add: tabApplication categoryIcon. self majorTabs setListSilently: newLabels. self builder isNil ifTrue: [^self]. (self builder componentAt: #notebook) widget icons: newIcons; setNewLabelsSilently.
updateParcelLists self currentTabApplication updateLists
</methods> <methods> Tools.FullNotebookSystemBrowser <category>notebook accessing</category>
currentSubCanvas ^self currentTabApplication isNil ifTrue: [nil] ifFalse: [self currentTabApplication canvas]
currentTabApplication ^currentTabApplication
currentTabApplication: aValue currentTabApplication := aValue
icons ^(self labelApplicationDictionary collect: [:ea | ea icon]) asOrderedCollection
labels ^(self labelApplicationDictionary collect: [:ea | ea label]) asOrderedCollection
nameSpaceTabApps ^self labelApplicationDictionary select: [ :ea | ea isNamspaceTabApp ]
subCanvases ^(labelApplicationDictionary collect: [:eachTabApp | eachTabApp canvas]) asOrderedCollection
</methods> <methods> Tools.FullNotebookSystemBrowser <category>accessing</category>
componentIDs ^#(#component1#component2 #component3 #component4)
getLabelApplicationDictionary | dict | dict := Dictionary new. self tabApplications do:[:each | dict at: each label put:(each newOnBrowser: self)]. ^dict
labelApplicationDictionary ^labelApplicationDictionary
labelApplicationDictionary: aDictionary labelApplicationDictionary := aDictionary
searchChildNamespaces ^searchChildNamespaces isNil ifTrue:[searchChildNamespaces := false] ifFalse:[searchChildNamespaces]
searchChildNamespaces: aBooleen searchChildNamespaces := aBooleen
setAndUpdateEnvironment: anEnvironment self setNameSpaceFor: #default to: anEnvironment. self nameSpaceTabApps do:[:each | each canvas selection: anEnvironment].
tabApplications ^tabApplications
tabApplications: aDictionary tabApplications := aDictionary
</methods> <methods> Tools.FullNotebookSystemBrowser <category>private</category>
areConnectedAndSelected ^true
resetTabs | oldSelection newLabels | oldSelection := self majorTabs selection. newLabels := self labels asOrderedCollection. newLabels add: (self currentTabApplication notNil ifTrue:[self currentTabApplication categoriesLabel] ifFalse:[ (#NoCategories << #labels >> 'No Categories')]). self majorTabs list: newLabels. (newLabels includes: oldSelection) ifTrue: [ self majorTabs selection: oldSelection ]. self majorTabs selection isNil ifTrue: [ self majorTabs selectionIndex: 1 ]. self changedMajorTab
setSubCanvas: aClient spec: aSymbol | localClient localSymbol notebookSubcanvas | self builder isNil ifTrue: [^self]. localClient := aClient. localSymbol := aSymbol. notebookSubcanvas := (self builder componentAt: #notebook) widget. localClient builder isNil ifTrue: [notebookSubcanvas client: localClient spec: localSymbol] ifFalse: [notebookSubcanvas client: localClient spec: localSymbol builder: localClient builder]. localClient postOpenWith: localClient builder
setSubCanvas: aClient withSpec: aSpec self currentSubCanvas notNil ifTrue: [ self currentSubCanvas updateForSwapOut ]. self setSubCanvas: aClient spec: aSpec.
tabApplicationForLabel: aString ^self labelApplicationDictionary detect: [:ea | ea label = aString] ifNone: [self labelApplicationDictionary detect: [:ea | ea isNamspaceTabApp]]
tryAll: testBlock default: defaultBlock components reverseDo: [:comp | | val | val := testBlock value: comp. val == nil ifFalse: [^val]]. self currentSubCanvas isNil ifFalse: [|val| val := testBlock value: self currentSubCanvas. val == nil ifFalse: [^val]]. ^defaultBlock value
</methods> <methods> Tools.FullNotebookSystemBrowser <category>aspects</category>
majorTabs "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^majorTabs isNil ifTrue: [majorTabs := ColorTextSelectionInList new] ifFalse: [majorTabs]
</methods> <methods> Tools.FullNotebookSystemBrowser <category>interface opening</category>
interfaceName ^#windowSpec5
postOpenWith: aBuilder | old | super postOpenWith: aBuilder. disableBatchUpdates := true. [ self changedMajorTab ] ensure: [ disableBatchUpdates := false ]. old := self currentTabApplication. [self labelApplicationDictionary do: [:each | self currentTabApplication: each. each intializeListFull. self updateMajorTabsListFor: self currentTabApplication]] ensure: [self currentTabApplication: old]
</methods> <methods> Tools.FullNotebookSystemBrowser <category>actions</category>
displayAboutBox self notYetImplemented
module: moduleName action: action (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator perform: action]. self currentSubCanvas menuHeader = moduleName ifTrue: [^self currentSubCanvas dispatch: action]. self categoryTabCanvas menuHeader = moduleName ifTrue: [^self categoryTabCanvas dispatch: action]. components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
module: moduleName action: action with: value (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator dispatch: action with: value]. self currentSubCanvas menuHeader = moduleName ifTrue: [^self currentSubCanvas dispatch: action with: value]. self categoryTabCanvas menuHeader = moduleName ifTrue: [^self currentSubCanvas dispatch: action ]. components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action with: value]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
toggleNamespaceList self currentTabApplication isNamspaceTabApp ifTrue:[self currentTabApplication canvas list toggleSelection]
truePerformerFor: moduleName "Answer the module that is responsible for performing menu actions for moduleName. Answer the receiver if none." self currentSubCanvas menuHeader = moduleName ifTrue:[^self currentSubCanvas ]. self categoryTabCanvas menuHeader = moduleName ifTrue: [^self categoryTabCanvas ]. components do: [ :comp | comp menuHeader = moduleName ifTrue: [ ^comp ] ]. ^nil
updateAllCanvases | old | old := self currentTabApplication. [self labelApplicationDictionary do: [:each | self currentTabApplication: each. each updateList]] ensure: [self currentTabApplication: old]
updateNamespaceListFull | old | old := self currentTabApplication. [self labelApplicationDictionary do: [:each | each isNamspaceTabApp ifTrue: [each updateList]]] ensure: [self currentTabApplication: old]. self updateMajorTabsList
</methods> <methods> Tools.FullNotebookSystemBrowser <category>text processing</category>
batchUpdates: aBlock | old | self disableBatchUpdates ifTrue:[^self]. old := inBatchMode. inBatchMode := true. aBlock ensure: [inBatchMode := old]. old ifFalse: [self updateText].
</methods> <methods> Tools.FullNotebookSystemBrowser <category>spawning</category>
spawnForMethodsLabel: aLabel list: list initialSelection: selection self currentTabApplication spawnForMethodsLabel: aLabel list: list initialSelection: selection with: self currentTabApplication
spawnOnClass: aClass self currentTabApplication spawnOnClass: aClass with: self currentTabApplication
spawnOnClass: aClass protocol: aSelection self currentTabApplication spawnOnClass: aClass with: self currentTabApplication protocol: aSelection
spawnOnClassHierarchy: aClass self currentTabApplication spawnOnClassHierarchy: aClass with: self currentTabApplication
spawnOnNameSpace: aNamespace self currentTabApplication spawnOnNameSpace: aNamespace with: self currentTabApplication
spawnOnNameSpaces: aNamespace category: aCategory self currentTabApplication spawnOnNameSpace: aNamespace with: self currentTabApplication category: aCategory
</methods> <methods> Tools.FullNotebookSystemBrowser <category>selection utlity</category>
selectBehavior: aBehavior self currentTabApplication selectBehavior: aBehavior
selectCategory: aCategory self currentTabApplication selectCategory: aCategory
selectMethod: aSymbol self currentTabApplication selectMethod: aSymbol
selectProtocol: aProtocol self currentTabApplication selectProtocol: aProtocol
</methods> <methods> Tools.FullNotebookSystemBrowser <category>initialize-release</category>
initialize self initializeColorSelections. self majorTabs selectionIndexHolder onChangeSend: #changedMajorTab to: self. super initialize.
initializeColorSelections self majorTabs applyListColor: ColorValue black selectedColor: ColorValue red disabledItemsColor: ColorValue gray
initializeForSystem self tabApplications: self class applicationTabs. disableBatchUpdates := true. self initializeTabs.
initializeForTabApplications: aCollectionOfTabApplications self tabApplications: aCollectionOfTabApplications. disableBatchUpdates := true. self initializeTabs.
initializeTabs self labelApplicationDictionary: self getLabelApplicationDictionary. self resetTabs
release super release. self majorTabs selectionIndexHolder removeDependent: self. self labelApplicationDictionary notNil ifTrue: [self labelApplicationDictionary do: [:each | each release]]. self components notNil ifTrue: [self components do:[:each | each release]]. components := nil.
</methods> <methods> Tools.FullNotebookSystemBrowser <category>delegating</category>
doesNotUnderstand: aMessage "Delegates anything I don't understand to the current tab application. This allows adding Tab Applications that don't conflict with each other easier." | tabApp | tabApp := self currentTabApplication. (tabApp respondsTo: aMessage selector) ifFalse: [^super doesNotUnderstand: aMessage]. ^tabApp perform: aMessage selector withArguments: aMessage arguments
</methods> <methods> Tools.FullNotebookSystemBrowser class <category>application configuration</category>
addApplicationTab: aBrowserTabApplication self applicationTabs add: aBrowserTabApplication
applicationTabs ^ApplicationTabs isNil ifTrue:[ApplicationTabs := OrderedCollection new ] ifFalse:[ApplicationTabs]
getLabelApplicationDictionaryFor: aBrowser | dict | dict := Dictionary new. self applicationTabs do:[:each | dict at: each label put:(each newOnBrowser: aBrowser)]. ^dict
removeApplicationTab: aBrowserTabApplication self applicationTabs remove: aBrowserTabApplication
</methods> <methods> Tools.FullNotebookSystemBrowser class <category>initialization</category>
initialize "self initialize" self addApplicationTab: ParcelTabApplication. self addApplicationTab: NamespaceTabApplication.
</methods> <methods> Tools.FullNotebookSystemBrowser class <category>actions</category>
openNormal " self openNormal" ^self new initializeForTabApplications: (Array with: NamespaceTabApplication); open
openOnParcels " self openOnParcels" ^self new searchChildNamespaces: true; initializeForTabApplications: (Array with: ParcelTabApplication); open
openOnParcelsAndNamespaces "self openOnParcelsAndNamespaces" | browser | browser := self new initializeForTabApplications: (Array with:NamespaceTabApplication with: ParcelTabApplication). browser majorTabs selectionIndex: 2. browser open
openOnSystem " self openOnSystem" ^self new initializeForTabApplications: self applicationTabs; open
</methods> <methods> Tools.BrowserListEntry <category>accessing</category>
displayLabel: string ^self type == nil ifTrue: [Label with: string offset: self offset] ifFalse: [(LabelAndIcon with: string offset: self offset) icon: self icon]
icon | icon | icon := self class icon: self type. ^icon
offset ^offset == nil ifTrue: [0@0] ifFalse: [offset]
offset: aPoint offset := aPoint
type ^type
type: aType type := aType
</methods> <methods> Tools.BrowserListEntry <category>comparing</category>
= anEntry ^self class == anEntry class and: [self value = anEntry value and: [self typeForComparing = anEntry typeForComparing]]
hash ^self value hash
typeForComparing "#normal and nil are different graphically, but they are equivalent semantically." ^type == nil ifTrue: [#normal] ifFalse: [type]
</methods> <methods> Tools.BrowserListEntry <category>printing</category>
displayLabel ^self type == nil ifTrue: [Label with: self value displayString offset: self offset] ifFalse: [(LabelAndIcon with: self value displayString offset: self offset) icon: self icon]
displayString ^self value displayString
</methods> <methods> Tools.BrowserListEntry class <category>initialize</category>
initialize "Initialize the class." "BrowserListEntry initialize" | variableIcon signalIcon folderIcon canvasIcon imageIcon menuIcon regionsIcon modelIcon queryIcon normalIcon | variableIcon := OpaqueImage figure: self CVariableIcon shape: self MskVariableIcon. signalIcon := OpaqueImage figure: self CSignalIcon shape: self MskSignalIcon. folderIcon := OpaqueImage figure: self CFolderIcon shape: self MskFolderIcon. canvasIcon := OpaqueImage figure: self CcanvasIcon shape: self MskCanvasIcon. imageIcon := OpaqueImage figure: self CiconIcon shape: self MskIconIcon. menuIcon := OpaqueImage figure: self CMenuIcon shape: self MskMenuIcon. regionsIcon := OpaqueImage figure: self CRegionsIcon shape: self MskIconIcon. modelIcon := OpaqueImage figure: self CModelIcon shape: self MskModelIcon. queryIcon := OpaqueImage figure: self CQueryIcon shape: self MskQueryIcon. normalIcon := CachedImage on: queryIcon shape asImage copyEmpty. Map := Dictionary new at: #nameSpace put: folderIcon; at: #exception put: signalIcon; at: #variable put: variableIcon; at: #canvas put: canvasIcon; at: #image put: imageIcon; at: #menu put: menuIcon; at: #hotRegions put: regionsIcon; at: #model put: modelIcon; at: #query put: queryIcon; at: #normal put: normalIcon; yourself
</methods> <methods> Tools.BrowserListEntry class <category>instance creation</category>
value: val type: type ^self new value: val; type: type
</methods> <methods> Tools.BrowserListEntry class <category>accessing</category>
icon: aName ^Map at: aName ifAbsent: [nil]
</methods> <methods> Tools.ParcelProtocolBrowserHelper <category>emphasis</category>
setButtonEmphasisFor: classOrNameSpace | buttons | module builder == nil ifTrue: [^self]. buttons := self emphasizer emphasisForClassButtons: classOrNameSpace for: self browser id: self selectionId. buttons with: #(#instanceButton #classButton #dataButton) do: [:emphasis :componentName | | component widget text | (component := module builder componentAt: componentName) ~~ nil ifTrue: [text := (widget := component widget) label text. (text emphasisAt: 1) ~= emphasis ifTrue: [text emphasizeAllWith: emphasis. widget invalidate. widget label text: text. widget invalidate]]]
textEmphasisForItem: anItem ^self emphasizer emphasisForProtocol: anItem for: self browser id: self selectionId
</methods> <methods> Tools.ParcelProtocolBrowserHelper <category>menus accessing</category>
getListMenu: forMenuBar | protocol parcels cl parcelsForClass selectorsInProtocol | (protocol := self selection) isNil ifTrue: [parcels := #()] ifFalse: [parcels := IdentitySet new: 4. cl := self selectedClassOrNameSpace. nil == (parcelsForClass := self browser manager parcelsForClassOrNameSpace: cl) ifFalse: [selectorsInProtocol := cl organization listAtCategoryNamed: protocol. parcelsForClass do: [:p| selectorsInProtocol do: [:sel| (p definesSelector: sel forClass: cl) ifTrue: [parcels add: p]]]]]. ^self browser addParceling: parcels to: (super getListMenu: forMenuBar) forHelper: self
</methods> <methods> Tools.ParcelProtocolBrowserHelper <category>list accessing</category>
updateListFull | class list | ( class := self targetClassOrNameSpace ) == nil ifTrue: [ list := List new ] ifFalse: [ list := class organization categories asList ]. self setButtonEmphasisFor: class. module setNewList: ( self filter: list )
</methods> <methods> Tools.ParcelProtocolBrowserHelper <category>private</category>
filter: protocols | class browser parcels currentParcel | (protocols isEmpty or: [(class := self targetClassOrNameSpace) isNil]) ifTrue: [^protocols]. class isForNameSpace ifTrue: [ ^self filterStatics: protocols in: class ]. browser := self browser. currentParcel := self selectedParcel. browser isUnparceledFilterOn ifTrue: [(parcels := browser currentParcelsFor: class currentParcel: currentParcel) isEmpty ifTrue: [^protocols]. ^protocols select: [:prot| | list | (list := class organization listAtCategoryNamed: prot) isEmpty or: [list contains: [:sel| parcels contains: [:p| (p definesSelector: sel forClass: class) not]]]]]. browser isParcelFilterOn ifFalse: [^protocols]. browser isConflictsFilterOn ifTrue: [| conflicts | conflicts := browser computeConflictsFor: (Set with: class instanceBehavior) within: (currentParcel notNil ifTrue: [Array with: currentParcel]). conflicts := conflicts first collect: [:md| md protocol]. ^protocols select: [:prot| conflicts includes: prot]]. (parcels := self browser currentParcelsFor: class currentParcel: currentParcel ) isNil ifTrue:[ parcels := #() ]. ^protocols select: [:prot| prot == #'parcel load/unload/save' or: [parcels contains: [:p| (p definedSelectorsFor: class andProtocol: prot) size > 0]]]
filterStatics: protocols in: nameSpace | browser currentParcel org mgr usedCategories classOrNameSpace | classOrNameSpace := nameSpace namedReferent. mgr := (browser := self browser) manager. currentParcel := self selectedParcel. org := nameSpace organization. browser isUnparceledFilterOn ifTrue: [^protocols select: [:cat| (org listAtCategoryNamed: cat) contains: [:bn| | binding | binding := nameSpace bindingFor: bn. binding isForNameSpace "Treat NameSpaces as flat; don't consider contained NameSpaces" ifTrue: [(mgr parcelsForClassOrNameSpace: binding value) size = 0] ifFalse: [binding isForClass ifTrue: [browser isUnparceledCodeInClass: binding value currentParcel: currentParcel] ifFalse: [(mgr parcelsForBinding: binding) size = 0]]]]]. browser isParcelFilterOn ifFalse: [^protocols]. browser isConflictsFilterOn ifTrue: [| multiplyParcelledThings conflicts | multiplyParcelledThings := mgr multiplyParcelledThings. classOrNameSpace isBehavior ifTrue: [^protocols select: [:cat| (org listAtCategoryNamed: cat) contains: [:bn| (multiplyParcelledThings includes: (nameSpace bindingFor: bn)) and: [currentParcel isNil or: [currentParcel definesName: bn in: classOrNameSpace]]]]]. conflicts := browser computeConflictsFor: (multiplyParcelledThings select: [:thing| thing isBehavior]) within: (currentParcel notNil ifTrue: [Array with: currentParcel]). ^protocols select: [:cat| | list | (list := org listAtCategoryNamed: cat) isEmpty or: [list contains: [:bn| | binding parcels | binding := nameSpace bindingFor: bn. binding isForNameSpace ifTrue: [parcels := (mgr parcelsForClassOrNameSpace: binding value) select: [:p| p definesObject: binding value]. parcels size > 1 and: [currentParcel isNil or: [parcels includes: currentParcel]]] ifFalse: [binding isForClass ifTrue: [((conflicts last contains: binding value) or: [conflicts first contains: [:md| md protocol == cat and: [md class == binding value]]])] ifFalse: [(conflicts at: 2) includes: binding]]]]]]. currentParcel == nil ifTrue: [^protocols select: [:cat| | list | (list := org listAtCategoryNamed: cat) isEmpty or: [list contains: [:bn| | binding | binding := nameSpace bindingFor: bn. (binding isForNameSpace or: [binding isForClass]) ifTrue: [(mgr parcelsForClassOrNameSpace: binding value) size > 0] ifFalse: [(mgr parcelsForBinding: binding) size > 0]]]]]. classOrNameSpace isBehavior ifTrue: [^protocols select: [:cat| | list | (list := org listAtCategoryNamed: cat) isEmpty or: [list contains: [:bn| currentParcel definesName: bn in: classOrNameSpace]]]]. usedCategories := IdentitySet new. usedCategories addAll: currentParcel definedClasses; addAll: currentParcel extendedClasses. usedCategories := usedCategories collect: [:class| class category]. ^protocols select: [:categorySymbol | usedCategories includes: categorySymbol]
</methods> <methods> Tools.ParcelProtocolBrowserHelper <category>actions</category>
addSelectionToParcel | target parcel selectorsOrKeys | self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. target := self targetClassOrNameSpace. parcel := self selectedParcel. selectorsOrKeys := target organization listAtCategoryNamed: self selection. target isForNameSpace ifTrue: [parcel addNames: selectorsOrKeys in: target] ifFalse: [parcel addSelectors: selectorsOrKeys forClass: target]. self browser updateLists
moveSelectionToParcel: aParcel "Move all methods in the current protocol into aParcel according to the following rules. If no Parcel is selected ... If filtering is off then move all the methods to theParcel and remove all the methods from all other parcels. If filtering is on then move all the methods that are defined by other parcels into theParcel, and remove just those methods from all other parcels. If a Parcel is selected ... move all the methods that are defined in the selected Parcel to theParcel and remove just those methods from the selected parcel." | theClass | self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. theClass := self targetClassOrNameSpace. ( theClass isForNameSpace or: [ self isData ] ) ifTrue: [ ^Dialog warn: (#MoveOfSharedVariableNotYetSupported << #dialogs >> 'Move of shared variables not yet supported.'). ]. self browser moveSelectors: (theClass organization listAtCategoryNamed: self selection) inClass: theClass toParcel: aParcel. self browser updateBrowser
remove "Override to ensure the parcel forgets the protocol if removed." | removed parcel | (removed := super remove) ifTrue: [(parcel := self selectedParcel) notNil ifTrue: [parcel cleanse]]. ^removed
removeSelectionConflictsFromParcel self unimplemented
removeSelectionFromParcel | target parcel| self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. target := self targetClassOrNameSpace. parcel := self selectedParcel. target isForNameSpace ifTrue: [ ^Dialog warn: (#NotImplemented << #dialogs >> 'Not implemented.'). ] ifFalse: [ parcel removeSelectors: ( target organization listAtCategoryNamed: self selection ) forClass: target ]. self browser updateLists
</methods> <methods> Tools.BlankUI <category>responding</category>
buildMenuBar: menu "here so we can respond but do nothing with any menu."
menuHeader ^nil
</methods> <methods> Tools.BlankUI <category>aspects</category>
blankList "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^blankList isNil ifTrue: [blankList := SelectionInList new] ifFalse: [blankList]
specName ^self class preferredSpecName
</methods> <methods> Tools.BlankUI class <category>interface specs</category>
preferredSpecName ^#windowSpec
</methods> <methods> Tools.ClassHierarchyBrowserHelper <category>accessing</category>
baseClass baseClass == nil ifTrue: [ baseClass := self targetClass ]. ^baseClass.
baseClass: aClass ^baseClass := aClass
windowLabel ^(#HierarchyBrowserOn1p << #labels >> 'Hierarchy Browser on <1p>') expandMacrosWith: self baseClass
</methods> <methods> Tools.ClassHierarchyBrowserHelper <category>menus accessing</category>
setEnablement: menu "Set the menu's items enabled/disabled state." super setEnablement: menu. (menu atNameKey: #add) disable. ^menu
</methods> <methods> Tools.ClassHierarchyBrowserHelper <category>list accessing</category>
updateListFull | newList | (self baseClass == nil or: [self baseClass isObsolete]) ifTrue: [newList := List new] ifFalse: [newList := self generateHierarchy]. module setNewList: newList
</methods> <methods> Tools.ClassHierarchyBrowserHelper <category>private</category>
decorate: item | thing | thing := super decorate: item. thing offset: (self nesting: item)@0. ^thing
generateHierarchy | newList | newList := List new. self generateSuper: self baseClass into: newList. self generateSubs: self baseClass into: newList. ^newList
generateSubs: cls into: newList | subs | cls == nil ifTrue: [^self]. subs := cls subclasses. subs := subs asSortedCollection: [:c1 :c2 | c1 fullName < c2 fullName]. subs do: [:cl | cl isMeta ifFalse: [newList add: cl. self generateSubs: cl into: newList]]
generateSuper: cls into: newList cls == nil ifFalse: [self generateSuper: cls superclass into: newList. cls isMeta ifFalse:[newList add: cls ]]
howManySuperclasses: item ^(item isBehavior and: [item superclass ~~ nil]) ifTrue: [(self howManySuperclasses: item superclass) + 1] ifFalse: [0]
nesting: item ^(self howManySuperclasses: item ) * 12
</methods> <methods> Tools.ParcelListBrowserHelper <category>menus accessing</category>
actionsForMultiSelect ^#()
actionsForNoSelect ^#(selectHelp newParcel loadParcel filter updateBrowser find)
buildViewMenu: aMenu | menu | menu := self class defTypeMenu. menu menuItems do: [ :i | i indication: ( self browser parcelDefType value = i value ) ]. aMenu addPart: menu
doesNotUnderstand: aMessage | browser | (self browser respondsTo: #currentTabApplication ) ifTrue:[ ^self browser perform: aMessage selector withArguments: aMessage arguments]. ((browser := self browser) respondsTo: aMessage selector) ifFalse: [^super doesNotUnderstand: aMessage]. ^browser perform: aMessage selector withArguments: aMessage arguments
getListMenu: forMenuBar | menu browser filterSubMenu | menu := super getListMenu: forMenuBar. menu selectionMemory: nil. browser := self browser. filterSubMenu := (menu atNameKey: #filter) submenu. (filterSubMenu atNameKey: #showOnlyParceled) indication: browser isParcelFilterOn. (filterSubMenu atNameKey: #showOnlyUnparceled) indication: browser isUnparceledFilterOn. (filterSubMenu atNameKey: #showMultiplyParceled) indication: browser isConflictsFilterOn. (menu atNameKey: #doUndo) enablementSelector: #canUndo. ^menu
</methods> <methods> Tools.ParcelListBrowserHelper <category>accessing</category>
windowLabel ^self currentParcel isNil ifTrue: [#Parcel << #labels >> 'Parcel'] ifFalse: [#x1sParcel << #dialogs >> '<1s> Parcel' expandMacrosWith: self currentParcel name]
</methods> <methods> Tools.ParcelListBrowserHelper <category>list accessing</category>
selectionChanged self setSelection. self browser updateButtonLabels. self nextModule updateList
selectParcel: aParcel | newSelection | (newSelection := aParcel) == nil ifTrue: [ module deselect ]. self module selection: newSelection
textForItem: aParcel ^aParcel listEntry asText
updateListFull "Must cleanse all parcels to make sure they're current." |pList| self manager parcels do: [ :aParcel | aParcel cleanse ]. pList := SortedCollection withAll: self manager parcels sortBlock: [:p1 :p2 | p1 name < p2 name]. module setNewList: pList asList. "parcelNameList"
</methods> <methods> Tools.ParcelListBrowserHelper <category>actions</category>
addChangeSet self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. self selectedParcel addChangeSet: ChangeSet current. self browser updateLists
addToChanges "Add the Parcel's contents to the current ChangeSet." self selectedParcel cleanse. ChangeSet current addChangeSet: self currentParcel
browseChangedMethods "Browse all methods that have changed in the currently selected parcel. Changed is defined as not having the same source file as the Parcel." | extensions fileIndex sfm | ((self selectedParcel propertyAt: #hideSource) notNil and: [self selectedParcel propertyAt: #hideSource]) ifTrue: [^Dialog warn: (#ParcelSourceHidden << #dialogs >> 'Parcel source is hidden. Cannot determine changed methods')]. extensions := SortedCollection new. fileIndex := self selectedParcel propertyAt: #sourceIndex. sfm := SourceFileManager default. self currentParcel methodsDo: [:cm| | def | (fileIndex ~= (sfm fileIndexFor: cm sourcePointer) and: [(def := cm definition) ~~ nil]) ifTrue: [extensions add: def]]. self methodCollector openListBrowserOn: extensions label: ((#ChangedMethodsIn1s << #dialogs >> 'Changed methods in <1s>') expandMacrosWith: self selectedParcel name) initialSelection: nil
browseClassExports "Browse references in the system to classes or names of classes exported from this Parcel. Open a list browser on references from methods and a category browser for references from subclasses" Cursor execute showWhile: [| names references subclassExports | names := self selectedParcel definedClasses collect: [:ea| ea name]. references := Set new. SystemUtils allBehaviorsDo: [:class| | extends | extends := self selectedParcel definesOrExtendsBehavior: class. class selectorsAndMethodsDo: [:sel :meth| (extends and: [self currentParcel definesSelector: sel forClass: class]) ifFalse: [meth allLiteralsDo: [:lit| | litVal | "If the method refers to more than one class then the set will eliminate multiple entries for this method." ((lit isSymbol and: [names includes: lit]) or: [lit isVariableBinding and: [(litVal := lit value) isBehavior and: [self selectedParcel definesClass: litVal]]]) ifTrue: [references add: ((MethodDefinition class: class selector: sel) extraText: ((#Exports1p << #dialogs >> ' exports: <1p>') expandMacrosWith: litVal))]]]]]. subclassExports := IdentitySet new. self selectedParcel definedClasses do: [:class| subclassExports addAll: (class subclasses select: [:subclass| | pcls | (pcls := self manager parcelsForClassOrNameSpace: subclass) size = 0 or: [pcls contains: [:p| p ~= self selectedParcel and: [p definesClass: subclass]]]])]. (references isEmpty and: [subclassExports isEmpty]) ifTrue: [^Dialog warn: (#NoExports << #dialogs >> 'No exports')]. references isEmpty ifFalse: [self methodCollector openListBrowserOn: references asSortedCollection label: ((#ReferencesToClassesExportedFrom1sParcel << #dialogs >> 'References to Classes Exported from <1s> Parcel') expandMacrosWith: self currentParcel name) initialSelection: nil]. subclassExports isEmpty ifFalse: [self notYetImplemented. "org := SystemOrganizer new. subclassExports do: [:class| org classify: class fullName under: 'Inherited Class Exports From ', self currentParcel name, ' Parcel']. self class openOn: (ParcelBrowser new on: org)"]]
browseClassImports "Browse references to classes defined by the rest of the system from within this Parcel." Cursor execute showWhile: [| references superclassImports extendedImports | references := Set new. superclassImports := IdentitySet new. extendedImports := IdentitySet new. SystemUtils allBehaviorsDo: [:class| | defines extends | ((defines := self selectedParcel definesClass: class) and: [class superclass notNil and: [(self selectedParcel definesClass: class superclass) not]]) ifTrue: [superclassImports add: class instanceBehavior superclass]. (extends := self selectedParcel extendsBehavior: class) ifTrue: [extendedImports add: class instanceBehavior]. class selectorsAndMethodsDo: [:sel :meth| (defines or: [extends and: [self selectedParcel definesSelector: sel forClass: class]]) ifTrue: [meth allLiteralsDo: [:lit| | litVal | "If the method refers to more than one class then the set will eliminate multiple entries for this method." (lit isVariableBinding and: [(litVal := lit value) isBehavior and: [(self selectedParcel definesClass: litVal) not]]) ifTrue: [references add: ((MethodDefinition class: class selector: sel) extraText: ((#ImportsColon1p << #dialogs >> ' imports: <1p>') expandMacrosWith: litVal))]]]]]. (references isEmpty and: [superclassImports isEmpty and: [extendedImports isEmpty]]) ifTrue: [^Dialog warn: (#NoImports << #dialogs >> 'No imports')]. references isEmpty ifFalse: [self methodCollector openListBrowserOn: references asSortedCollection label: ((#ReferencesToClassesImportedBy1sParcel << #dialogs >> 'References to Classes Imported by <1s> Parcel') expandMacrosWith: self currentParcel name) initialSelection: nil]. superclassImports isEmpty ifFalse: [self notYetImplemented. "org := SystemOrganizer new. superclassImports do: [:class| org classify: class fullName under: 'Class Imports into ', self currentParcel name, ' Parcel']. self class openOn: (ParcelBrowser new on: org)"]. extendedImports isEmpty ifFalse: [self notYetImplemented. "org := SystemOrganizer new. extendedImports do: [:class| org classify: class fullName under: 'Classes Extended by ', currentParcel name, ' Parcel']. self class openOn: (ParcelBrowser new on: org)"]]
browseDanglingReferences "Browse references in the system to classes or names of classes exported from this Parcel. Open a list browser on references from methods and a category browser for references from subclasses" Cursor execute showWhile: [| references subclassExports | references := Set new. subclassExports := IdentitySet new. self selectedParcel danglingReferencesIfUnloadedDo: [:referer :referent| referer isBehavior ifTrue: [subclassExports add: referer] ifFalse: [referer isSymbol ifTrue: [references add: (MethodDefinition class: referent selector: referer)] ifFalse: [references add: (referer definition extraText: ' -> ', referent fullName; yourself)]]]. (references isEmpty and: [subclassExports isEmpty]) ifTrue: [^Dialog warn: (#NoDanglingReferences << #dialogs >> 'No dangling references')]. references isEmpty ifFalse: [self methodCollector openListBrowserOn: references asSortedCollection label: ((#ClassRefsInParcel << #dialogs >> 'References to Classes in <1s> Parcel') expandMacrosWith: self currentParcel name) initialSelection: nil]. subclassExports isEmpty ifFalse: [| namespace | namespace := NameSpace new name: ((#InheritedClassRefs << #dialogs >> 'Inheriting Class References From <1s>') asString expandMacrosWith: self currentParcel name). subclassExports do: [:class | namespace addBinding: (class environment bindingFor: class name)]. self browser spawnOnNameSpace: namespace]]
browseExclusiveMethodImports "Browse methods imported by this Parcel and unused elsewhere." | danglingMethods | Cursor execute showWhile: [danglingMethods := self computeExclusiveMethodImports]. self methodCollector openListBrowserOn: danglingMethods asSortedCollection label: ((#PossibleDanglingMethods << #dialogs >> 'Methods Used Only by <1s> but not in <2s>') expandMacrosWith: self selectedParcel name with: self currentParcel name) initialSelection: nil
browseExtensionMethods "Browse all extension methods in the currently selected parcel." | extensions | extensions := SortedCollection new. self currentParcel extensionsDo: [:aClass :aSelector| extensions add: (MethodDefinition class: aClass selector: aSelector)]. self methodCollector openListBrowserOn: extensions label: ((#ExtensionMethodsIn1s << #dialogs >> 'Extension methods in <1s>') expandMacrosWith: self currentParcel name) initialSelection: nil
browseImplementorsOf "Prompt the user for a selector or selector pattern. If only one existing message selector matches that selector (case insensitive) or pattern, then browse all implementors of that selector. If more than one match, then present a menu of the matching selectors and browse all implementors of the selected one." | trial coll selector mc | "Two things; a) this should open a Parcel Method List Browser, b) the prompting for selectors should be in some central place" trial := Dialog request: (#BrowseImplementorsOfWhatQ << #dialogs >> 'Browse implementors of what?'). trial isEmpty ifTrue: [^self]. coll := OrderedCollection new. Cursor wait showWhile: [Symbol allSubInstancesDo: [:sym | (trial match: sym) ifTrue: [coll add: sym]]]. coll isEmpty ifTrue: [^Dialog warn: (#NoMatchingMessages << #dialogs >> 'No matching messages')]. selector := coll size = 1 ifTrue: [coll first] ifFalse: [Dialog choose: (#FindAllImplementorsOfDot << #dialogs >> 'Find all implementors of...') fromList: (coll collect: [:sel | sel asString]) values: coll lines: 20 cancel: [^self]]. mc := self methodCollector. mc browseSelect: (mc parcel: self currentParcel) & (mc implementorsOf: selector)
browseOverriddenByOthers "Browse all methods in the currently selected parcel that are overridden by other parcels. These methods prevent a parcel from being saved." | overrides current currentParcel | currentParcel := self currentParcel. ( overrides := currentParcel overrides ) isEmpty ifTrue: [ ^Dialog warn: (#NothingOverriddenByOthers << #dialogs >> 'Nothing overridden by others') ]. current := OrderedCollection new. overrides do: [ :over | over isForMethod ifTrue: [ current add: ( MethodDefinition class: over owner selector: over selector) ] ]. OverrideList new listName: ((#OverriddenDefsInParcel << #dialogs >> 'Definitions in <1s> overridden by others') expandMacrosWith: currentParcel name); checkSystem: #code; showConflicts: true; openOn: overrides. current isEmpty ifFalse: [ self methodCollector openListBrowserOn: current asSortedCollection label: ((#CurrentMethodOverridden << #dialogs >> 'Current method overridden in <1s>') expandMacrosWith: self currentParcel name) initialSelection: nil ].
browseOverriddenExtensions "Browse all methods in the currently selected parcel that are overrides of previous versions. To allow comparison of the old and the new open up a ChangeList switched to conflicts containing the original versions. To allow parcelling, open up a MethodListParcelBrowser." | overrides current currentParcel | currentParcel := self currentParcel. ( overrides := Override overriddenByComponent: currentParcel ) isEmpty ifTrue: [ ^Dialog warn: (#NoOverriddenExtensions << #dialogs >> 'No overridden extensions') ]. current := OrderedCollection new. overrides do: [ :over | over isForMethod ifTrue: [ current add: ( MethodDefinition class: over owner selector: over selector) ] ]. OverrideList new listName: ((#DefinitionsOverriddenByParcel << #dialogs >> 'Definitions overridden by <1s> parcel') expandMacrosWith: self currentParcel name); checkSystem: #code; showConflicts: true; openOn: overrides. current isEmpty ifFalse: [ self methodCollector openListBrowserOn: current asSortedCollection label: ((#CurrentMethodOverrides << #dialogs >> 'Current method overrides defined in <1s>') expandMacrosWith: self currentParcel name) initialSelection: nil ].
browseSendersOf "Prompt the user for a selector or selector pattern. If only one existing message selector matches that selector (case insensitive) or pattern, then browse all senders of that selector. If more than one match, then present a menu of the matching selectors and browse all senders of the selected one." | trial coll selector mc | "Two things; a) this should open a Parcel Method List Browser, b) the prompting for selectors should be in some central place" trial := Dialog request: (#BrowseSendersOfWhatQ << #dialogs >> 'Browse senders of what?'). trial isEmpty ifTrue: [^self]. coll := OrderedCollection new. Cursor wait showWhile: [Symbol allSubInstancesDo: [:sym | (trial match: sym) ifTrue: [coll add: sym]]]. coll isEmpty ifTrue: [^Dialog warn: (#NoMatchingMessages << #dialogs >> 'No matching messages')]. selector := coll size = 1 ifTrue: [coll first] ifFalse: [Dialog choose: (#FindAllSendersOfDot << #dialogs >> 'Find all senders of...') fromList: (coll collect: [:sel | sel asString]) values: coll lines: 20 cancel: [^self]]. mc := self methodCollector. mc browseSelect: (mc parcel: self currentParcel) & (mc referencesTo: selector)
browseUnparceledMethodsOnDefinedClasses "Browse methods on classes defined by this Parcel that are not in the Parcel." ^self methodCollector openListBrowserOn: self computeUnparceledMethodsOnDefinedClasses asSortedCollection label: ((#UnparcelledMethods << #dialogs >> 'Unparcelled methods in classes defined in <1s>') expandMacrosWith: self currentParcel name) initialSelection: nil
discardParcel "Discard the selected parcel. This discards the Parcel but does not remove its code." self changeRequest ifFalse: [^self]. (Dialog confirm: (#DiscardBbutNotUnloadParcelQ << #dialogs >> 'Really discard (but not unload) the parcel?')) ifTrue: [ self manager destroyParcelNamed: self currentParcel name. self updateListFull. self selectParcel: nil ]
emptyParcel "Empty the current parcel, but do not remove the code it defined from the system." self changeRequest ifFalse: [^self]. self currentParcel uiForEmpty ifTrue: [self browser updateLists]
fileIntoParcel | fileName | self changeRequest ifFalse: [^self]. fileName := Dialog requestFileName: (#FileInFromFileNamed << #dialogs >> 'File in from file named') default: '*.st' version: #mustBeOld ifFail: [nil] for: self browser builder window. fileName size = 0 ifTrue: [^self]. self currentParcel fileIntoFrom: fileName. self browser updateLists
fileOutParcel self changeRequest ifFalse: [^self]. self currentParcel fileOutAsFor: nil. "builder window"
find "Prompt for a name and position myself there." | obj parcelSet found | self changeRequest ifFalse: [^self]. obj := self findASomething: (#FindColon << #labels >> 'Find:'). obj == nil ifTrue: [^self]."if we can't see it, we can't select it....." obj isBindingReference ifTrue: [self browser batchUpdates: [self browser metaShowData. self browser setAndUpdateEnvironment: obj environment environment. self browser selectCategory: obj environment category. self browser selectBehavior: obj environment. self browser selectProtocol: (obj environment asNameSpace categoryFor: obj name). self browser selectMethod: obj name]] ifFalse: [self environment == nil & (self category == nil) ifFalse: [self browser setAndUpdateEnvironment: obj environment. self category == obj category ifFalse: [module nextModule select: obj category whenFinished: ["module nextModule updateList"]]]. found := self browser manager parcelsForClassOrNameSpace: obj. found isNil ifFalse: [|foundCollection| foundCollection := found asOrderedCollection. parcelSet := foundCollection select: [:each | (each definesClass: obj) or: [each definesObject: obj]]. parcelSet isEmpty ifTrue: [parcelSet := foundCollection]]. found notNil ifTrue: [self module select: parcelSet first whenFinished: [module updateList]]. module nextModule nextModule select: obj whenFinished: [self browser updateBrowser]]
inspectParcel self selectedParcel inspect
loadParcel self changeRequest ifFalse: [ ^self ]. self manager loadParcelFor: nil. "builder window." self browser updateParcelLists. self browser updateNamespaceListFull.
newParcel "Pop dialog to prompt user for new name. Tell def mgr to make it" | newName currentParcel | self changeRequest ifFalse: [^self]. newName := Dialog request: (#EnterNameForNewParcel << #dialogs >> 'Enter name for the new parcel') initialAnswer: '' onCancel: [nil]. newName := self manager normalizedNameFor: newName. (newName isNil or: [newName isEmpty]) ifTrue: [^self]. (self manager parcelNamed: newName) notNil ifTrue: [Dialog warn: (#parcelExists << #dialogs >> 'A parcel with this name already exists'). ^self]. currentParcel := self manager createParcelNamed: newName. currentParcel == nil ifFalse: [ self browser updateLists. self module selection: currentParcel ]
openParcelProperties PackagePropertiesDialog on: self currentParcel
removeChangeSet self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. self currentParcel removeChangeSet: ChangeSet current. self browser updateLists
removeFromChanges "Remove the Parcel's contents from the current ChangeSet." self currentParcel cleanse. ChangeSet current removeChangeSet: self currentParcel
removeParcel "Remove the currently selected parcel. This unloads the Parcel's code and updates the current change set with the removals." self changeRequest ifFalse: [^self]. (Dialog confirm: (#UnloadAndRemoveParcelCodeQ << #dialogs >> 'Really unload (and remove) the parcel''s code?')) ifTrue: [Cursor wait showWhile: [self currentParcel hasDanglingReferencesIfUnloaded ifTrue: [(Dialog confirm: ((#HasDanglingReferencesRemoveParcelQ << #dialogs >> '<1s> has dangling references.<n>Do you really want to remove the parcel''s code?') expandMacrosWith: self currentParcel name)) ifFalse: [^self]]. (self manager removeParcelNamed: self currentParcel name) ifTrue: [self postUnloadParcel]]]. self browser updateParcelLists
removeScript | fileName stream | fileName := self currentParcel name asString, '.rm'. fileName := self buildPlatformFilename: fileName. fileName := Dialog requestNewFileName: (#SaveRemoveScriptToFileNamed << #dialogs >> 'Save remove script to file named?') default: fileName. fileName isEmpty ifTrue: [^self]. stream := fileName asFilename writeStream. [self currentParcel writeRemovalScriptOn: stream] ensure: [stream close]
renameParcel self changeRequest ifFalse: [^self]. "Remember currentParcel because rename sets currentParcel to nil" self currentParcel uiForRename ifTrue: [ self updateLists ]
saveParcelDialog "Put up a Dialog that allows the user to save the Parcel in various forms." self changeRequest ifFalse: [^self]. self currentParcel saveParcelDialogFor: nil . "builder window." self browser updateLists
showComputedPrerequisites | prerequisites | self changeRequest ifFalse: [^self]. prerequisites := self computePrerequisites. self parcelTextMode: #parcelPrerequisites value: ((#EditAndAcceptPrereqs << #dialogs >> '"Edit as required and then choose accept to set the parcel''s prerequisites."<nn><1s>') expandMacrosWith: ((prerequisites asSortedCollection: [:p1 :p2 | p1 name <= p2 name]) asArray collect: [:p | Array with: p name with: (p propertyStringAt: #version)]) storeString asText)
showSummary self browser parcelTextMode: #parcelSummary
spawn "Not supported." Dialog warn: (#NotImplemented << #dialogs >> 'Not implemented.')
unloadParcel self changeRequest ifFalse: [^self]. self currentParcel isNil ifTrue: [| parcels unloaded | parcels := self manager parcels select: [:ea| ea isLoaded]. parcels := SimpleDialog new chooseMultiple: (#SelectParcelsToUnload << #dialogs >> 'Select parcels to unload.') fromList: (parcels collect: [:p| p listEntry]) values: parcels buttons: #() values: #() lines: 8 cancel: [] for: Dialog defaultParentWindow. parcels notNil ifTrue: [unloaded := false. Cursor wait showWhile: [(SystemUtils sortForLoading: parcels) reverseDo: [:p| p hasDanglingReferencesIfUnloaded ifTrue: [(Dialog confirm: ((#ParcelHasDanglingRefs << #dialogs >> '<1s> has dangling references.<n>Do you really want to unload the parcel''s code?') expandMacrosWith: p name)) ifFalse: [^self]]. (self manager unloadParcelNamed: p name) ifTrue: [unloaded := true]]. unloaded ifTrue: [self postUnloadParcel]]]] ifFalse: [(Dialog confirm: (#UnloadAndDiscardParcelCodeQ << #dialogs >> 'Really unload (and discard) the parcel''s code?')) ifTrue: [Cursor wait showWhile: [self currentParcel hasDanglingReferencesIfUnloaded ifTrue: [(Dialog confirm: ((#ParcelHasDanglingRefs << #dialogs >> '<1s> has dangling references.<n>Do you really want to unload the parcel''s code?') expandMacrosWith: self currentParcel name)) ifFalse: [^self]]. (self manager unloadParcelNamed: self currentParcel name) ifTrue: [self postUnloadParcel]]]]. self browser updateParcelLists
updateBrowser self browser updateBrowser
</methods> <methods> Tools.ParcelListBrowserHelper <category>text processing</category>
acceptText: aText from: textController | currentParcel textMode | (currentParcel := self currentParcel) isNil ifTrue: [^nil]. textMode := self browser parcelDefType value. textMode == #parcelComment ifTrue: [currentParcel comment: aText string. self updateListFull. ^true]. textMode == #parcelVersion ifTrue: [currentParcel version: aText string. self updateListFull. ^true]. textMode == #parcelNotice ifTrue: [currentParcel propertyAt: #notice put: aText string. self updateListFull. ^true]. textMode == #parcelPrerequisites ifTrue: [currentParcel prerequisiteParcels: (Compiler new evaluate: aText string in: nil allowReceiver: true receiver: currentParcel environment: nil notifying: textController ifFail: [^false]). self updateListFull. ^true]. textMode == #parcelDefintion ifTrue: [ ^self acceptDefinition: aText from: textController ]. ^nil
text | currentParcel textMode | (currentParcel := self currentParcel) isNil ifTrue: [^'' asText]. textMode := self browser parcelDefType value. textMode = #parcelDefintion ifTrue: [ textMode := #parcelComment ]. "Should be something" textMode == #parcelSummary ifTrue: [^('Parcel ', (currentParcel listEntry), '\\' withCRs) asText, currentParcel summary asText]. textMode == #parcelComment ifTrue: [^currentParcel comment asText]. textMode == #parcelVersion ifTrue: [^currentParcel version asText]. textMode == #parcelNotice ifTrue: [^(currentParcel propertyAt: #notice ifAbsent: ['Copyright © <1p> ????. All Rights Reserved.' expandMacrosWith: Date today year]) asText]. textMode == #parcelPrerequisites ifTrue: [^('"Supply Parcel prerequisites as Parcel name, Version string pairs. E.g.\ #(#(''Foo'' ''0.1'')\ #(''Bar'' ''0.2''))"\\' withCRs asText emphasizeAllWith: #italic), currentParcel prerequisiteParcels storeString asText]. textMode == #parcelProperties ifTrue: [ | properties s | properties := currentParcel properties. s := (String new: 64) writeStream. (properties keys asSortedCollection asOrderedCollection remove: #name; addFirst: #name; yourself) do: [:key| | value source | value := properties at: key. value isString ifFalse: [value := value printString]. s cr; nextPut: key first asUppercase; nextPutAll: (key copyFrom: 2 to: key size); nextPut: $:; space; nextPutAll: value. key == #sourceIndex ifTrue: [source := SourceFileManager default nameStringAt: (properties at: key). source := source isNil ifTrue: [source printString] ifFalse: [source]. s space; nextPut: $(; nextPutAll: source; nextPut: $)]]. ^s contents asText]. textMode == #parcelDanglingReferences ifTrue: [| s | s := (String new: 64) writeStream. Cursor wait showWhile: [currentParcel danglingReferencesIfUnloadedDo: [:referer :referent| referer isBehavior ifTrue: [s nextPutAll: referer printString; nextPutAll: ' subclasses '; nextPutAll: referent printString] ifFalse: [referer isSymbol ifTrue: [s nextPutAll: referer; nextPutAll: ' extends '; nextPutAll: referent printString] ifFalse: [referer printNameOn: s inClass: referer mclass. s nextPutAll: ' refers to '; nextPutAll: referent printString]]. s cr]]. s isEmpty ifTrue: [s nextPutAll: 'none']. ^s contents asText]. ^nil
</methods> <methods> Tools.ParcelListBrowserHelper <category>private</category>
buildPlatformFilename: aString | oldSeparator | oldSeparator := (aString includes: UnixFilename separator) ifTrue: [ UnixFilename separator ] ifFalse: [ (aString includes: PCFilename separator) ifTrue: [ PCFilename separator ] ifFalse: [ (aString includes: MacFilename separator) ifTrue: [ MacFilename separator ] ifFalse: [ nil ] ] ]. aString replaceAll: oldSeparator with: Filename separator. ^aString copyWithout: Character space.
computeExclusiveMethodImports "The algorithm computes a fixed point of the methods used by the parcel which are unused outside it. The algorithm is compute messages sent within parcel repeat until at a fixed point: compute intersection of this with methods implemented outside parcel compute messages sent outside parcel not within the intersection remove these from intersection" | parcelMessages "<IdentitySet of: Symbol> messages sent within this parcel" externalMethods "<Set of: MethodDescription> methods implemented outside this parcel" danglingMethods "<Set of: MethodDescription> methods importeded only by this parcel" previousDangling "<Set of: MethodDescription> intermediate value of danglingMethods (for determining if fixed point is reached)" danglingMessages "<Set of: Symbol> selectors of methods in danglingMethods" noLongerDangling "<Set of: Symbol> selectors to be moved from dangling" | parcelMessages := IdentitySet new. self currentParcel methodsDo: [:meth| parcelMessages addAll: meth allSymbolLiterals]. "compute starting points for danglingMethods and externalMethods" danglingMethods := Set new: 50. externalMethods := Set new: 20000. SystemUtils allBehaviorsDo: [:aBehavior| | extends | (self currentParcel definesClass: aBehavior) ifFalse: [extends := self currentParcel extendsBehavior: aBehavior. aBehavior selectorsAndMethodsDo: [:sel :meth| (extends and: [self currentParcel definesSelector: sel forClass: aBehavior]) ifFalse: [((parcelMessages includes: sel) ifTrue: [danglingMethods] ifFalse: [externalMethods]) add: (MethodDefinition class: aBehavior selector: sel)]]]]. ["Now iterate to the fixed-point. Any method in dangling with a selector sent in external must be moved into external until dangling reaches its fixed point." previousDangling := danglingMethods copy. danglingMessages := danglingMethods collect: [:md| md selector]. noLongerDangling := Set new: danglingMethods size. externalMethods do: [:md| md method allSymbolLiteralsDo: [:l| (danglingMessages includes: l) ifTrue: [noLongerDangling add: l]]]. externalMethods := danglingMethods select: [:md| noLongerDangling includes: md selector]. danglingMethods removeAll: externalMethods. danglingMethods size ~= previousDangling size] whileTrue. ^danglingMethods
computePrerequisites "Compute the Parcel's prerequisites and display them in the text pane; The programmer can then edit and accept." | importedClasses prerequisites | importedClasses := IdentitySet new. "Collect imported classes. These are the superclasses of classes in the parcel, the classes extended by the parcel, and any classes referred to by methods in the parcel." self currentParcel definedClasses do: [:class| | superclass | ((superclass := class superclass) notNil and: [(self currentParcel definesClass: superclass) not]) ifTrue: [importedClasses add: superclass]]. importedClasses addAll: self currentParcel extendedClasses. self currentParcel methodsDo: [:meth| meth allLiteralsDo: [:lit| | thing | (lit isSymbol and: [lit size > 0]) ifTrue: [((thing := Smalltalk at: lit ifAbsent: []) isBehavior and: [(self currentParcel definesClass: thing) not]) ifTrue: [importedClasses add: thing]] ifFalse: [(lit isVariableBinding and: [(thing := lit value) isBehavior and: [(self currentParcel definesClass: thing) not]]) ifTrue: [importedClasses add: thing]]]]. prerequisites := Set new. importedClasses do: [:class| | parcels | parcels := self manager parcelsForClassOrNameSpace: class. parcels notNil ifTrue: [prerequisites addAll: (parcels select: [:p| p definesClass: class])]]. prerequisites remove: self currentParcel ifAbsent: nil. ^prerequisites
computeUnparceledMethodsOnDefinedClasses "Answer a Set of methods on classes defined by this Parcel that are not in the Parcel." | references | references := Set new. SystemUtils allBehaviorsDo: [:class| (self currentParcel definesClass: class) ifTrue: [class selectorsAndMethodsDo: [:sel :meth| (self currentParcel definesSelector: sel forClass: class) ifFalse: [references add: (MethodDefinition class: class selector: sel)]]]]. ^references
postUnloadParcel "Clean-up after unloading a Parcel." self component1 updateListFull. self component2 updateListFull. self browser updateLists. (Dialog confirm: (#removeCatagoriesAndPurge << #dialogs >> 'Remove empty categories and purge Undeclared?')) ifTrue: [ Cursor execute showWhile: [ Root allNameSpaces do: [ :ns | ns organization removeEmptyCategories ]. ClassOrganizer allInstancesDo: [ :clo| clo removeEmptyCategories ]. Undeclared purgeUnusedBindings ] ]
</methods> <methods> Tools.ParcelListBrowserHelper <category>selections</category>
defaultAttribute "Answer the default attribute that this helper is responsible for selecting." ^#parcel
</methods> <methods> Tools.ParcelListBrowserHelper <category>drag and drop</category>
canAcceptDropFrom: aDC "respond to objects that can be added to a Parcel" ^aDC key == self classOrNamespaceKey or: [ aDC key == self selectorOrStaticKey]
</methods> <methods> Tools.ParcelListBrowserHelper class <category>menus accessing</category>
menuHeader ^(#Par_cel << #menus >> 'Par&cel') asString
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>parcel actions</category>
addSelectionToParcel | target | self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. target := self targetClassOrNameSpace. target isForNameSpace ifTrue: [ self selectedParcel addName: self selection in: target ] ifFalse: [ self selectedParcel addSelector: self selection forClass: target ]. self browser updateLists
moveSelectionToParcel: aParcel | target | self changeRequest ifFalse: [^self]. target := self targetClassOrNameSpace. self browser saveParcelsForUndo. target isForNameSpace ifTrue: [ self browser moveData: ( IdentitySet with: self selection ) inNameSpace: target fromParcel: self selectedParcel toParcel: aParcel ] ifFalse: [ self browser moveSelectors: ( IdentitySet with: self selection ) inClass: target fromParcel: self selectedParcel toParcel: aParcel ]. self browser updateLists
removeSelectionConflictsFromParcel self unimplemented
removeSelectionFromParcel | target | self changeRequest ifFalse: [^self]. self browser saveParcelsForUndo. target := self targetClassOrNameSpace. target isForNameSpace ifTrue: [ self selectedParcel removeName: self selection in: target ] ifFalse: [ self selectedParcel removeSelector: self selection forClass: target ]. self browser updateLists
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>menus accessing</category>
getListMenu: forMenuBar | selector parcels cl menu | selector := self selection. cl := self targetClass. "nil if namespace selected." menu := super getListMenu: forMenuBar. ^self browser addParceling: (selector isNil ifTrue: [#()] ifFalse: [nil ~~ (parcels := self browser manager parcelsForClassOrNameSpace: cl) ifTrue: [(self definitionOf: selector) isBindingReference ifTrue: [parcels select: [:p| p definesName: selector in: cl]] ifFalse: [parcels select: [:p| p definesSelector: selector forClass: cl]]]]) to: menu forHelper: self
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>text processing</category>
acceptText: text from: textController "Override to add prompt for parcel membership, and retention of old method in parcel overrides." | currentParcel theClass previousSelector result selector dialog spec aBuilder addSelector addOverride extent over | currentParcel := self selectedParcel. "below, answers nil if namespace. doesn't handle statics." (theClass := self targetClass) isNil ifTrue: [^nil]. (currentParcel notNil and: [(currentParcel definesClass: theClass) not and: [(previousSelector := self selection) notNil]]) ifTrue: [ over := Override forSelector: self selection class: theClass ]. result := super acceptText: text from: textController. result ~~ true ifTrue: [^result]. selector := self selection. selector isNil ifTrue:[^true ]. (currentParcel isNil or: [currentParcel definesSelector: selector forClass: theClass]) ifTrue: [^true]. (over isNil or: [previousSelector ~= selector]) ifTrue: [(Dialog confirm: ((#Add1sToParcel << #dialogs >> 'Add <1s> to parcel?') expandMacrosWith: selector)) ifTrue: [self addSelectionToParcel]. ^true]. dialog := SimpleDialog new. spec := (dialog class interfaceSpecFor: #emptySpec). aBuilder := dialog builder. dialog initializeBuilderFor: self browser builder window. aBuilder add: spec window. aBuilder add: spec component. dialog initializeWindowFor: self browser builder window. dialog setInitialGap. dialog addMessage: ((#Add1sToParcel << #dialogs >> 'Add <1s> to parcel?') expandMacrosWith: selector) centered: true. dialog addGap: 4. dialog addCheckLabels: (Array with: (#addToParcel << #dialogs >> 'add to parcel') with: (#overrideMove << #dialogs >> 'move old version to overridden')) values: (Array with: (addSelector := true asValue) with: (addOverride := over notNil asValue)) equalize: true columns: 1. dialog addDivider. dialog addOK: [true]. dialog preOpen. extent := aBuilder window displayBox extent. aBuilder window maximumSize: extent. aBuilder window minimumSize: extent. aBuilder openDialogWithExtent: extent. dialog cancel value ifTrue: [^true]. addSelector value ifTrue: [self addSelectionToParcel. (over notNil and: [addOverride value]) ifTrue: [ Override installMethodOverride: over ]. ]. ^true
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>emphasis</category>
textEmphasisForItem: anItem | target | target := self selectedClassOrNameSpace. target == nil ifTrue: [ ^#( norm ) ]. ^( ( self isData or: [ target isForNameSpace ] ) ifTrue: [ self emphasizer emphasisForStaticKey: anItem for: self browser id: self selectionId ] ifFalse: [ self emphasizer emphasisForSelector: anItem for: self browser id: self selectionId ] )
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>accessing</category>
selector ^self selection
</methods> <methods> Tools.ParcelSelectorBrowserHelper <category>actions</category>
remove "Override to ensure the parcel forgets the selector if removed." | removed parcel | (removed := super remove) ifTrue: [(parcel := self selectedParcel) notNil ifTrue: [parcel cleanse]]. ^removed
</methods> <methods> Tools.TabApplicationSystemBrowser <category>accessing</category>
components ^self tabApplication systemBrowserComponents
components: aList self tabApplication components: aList. self linkComponents
currentTabApplication "for sideways compatibility." ^tabApplication
currentTabApplication: aTabApplication "for sideways compatibility." self tabApplication: aTabApplication
tabApplication ^tabApplication
tabApplication: aBrowserTabApplication tabApplication := aBrowserTabApplication
</methods> <methods> Tools.TabApplicationSystemBrowser <category>delagating</category>
doesNotUnderstand: aMessage "this delegates anything I don't understand to the current tab application. this is so that behavour normally needed to be sent to the browser can be offloaded to the BrowserTabApplication. This makes adding Tab Applications that don't step on each other easier." | tabApp | tabApp := self tabApplication. ((tabApp) respondsTo: aMessage selector) ifFalse: [^super doesNotUnderstand: aMessage]. ^tabApp perform: aMessage selector withArguments: aMessage arguments
</methods> <methods> Tools.TabApplicationSystemBrowser <category>actions</category>
module: moduleName action: action (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator perform: action]. self components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
module: moduleName action: action with: value (coordinator notNil and: [coordinator menuHeader = moduleName]) ifTrue: [^coordinator dispatch: action with: value]. self components do: [:comp | comp menuHeader = moduleName ifTrue: [^comp dispatch: action with: value]]. self error: (#ThisMenuItemIsNotSupported << #dialogs >> 'This menu item is not supported')
truePerformerFor: moduleName "Answer the module that is responsible for performing menu actions for moduleName. Answer the receiver if none." ( coordinator notNil and: [ coordinator menuHeader = moduleName ] ) ifTrue: [ ^coordinator ]. self components do: [ :comp | comp menuHeader = moduleName ifTrue: [ ^comp ] ]. ^nil
updateLists self tabApplication components isEmpty ifFalse: [self tabApplication components first updateList]
</methods> <methods> Tools.TabApplicationSystemBrowser <category>initialize</category>
initialize inBatchMode := false. text := String new asValue. meta := #instance asValue. meta onChangeSend: #updateProtocolLists to: self. defType := #showDefinition asValue. defType onChangeSend: #updateText to: self. toolBar := nil asValue. selectionDictionary := IdentityDictionary new. "self initializeForNameSpace: Smalltalk."
initializeForAllNameSpaces self ignoreNamepaceChanges: true. self tabApplication initializeForAllNameSpaces. self setNameSpaceFor: #default to: Smalltalk.
initializeForClass: aClass self tabApplication initializeForClass: aClass
initializeForClass: aClass protocol: aProtocol self tabApplication initializeForClass: aClass protocol: aProtocol
initializeForClassHierarchy: aClass self tabApplication initializeForClassHierarchy: aClass
initializeForMethodsLabel: labelString list: aCollection initialSelection: selector self tabApplication initializeForMethodsLabel: labelString list: aCollection initialSelection: selector
initializeForNameSpace: aNameSpace self tabApplication initializeForNameSpace: aNameSpace
initializeForNameSpaces self tabApplication initializeForNameSpaces
initializeForNameSpaces: aNameSpace category: aCategory self tabApplication initializeForNameSpaces: aNameSpace category: aCategory
release self tabApplication release. super release
</methods> <methods> Tools.TabApplicationSystemBrowser <category>private</category>
linkComponents 1 to: self components size-1 do: [:i | (components at: i) browser: self; nextModule: ((i+1) > components size ifTrue:[nil] ifFalse:[ components at: i+1])]. self components last browser: self. self updateLists
numberOfLists | n | n := coordinator == nil ifTrue: [0] ifFalse: [coordinator numberOfLists]. ^self components inject: n into: [:i :comp | i + comp numberOfLists]
tryAll: testBlock default: defaultBlock self components reverseDo: [:comp | | val | val := testBlock value: comp. val == nil ifFalse: [^val]]. ^defaultBlock value
visibleComponentAt: index | n | n := 0. coordinator == nil ifFalse: [n := n + coordinator numberOfLists. n >= index ifTrue: [^coordinator]]. self components do: [:comp | n := n + comp numberOfLists. n >= index ifTrue: [^comp]]. ^self error: ((#Component1pNotFound << #dialogs >> 'Component <1p> not found') expandMacrosWith: index)
</methods> <methods> Tools.TabApplicationSystemBrowser <category>components</category>
menuBar | menu | menu := Menu new addPart: self class menuBarStart. coordinator == nil ifFalse: [coordinator buildMenuBar: menu]. self components do: [:comp | comp buildMenuBar: menu]. menu addPart: self class menuBarEnd. (menu atNameKey: #edit) submenu: self remoteTextMenu. (menu atNameKey: #view) submenu: [self viewMenu]. ^menu
resetToolBar | menu | menu := Menu new. coordinator == nil ifFalse: [coordinator buildToolBar: menu]. self components do: [:comp | comp buildToolBar: menu]. toolBar value: menu
viewMenu | menu | menu := Menu new. coordinator == nil ifFalse: [coordinator buildViewMenu: menu]. self components do: [:comp | comp buildViewMenu: menu]. ^menu
windowLabel ^self components isEmpty ifTrue: [(#SystemBrowser << #labels >> 'System Browser')] ifFalse: [self components first windowLabel]
</methods> <methods> Tools.TabApplicationSystemBrowser <category>text processing</category>
updateText | sel tv | text value: (self tryAll: [:c | c text] default: [Text new]) asText addHyperlinkEmphases. (sel := self tabApplication components first initialSelection) == nil ifFalse: [builder == nil ifFalse: [tv := (builder componentAt: #text) widget. tv deselect. tv controller find: sel. tv displaySelection: true. tv selectAndScroll]]
</methods> <methods> Tools.TabApplicationSystemBrowser <category>spawning</category>
spawnForMethodsLabel: aLabel list: list initialSelection: selection self currentTabApplication spawnForMethodsLabel: aLabel list: list initialSelection: selection with: self currentTabApplication
spawnOnClass: aClass self currentTabApplication spawnOnClass: aClass with: self currentTabApplication
spawnOnClass: aClass protocol: aSelection self currentTabApplication spawnOnClass: aClass with: self currentTabApplication protocol: aSelection
spawnOnClassHierarchy: aClass self currentTabApplication spawnOnClassHierarchy: aClass with: self currentTabApplication
spawnOnNameSpace: aNamespace self currentTabApplication spawnOnNameSpace: aNamespace with: self currentTabApplication
spawnOnNameSpaces: aNamespace category: aCategory self currentTabApplication spawnOnNameSpace: aNamespace with: self currentTabApplication category: aCategory
</methods> <methods> Tools.TabApplicationSystemBrowser <category>selection utlity</category>
selectBehavior: aBehavior self currentTabApplication selectBehavior: aBehavior
selectCategory: aCategory self currentTabApplication selectCategory: aCategory
selectMethod: aSymbol self currentTabApplication selectMethod: aSymbol
selectProtocol: aProtocol self currentTabApplication selectProtocol: aProtocol
</methods> <methods> Tools.TabApplicationSystemBrowser <category>change</category>
updateButtonLabels self updateMajorTabsListFor: self currentTabApplication
</methods> <methods> Tools.TabApplicationSystemBrowser <category>interface opening</category>
postOpenWith: aBuilder "Make current selection visible." super postOpenWith: aBuilder. tabApplication components first checkVisibility
</methods> <methods> Tools.TabApplicationSystemBrowser class <category>application configuration</category>
allButOpenOnClass: aClass ^self openOnClass: aClass with: NamespaceTabApplication
initializeForMethodsLabel: labelString list: aCollection initialSelection: selector with: aBrowserTabApplicationClass | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. inst tabApplication: aBrowserTabApplication; initializeForMethodsLabel: labelString list: aCollection initialSelection: selector. aCollection size = 1 ifTrue: [inst components first forceSelection: aCollection first. inst updateLists]. ^inst open
initializeForNamespacesWith: aBrowserTabApplicationClass | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForAllNameSpaces; open.
openOnAllNameSpaces "self openOnAllNameSpaces" ^self initializeForNamespacesWith: NamespaceTabApplication.
openOnClass: aClass ^self openOnClass: aClass with: NamespaceTabApplication
openOnClass: aClass with: aBrowserTabApplicationClass "self openOnClass: self" | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForClass: aClass; open.
openOnClass: aClass with: aBrowserTabApplicationClass protocol: aSelection "self openOnClass: self" | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForClass: aClass protocol: aSelection; open.
openOnClassHierarchy: aClass ^self openOnClassHierarchy: aClass with: NamespaceTabApplication
openOnClassHierarchy: aClass with: aBrowserTabApplicationClass "self openOnClassHierarchy: self" | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForClassHierarchy: aClass; open.
openOnNameSpace: aNameSpace with: aBrowserTabApplicationClass | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForNameSpace: aNameSpace; open.
openOnNameSpace: aNameSpace with: aBrowserTabApplicationClass on: aCategory | inst aBrowserTabApplication | inst := self new. aBrowserTabApplication := aBrowserTabApplicationClass basicNewOnBrowser: inst. ^inst tabApplication: aBrowserTabApplication; initializeForNameSpaces: aNameSpace category: aCategory ; open.
</methods> <methods> UI.PackagePropertiesDialog <category>help</category>
generalPropertiesHelp ^(#generalPropertiesHelp << #dialogs >> 'This is an inspector on <1s>''s properties. The properties are stored in a IdentityDictionary, and what you see is something that should have the same type of behavior as a normal DictionaryInspector. <n><n>You should be able to add any key->value pair you want. For example, one might want to add a Author property for <1s>. To do so, simply invoke the operate menu from the left pane of the inspector and select "add-field". The Accept button at the bottom of this page will only be enabled after you actually accept from the operate menu in the embedded inspector''s right pane.<n>NOTE: properties with a value of nil will be removed.') expandMacrosWith: self package name
loadHelp ^(#packagePropertiesHelp << #dialogs >> 'Loading actions are one argument blocks that take the package / parcel being loaded as an argument. In the case of parcels, the PreLoadAction is run after all the code from a parcel has been parsed but before the code has been installed in the system. Hence the pre-load action may happen too late to do things that affect the contents of a parcel. Use the pre-read action if you want an action that runs before the parcel''s contents are parsed. In the case of packages, code is currently compiled definition by definition so the pre-read and pre-load actions are run immediately consecutively. PreReadAction <code parsed from parcel and built> PreLoadAction <code installed into the system> PostLoadAction ')
loadOptionsHelp ^(#loadOptionsHelp << #dialogs >> 'A Parcel''s warning suppression action must be a block taking one argument, the name of a prerequisite Parcel being loaded. The block should answer true if any warnings caused by loading the prerequsiite shouild be suppressed. The warning suppression block is run before any of the Parcel''s code is loaded. Consequently it cannot and should not mention any code in this Parcel.')
preReadHelp ^(#preReadHelp << #dialogs >> 'A Parcel''s pre-read action is a zero argument block, which is run before any of the Parcel is read, but after any of its prerequisites are loaded. The block should answer true if loading is to continue; any other return value will abort the load. A Parcel''s prerequisite version block must be a block taking three arguments, the name of a prerequisite Parcel being loaded, its version string, and the version string defined in the Parcel''s list of prerequisites. The block should answer true if the prerequsite''s version is acceptable, and should be loaded. Otherwise the loader will continue to search for another parcel of the same name with a different version.')
prerequisitesHelp ^(#prerequisitesHelp << #dialogs >> 'Deployment prerequsites are an array of prerequisite parcels. Each individual prerequisite is a name, version pair. On loading the Parcel loader searches along the SearchPath for .pcl files that have the required name and attempts to load them. All parcels have a version which is an arbitrary string, that defaults to the empty string. Each Parcel can also define a prerequisite version block which it can use to select appropriate versions of prerequisite parcels. Development prerequisites are used in loading from Store. Each prerequisite is an array with a type (#parcel #package #bundle or #any), a name and a version string. Developement prerequisites are usually supersets of the deployment prerequisities.')
saveHelp ^(#saveHelp << #dialogs >> 'Save actions are one argument blocks that take the package / parcel being saved as an argument. PreSaveAction ')
unloadHelp ^(#unloadHelp << #dialogs >> 'Unloading actions are actions run when unloading a package or parcel. The preUnloadAction is run before unloading commences. It is a one-argument block that takes the package or parcel being unloaded as an argument. The postUnloadAction is a zero-argument block run after the package or parcel has been unloaded and discarded. PreUnloadAction <code removed from system> PostUnloadAction ')
</methods> <methods> UI.PackagePropertiesDialog <category>accessing</category>
package ^package
package: aPackage package := aPackage. self initializeProperties.
</methods> <methods> UI.PackagePropertiesDialog <category>interface</category>
labelFor: aKey "Return an instance of a non-abstract subclass of CharacterArray, that will be used as a label for a component." ^[ self perform: aKey ] on: MessageNotUnderstood do: [ : e | e return: aKey ].
windowLabel ^package == nil ifTrue: [ (#PackageProperties << #labels >> 'Package properties') ] ifFalse: [ (#packageName << #labels >> '<1s> properties') expandMacrosWith: package name ]
</methods> <methods> UI.PackagePropertiesDialog <category>initialization</category>
actionStringFor: aPackageAction numArgs: numArgs | string | string := CodeComponent stringFromAction: (package perform: aPackageAction). ^(string isNil ifTrue: [self defaultActionTextFor: numArgs] ifFalse: [string]) asText
initializeProperties "Initialize the receiver's values from the package." properties := IdentityDictionary new. properties at: #deploymentPrerequisites put: package deploymentPrerequisites storeString asValue; at: #developmentPrerequisites put: package developmentPrerequisites storeString asValue; at: #versionSelection put: (package versionSelectionBlock == nil ifTrue: [self defaultVersionSelectionText] ifFalse: [package versionSelectionBlock]) asValue. #(#preload #postload #preunload #presave) with: #(#preLoadBlock #postLoadBlock #preUnloadBlock #preSaveBlock) do: [:aspect :action | properties at: aspect put: (self actionStringFor: action numArgs: 1) asValue]. properties at: #warningSuppression put: (package warningSuppressionBlock == nil ifTrue: [self defaultWarningSuppressionText] ifFalse: [package warningSuppressionBlock]) asValue. properties at: #preRead put: (package preReadBlock == nil ifTrue: [self defaultPreReadText] ifFalse: [self actionStringFor: #preReadBlock numArgs: 0]) asValue. properties at: #postunload put: (self actionStringFor: #postUnloadBlock numArgs: 0) asValue. properties at: #generalProperties put: (ParcelPropertiesInspector new inspect: package properties). ^properties
</methods> <methods> UI.PackagePropertiesDialog <category>private</category>
defaultActionTextFor: numArgs ^(numArgs =1 ifTrue: [(#defaultActionText << #dialogs >> '[ :pkg | <nn>]')] ifFalse: ['[<nn>]']) expandMacros asText
defaultPreReadText ^(#defaultPreReadText << #dialogs >> '[<nn>booleanExpression<nn>]') expandMacros asText
defaultVersionSelectionText ^(#defaultVersionSelectionText << #dialogs >> '[ :parcelName :versionString :requiredVersionString |<n> booleanExpression<n>]') expandMacros asText
defaultWarningSuppressionText ^(#defaultWarningSuppressionText << #dialogs >> '[:prerequisiteName|<n>booleanExpression<n>]') expandMacros asText
rebuild "We need to ensure that we get callback notification on changes to the TextEditors and that the proper menu is used for the TextEditor. Fortunately, we thought ahead and chose a naming convention for the editors to allow for easy selecting from the subBuilder." | textEditorNames | super rebuild. textEditorNames := subBuilder namedComponents keys select: [:name | '*Text' match: name]. textEditorNames do: [:name | | textController | textController := (subBuilder componentAt: name) widget controller. textController continuousAccept: true. textController initializeMenuForCode]
removeAction: actionSymbol ( Dialog confirm: ( (#prereqRemove << #dialogs >> 'Remove <1s> from <2s>?') expandMacrosWith: actionSymbol with: package name ) ) ifTrue: [ package propertyAt: actionSymbol put: nil ]
validateBlock: code numberOfArguments: integer notifying: aController "Validate that code compiles to a block with integer # of arguments. Accepts empty strings as an attempt to remove an attribute. Return a symbol to the receiver that indicates what the problem is." | blk | (code == nil or: [code isEmpty]) ifTrue: [^#ok]. code = (self defaultActionTextFor: integer) ifTrue: [ ^#unspecified ]. blk := self class compilerClass new evaluate: code string in: nil allowReceiver: false receiver: nil environment: Object environment notifying: aController ifFail: [^#compile]. ^[blk numArgs == integer ifTrue: [#ok] ifFalse: [#arguments]] on: MessageNotUnderstood do: [:e | e return: #compile]
</methods> <methods> UI.PackagePropertiesDialog <category>properties</category>
deploymentPrerequisitesText ^properties at: #deploymentPrerequisites
developmentPrerequisitesText ^properties at: #developmentPrerequisites
generalProperties ^properties at: #generalProperties
generalPropertiesAccept "Update the properties to the package/parcel with the modified properties." | editingProperties | editingProperties := self generalProperties object. editingProperties associationsDo: [ :assoc | ( self package propertyAt: assoc key ) = assoc value ifTrue: [ editingProperties removeKey: assoc key ] ]. self package copyPropertiesFrom: editingProperties. self generalProperties inspect: self package properties.
generalPropertiesReset | oldSelection | oldSelection := self generalProperties fieldListHolder selection. [self generalProperties inspect: self package properties] ensure: [self generalProperties fieldListHolder selection: oldSelection]
loadAccept | postLoadStatus textController numBlockArgs preLoadStatus | numBlockArgs := 1. textController := (subBuilder componentAt: #postloadText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. postLoadStatus := self validateBlock: (properties at: #postload) value numberOfArguments: numBlockArgs notifying: textController. postLoadStatus == #arguments ifTrue: [^Dialog warn: ((#errPostLoadArguments << #dialogs >> 'Post-Load action has wrong number of arguments. It expects <1p>')expandMacrosWith:numBlockArgs)]. postLoadStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. textController := (subBuilder componentAt: #preloadText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. preLoadStatus := self validateBlock: (properties at: #preload) value numberOfArguments: numBlockArgs notifying: textController. preLoadStatus == #arguments ifTrue: [^Dialog warn: ((#errPreLoadArguments << #dialogs >> 'Pre-Load action has wrong number of arguments. It expects <1p>') expandMacrosWith: numBlockArgs)]. preLoadStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. package preLoadBlock: (preLoadStatus == #unspecified ifTrue: [nil] ifFalse: [CodeComponent asActionBlock: (properties at: #preload) value]). package postLoadBlock: (postLoadStatus == #unspecified ifTrue: [nil] ifFalse: [CodeComponent asActionBlock: (properties at: #postload) value])
loadOptionsAccept | numBlockArgs textController warningSuppressionStatus | numBlockArgs := 1. textController := (subBuilder componentAt: #warningSuppressionText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. warningSuppressionStatus := self validateBlock: (properties at: #warningSuppression) value numberOfArguments: numBlockArgs notifying: textController. warningSuppressionStatus == #arguments ifTrue: [^Dialog warn: ((#errSuppressionArguments << #dialogs >> 'Warning suppression action has wrong number of arguments. It expects <1p>') expandMacrosWith: numBlockArgs)]. warningSuppressionStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. package warningSuppressionBlock: (warningSuppressionStatus == #unspecified ifTrue: [nil] ifFalse: [(CodeComponent asActionBlock: (properties at: #warningSuppression) value)])
loadOptionsRemove self removeAction: #warningSuppressionBlock. self loadOptionsReset.
loadOptionsReset | warningSuppression | (warningSuppression := CodeComponent stringFromAction: (package perform: #warningSuppressionBlock)) isNil ifTrue: [warningSuppression := self defaultWarningSuppressionText]. ( properties at: #warningSuppression ) value: ( warningSuppression ).
loadRemove self removeAction: #preLoadBlock. self removeAction: #postLoadBlock. self loadReset.
loadReset (properties at: #preload) value: (self actionStringFor: #preLoadBlock numArgs: 1). (properties at: #postload) value: (self actionStringFor: #postLoadBlock numArgs: 1)
postloadText ^properties at: #postload
postunloadText ^properties at: #postunload
preloadText ^properties at: #preload
preReadAccept | readStatus textController numBlockArgs versionStatus | numBlockArgs := 0. textController := (subBuilder componentAt: #preReadText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. readStatus := (properties at: #preRead) value = self defaultPreReadText ifTrue: [#unspecified] ifFalse: [self validateBlock: (properties at: #preRead) value numberOfArguments: 0 notifying: textController]. readStatus == #arguments ifTrue: [^Dialog warn: ((#errPreLoadArguments << #dialogs >> 'Pre-Load action has wrong number of arguments. It expects <1p>') expandMacrosWith: numBlockArgs)]. readStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. numBlockArgs := 0. versionStatus := (properties at: #versionSelection) value = self defaultVersionSelectionText ifTrue: [#unspecified] ifFalse: [(self validateBlock: ( properties at: #versionSelection ) value numberOfArguments: 3 notifying: (subBuilder componentAt: #versionSelectionText) widget controller)]. versionStatus == #arguments ifTrue: [^Dialog warn: ((#errVersionSelectionArguments << #dialogs >> 'version selection action has wrong number of arguments. It expects <1p>') expandMacrosWith: numBlockArgs)]. versionStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. package preReadBlock: (readStatus == #unspecified ifTrue: [nil] ifFalse: [CodeComponent asActionBlock: (properties at: #preRead) value]). package versionSelectionBlock: (versionStatus == #unspecified ifTrue: [nil] ifFalse: [CodeComponent asActionBlock: (properties at: #versionSelection) value])
preReadRemove self removeAction: #preReadBlock. self removeAction: #versionSelectionBlock. self preReadReset
preReadReset ( properties at: #preRead ) value: ( package preReadBlock == nil ifTrue: [ self defaultPreReadText ] ifFalse: [ self actionStringFor: #preReadBlock numArgs: 0 ] ). ( properties at: #versionSelection ) value: ( package versionSelectionBlock == nil ifTrue: [ self defaultVersionSelectionText ] ifFalse: [ package versionSelectionBlock ] ).
preReadText ^properties at: #preRead
prerequisitesAccept | missing devSet | package deploymentPrerequisites: (Compiler evaluate: ( properties at: #deploymentPrerequisites ) value asString). package developmentPrerequisites: (Compiler evaluate: ( properties at: #developmentPrerequisites ) value asString). missing := OrderedCollection new. devSet := ( package developmentPrerequisites collect: [ :array | array at: 2 ] ) asSet. package deploymentPrerequisites do: [ :array | ( devSet includes: array first ) ifFalse: [ missing add: ( array first ) ]. ]. missing isEmpty ifFalse: [ | str | str := (String new: 256) writeStream. missing do: [ :name | str nextPutAll: ' ', name ]. Dialog warn: ((#DevPrereqsMissing << #dialogs >> 'Development prerequisites appear to be missing:<1s>.') expandMacrosWith: str contents). ].
prerequisitesRemove ( Dialog confirm: ( (#prereqRemove << #dialogs >> 'Remove <1s> from <2s>?') expandMacrosWith: #deploymentPrerequisites with: package name ) ) ifTrue: [ package deploymentPrerequisites: nil ]. self removeAction: #developmentPrerequisites. self prerequisitesReset.
prerequisitesReset ( properties at: #deploymentPrerequisites ) value: ( package deploymentPrerequisites storeString ). ( properties at: #developmentPrerequisites ) value: ( package developmentPrerequisites storeString ).
prerequisitesText ^properties at: #prerequisites
presaveText ^properties at: #presave
preunloadText ^properties at: #preunload
saveAccept | validationStatus textController numBlockArgs | numBlockArgs := 1. textController := (subBuilder componentAt: #presaveText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. validationStatus := self validateBlock: (properties at: #presave) value numberOfArguments: numBlockArgs notifying: textController. validationStatus == #arguments ifTrue: [^Dialog warn: ((#errPreSaveArguments << #dialogs >> 'Pre-Save action has wrong number of arguments. It expects <1p>') expandMacrosWith: numBlockArgs)]. validationStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. package preSaveBlock: (validationStatus == #unspecified ifTrue: [nil] ifFalse: [CodeComponent asActionBlock: (properties at: #presave) value])
saveRemove self removeAction: #preSaveBlock. self saveReset.
saveReset (properties at: #presave) value: (self actionStringFor: #preSaveBlock numArgs: 1).
unloadAccept | postUnloadStatus textController numPreUnloadBlockArgs numPostUnloadBlockArguments preUnloadStatus | numPreUnloadBlockArgs := 1. numPostUnloadBlockArguments := 0. textController := (subBuilder componentAt: #postunloadText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. postUnloadStatus := self validateBlock: (properties at: #postunload) value numberOfArguments: numPostUnloadBlockArguments notifying: textController. postUnloadStatus == #arguments ifTrue: [^Dialog warn: ((#errPostLoadArguments << #dialogs >> 'Post-Load action has wrong number of arguments. It expects <1p>') expandMacrosWith: numPostUnloadBlockArguments)]. postUnloadStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. textController := (subBuilder componentAt: #preunloadText) widget controller. subBuilder keyboardProcessor setActive: textController. textController selectEntireText. preUnloadStatus := self validateBlock: (properties at: #preunload) value numberOfArguments: numPreUnloadBlockArgs notifying: textController. preUnloadStatus == #arguments ifTrue: [^Dialog warn: ((#errPreUnloadArguments << #dialogs >> 'Pre-Unload action has wrong number of arguments. It expects <1p>') expandMacrosWith: numPreUnloadBlockArgs)]. preUnloadStatus == #compile ifTrue: [self undisturb. ^Dialog warn: (#errFixCompilation << #dialogs >> 'Fix the compiliation error')]. package preUnloadBlock: (preUnloadStatus == #unspecified ifTrue: [nil] ifFalse: [(CodeComponent asActionBlock: (properties at: #preunload) value)]). package postUnloadBlock: (postUnloadStatus == #unspecified ifTrue: [nil] ifFalse: [(CodeComponent asActionBlock: (properties at: #postunload) value)])
unloadRemove self removeAction: #preUnloadBlock. self removeAction: #postUnloadBlock. self unloadReset.
unloadReset (properties at: #preunload) value: (self actionStringFor: #preUnloadBlock numArgs: 1). (properties at: #postunload) value: (self actionStringFor: #postUnloadBlock numArgs: 0)
versionSelectionText ^properties at: #versionSelection
warningSuppressionText ^properties at: #warningSuppression
</methods> <methods> UI.PackagePropertiesDialog <category>events</category>
noticeOfWindowClose: aWindow super noticeOfWindowClose: aWindow. self release
</methods> <methods> UI.PackagePropertiesDialog <category>updating</category>
update: anAspectSymbol with: aParameter from: aSender (anAspectSymbol = #accept and: ([aSender class = ParcelPropertiesInspector and: [aParameter]])) ifTrue: [self disturb]. ^super update: anAspectSymbol with: aParameter
</methods> <methods> UI.PackagePropertiesDialog <category>interface opening</category>
postOpenWith: aBuilder "We do not use the keyboard hook that the superclass sets up because of our implementation of #rebuild. Also, we set up a dependency on our embedded inspector to get the Accept and Reset buttons to reflect the true state of things" super postOpenWith: aBuilder. self builder window keyboardProcessor keyboardHook: nil. self generalProperties fieldListHolder listHolder onChangeSend: #disturb to: self. self generalProperties addDependent: self
</methods> <methods> UI.PackagePropertiesDialog <category>initialize-release</category>
release super release. self generalProperties removeDependent: self. self generalProperties fieldListHolder listHolder retractInterestsFor: self
</methods> <methods> UI.PackagePropertiesDialog class <category>interface opening</category>
invalidUseWarning "Raise a Dialog to warn the client of the receiver that they are not using the correct protocol to open an instance." Dialog warn: ((#invalidDialogUseWarning << #dialogs >> 'You must open up <1s> with #on:<n><1s> requires a subclass of<n>CodeComponent to be properly initialized.') expandMacrosWith: self name)
open "Use #on: instead, as the receiver relies on a CodeComponent to properly initialize itself." self invalidUseWarning
</methods> <methods> UI.PackagePropertiesDialog class <category>class initialization</category>
initialize "self initialize" | complexList | complexList := OrderedCollection new add: (#Prerequisites << #labels >> 'Prerequisites')->#(#prerequisitesSpec #prerequisitesHelp); add: (#LoadOptions << #labels >> 'Load Options')->#(#loadOptionsSpec #loadOptionsHelp); add: (#PrereadActions << #labels >> 'Preread Actions')->#(#preReadSpec #preReadHelp); add: (#LoadActions << #labels >> 'Load Actions')->#(#loadSpec #loadHelp); add: (#UnloadActions << #labels >> 'Unload Actions')->#(#unloadSpec #unloadHelp); add: (#SaveActions << #labels >> 'Save Actions')->#(#saveSpec #saveHelp); add: (#OtherProperties << #labels >> 'Other Properties')->#(#generalPropertiesSpec #generalPropertiesHelp); asArray. developmentTabLabels := (complexList collect: [:each | each key]) asArray. tabSpecsAndHelpSelectors := (complexList collect: [:each | each value]) asArray. runtimeTabLabels := Array new
masterList "For the VisualWorks tools use case we only want to use the development lables. In other words, we do not encourage deployment of our tools." ^self developmentTabLabels
on: aPackage "Open a properties dialog on aPackage." self openOn: ( self new package: aPackage; yourself )
</methods> <methods> Tools.MorphingBrowserModule <category>accessing</category>
currentHelper | primary | primary := helpers first selected: #environment. primary == nil ifTrue: [ ^helpers first ]. ^( primary isBehavior and: [ browser isData not ] ) ifTrue: [ helpers first ] ifFalse: [ helpers at: 2 ]
meta ^self browser meta
</methods> <methods> Tools.MorphingBrowserModule class <category>interface specs</category>
preferredSpec ^self listSpecProtocols
preferredSpecName ^#listSpecProtocols
</methods> <methods> Tools.NamespaceTabApplication <category>componentBuilding</category>
allCategoriesComponent ^SimpleBrowserModule new helpers: (Array with: (NameSpaceOrganizerBrowserHelper new searchChildNamespaces: true) ).
allClassesComponent ^SimpleBrowserModule new helperType: NameSpaceGlobalCategoryBrowserHelper; yourself
buildComponentArray super buildComponentArray. self indexOfCategoryCanvas: 1.
categoriesComponent ^SimpleBrowserModule new helperType: NameSpaceOrganizerBrowserHelper.
classesComponent ^SimpleBrowserModule new helperType: NameSpaceCategoryBrowserHelper
classHierarchyComponent ^SimpleBrowserModule new helperType: ClassHierarchyBrowserHelper; yourself
componentId ^#NameSpaceTab
protocolsComponent ^SimpleBrowserModule new specName: #listSpecProtocols; helperType: ProtocolBrowserHelper.
selectorsComponent ^SimpleBrowserModule new helperType: SelectorBrowserHelper
</methods> <methods> Tools.NamespaceTabApplication <category>accessing subcanvases</category>
getCanvas | module | module := self namespaceHierachyComponent. module browser: self browser. ^module
namespaceHierachyComponent ^HierarchicalBrowserModule new helperType: NameSpaceHierarchyBrowserHelper
</methods> <methods> Tools.NamespaceTabApplication <category>accessing</category>
categoriesLabel ^self browser selectedEnvironment notNil ifTrue: [self categoryTabCanvas selection notNil ifTrue: [self categoryTabCanvas selection] ifFalse: [((#x1sCategories << #dialogs >> '<1s> Categories') expandMacrosWith: self browser selectedEnvironment name asString)]] ifFalse: [(#Categories << #labels >> 'Categories') asString]
icon ^icon isNil ifTrue:[ icon := self eraseBackgroundOnImage: (self class folderIcon)] ifFalse:[icon ]
label ^self browser selectedEnvironment notNil ifTrue: [((#x1sNameSpace << #dialogs >> '<1s> NameSpace') expandMacrosWith: self browser selectedEnvironment name asString)] ifFalse: [self class label]
</methods> <methods> Tools.NamespaceTabApplication <category>testing</category>
isNamspaceTabApp ^true
</methods> <methods> Tools.NamespaceTabApplication <category>initialize</category>
initializeForAllNameSpaces self browser setNameSpaceFor: #default to: Root. components := List new. components add: self allCategoriesComponent. components add: self allClassesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponentsInArray: components. self browser updateLists
initializeForClass: aClass self browser setNameSpaceFor: #default to: aClass environment. self browser meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). components := List new. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self browser setClassOrNameSpaceFor: #default to: aClass. self linkComponentsInArray: components. self linkFirstComponentToSubcanvas. components first forceSelection: aClass; updateList
initializeForClass: aClass protocol: aProtocol self browser setNameSpaceFor: #default to: aClass environment. self browser meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). components := List new. components add: self protocolsComponent. components add: self selectorsComponent. self browser setClassOrNameSpaceFor: #default to: aClass. self browser setProtocolFor: #default to: aProtocol. self linkComponentsInArray: components. self linkFirstComponentToSubcanvas. components first forceSelection: aProtocol; updateList
initializeForClassHierarchy: aClass | cls | self browser setNameSpaceFor: #default to: aClass environment. self browser meta value: (aClass isMeta ifTrue: [#class] ifFalse: [#instance]). cls := aClass instanceBehavior. self browser setClassOrNameSpaceFor: #default to: aClass. components := List new. components add: self classHierarchyComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponentsInArray: components. self browser updateLists. "self linkFirstComponentToSubcanvas." components first selection: cls; updateList.
initializeForMethodsLabel: labelString list: aCollection initialSelection: selector | helper module | helper := MethodListBrowserHelper new. helper label: labelString; baseList: aCollection; initialSelection: selector. module := SimpleBrowserModule new helpers: (Array with: helper). components := List new. components add: module. self linkComponentsInArray: components. self linkFirstComponentToSubcanvas. self browser updateLists.
initializeForNameSpace: aNameSpace components := List new. self browser setNameSpaceFor: #default to: aNameSpace. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponentsInArray: components. self browser updateLists
initializeForNameSpaces self browser setNameSpaceFor: #default to: nil. components := List new. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self linkComponentsInArray: components. self browser updateLists
initializeForNameSpaces: aNameSpace category: aCategory components := List new. components add: self categoriesComponent. components add: self classesComponent. components add: self protocolsComponent. components add: self selectorsComponent. self browser setNameSpaceFor: #default to: aNameSpace. self browser setCategoryFor: #default to: aCategory. self linkComponentsInArray: components. self browser updateLists components first forceSelection: aCategory; updateList
</methods> <methods> Tools.NamespaceTabApplication class <category>accessing</category>
label ^(#NameSpaces << #labels >> 'NameSpaces') asString
</methods> <methods> Tools.NameSpaceNavigator <category>initialize</category>
initialize super initialize. home := nil asValue. home onChangeSend: #updateList to: self. action := nil asValue. action onChangeSend: #doAction to: self. list := SelectionInList new. path := SelectionInList new. list selectionIndexHolder onChangeSend: #maybeNoPath to: self. path selectionIndexHolder onChangeSend: #maybeNoList to: self.
</methods> <methods> Tools.NameSpaceNavigator <category>accessing</category>
action ^action
doAction self perform: action value
finalSelection ^list selection == nil ifTrue: [path selection == nil ifTrue: [home value] ifFalse: [path selection value]] ifFalse: [list selection value]
home ^home
list ^list
openSelection list selection == nil ifTrue: [path selection == nil ifTrue: [] ifFalse: [home value: path selection value]] ifFalse: [home value: list selection value]
path ^path
</methods> <methods> Tools.NameSpaceNavigator <category>updating</category>
maybeNoList path selectionIndex = 0 ifTrue: [(list selectionIndex = 0 and: [path list size ~= 0]) ifTrue: [path selectionIndex: path list size]] ifFalse: [list selectionIndex: 0]
maybeNoPath list selectionIndex = 0 ifTrue: [path list size = 0 ifFalse: [path selection: path list last]] ifFalse: [path selectionIndex: 0]
updateList | vars newPath | vars := SortedCollection new. home value bindingsDo: [:var | var isForNameSpace ifTrue: [vars add: var]]. list list: vars asList. newPath := List with: home value. [newPath first environment == nil] whileFalse: [newPath addFirst: newPath first environment]. newPath := newPath collect: [:env | BrowserListEntry new value: env]. 1 to: newPath size do: [:i | (newPath at: i) offset: i-1*12@0]. path list: newPath. path selection: newPath last
</methods> <methods> Tools.NameSpaceNavigator <category>searching</category>
addList: model lines: maxLines validation: valid | height layout field grid font scrollW max fullMax | height := builder window displayBox height. layout := LayoutFrame new. layout leftOffset: 16. layout rightFraction: 1 offset: -16. layout topOffset: height. field := SequenceViewSpec model: model menu: nil layout: layout. field selectionType: #normalSelection. builder add: field. builder wrapper widget controller setDispatcher: (UIDispatcher new doubleClick: [valid value ifTrue: [self doubleClickList]]). builder wrapper widget setValidTargetIndex: model selectionIndex. scrollW := builder wrapper decorator scrollerComponent. scrollW preferredBoundsBlock: [:sw | | rect | rect := sw component preferredBounds translatedBy: sw translation. rect height: maxLines*sw scrollGrid y. rect]. font := builder wrapper widget textStyle defaultFont. font := Screen default defaultFontPolicy findFont: font. max := model list inject: 0 into: [:i :str | i max: str size]. "Instead of exactly measuring every string, we assume that $o will be a fairly representative character. Actually, $o will probably be wider than the average, but this will usually be OK." max := (font widthOf: $o) * max. "Don't let the dialog get too wide." fullMax := 350. max > fullMax ifTrue: [max := fullMax. builder wrapper decorator useHorizontalScrollBar. builder wrapper widget measureWidth: true]. grid := builder wrapper preferredBounds height. layout bottomOffset: height+grid. self addGap: grid. self minWidth: max + 48. ^builder wrapper
addNoCloseLabels: labels values: values default: defaultValue storeInto: result takeKeyboard: takeKeyboard equalize: eqBoolean | num maxButtonWidth maxButtonHeight separation buttonWAs buttonWidth window box layout left top actualColumns actualRows | num := labels size. maxButtonWidth := 0. maxButtonHeight := 0. separation := 20. buttonWAs := OrderedCollection new. window := builder window. box := window displayBox. actualColumns := SmallInteger maxVal min: labels size. actualRows := num + actualColumns - 1 // actualColumns. "We have to create and place the buttons before we can ask them their preferred bounds and refine their spacing." layout := LayoutFrame new. layout leftFraction: 0.5; rightFraction: 0.5. builder newComposite. 1 to: num do: [:index | | lbl val buttonSpec buttonW bExt | lbl := labels at: index. val := values at: index. (buttonSpec := ActionButtonSpec model: (result == nil ifTrue: [val] ifFalse: [[result value: val]]) label: lbl layout: (0@0 extent: 1@1)) defaultable: (values includes: defaultValue); isDefault: val == defaultValue. builder add: buttonSpec. buttonW := builder wrapper. (takeKeyboard and: [val == defaultValue]) ifTrue: [builder keyboardProcessor setActive: buttonW widget controller]. maxButtonWidth := maxButtonWidth max: (bExt := buttonW preferredBounds extent) x. maxButtonHeight := maxButtonHeight max: bExt y. buttonWAs add: buttonW -> bExt]. buttonWidth := eqBoolean ifTrue: [actualColumns * maxButtonWidth + ((actualColumns - 1) * separation)] ifFalse: [buttonWAs inject: separation negated into: [:x :assoc | x + assoc value x + separation]]. layout topOffset: box height; bottomOffset: box height+(actualRows * maxButtonHeight). layout leftOffset: 0 - ((buttonWidth + 1) // 2); rightOffset: (buttonWidth + 1) // 2. builder endCompositeLayout: layout. left := 0. top := 0. 1 to: num do: [:index | | bttnWA width | bttnWA := buttonWAs at: index. width := eqBoolean ifTrue: [maxButtonWidth] ifFalse: [bttnWA value x]. bttnWA key newLayout: (Rectangle left: left right: left + width top: top bottom: top + maxButtonHeight). index \\ actualColumns = 0 ifTrue: [left := 0. top := top + maxButtonHeight] ifFalse: [left := left + width + separation]]. self addGap: maxButtonHeight * actualRows. buttonWidth := buttonWidth + separation. self minWidth: buttonWidth. ^builder wrapper
doubleClickList list selection == nil ifTrue: [path selection == nil ifFalse: [home value: path selection value]] ifFalse: [home value: list selection value].
</methods> <methods> Tools.NameSpaceNavigator class <category>searching</category>
searchFrom: aNameSpace label: label "NameSpaceNavigator searchFrom: Smalltalk label: 'Move to which environment?' " | sd spec listW buttons | sd := self new. sd home value: aNameSpace. spec := (sd class interfaceSpecFor: #emptySpec). sd builder add: spec window. sd builder add: spec component. sd setInitialGap. sd addMessage: label centered: true. sd addGap: 8. sd addList: sd path lines: 4 validation: [sd path selectionIndex > 0]. sd addGap: 8. listW := sd addList: sd list lines: 8 validation: [sd list selectionIndex > 0]. listW widget setValidTargetIndex: sd list selectionIndex. sd addGap: 4. buttons := sd addOK: [true]. sd addGap: 15. sd addNoCloseLabels: (Array with: (#Open << #dialogs >> 'Open')) values: #(#openSelection) default: nil storeInto: sd action takeKeyboard: true equalize: true. sd addGap: 6. sd bottomAlignLowerEdge: listW. sd bottomAlign: (Array with: buttons). sd preOpen. sd builder openDialogWithExtent: sd builder window displayBox extent. ^sd accept value ifTrue: [sd finalSelection] ifFalse: [nil]
</methods> <methods> Tools.PickASomethingDialog <category>intialize</category>
intialize self list onChangeSend: #changedSelection to: self
</methods> <methods> Tools.PickASomethingDialog <category>actions</category>
doAccept self list selection isNil ifTrue: [accept value: false] ifFalse: [accept value: true. self close]
doubleClick self doAccept
</methods> <methods> Tools.PickASomethingDialog <category>interface opening</category>
postBuildWith: aBuilder | component | (component := aBuilder componentAt: #list) isNil ifTrue: [^self]. component widget visualBlock: self visualBlock; selectedVisualBlock: self selectedVisualBlock
</methods> <methods> Tools.PickASomethingDialog <category>private</category>
selectedVisualBlock "Supply the block that determins the appearance for selected list entries." ^[ :view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry value. aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label:= listEntry displayLabel: aText) attributes: view textStyle; offset: label offset. label:= ReversingWrapper on: label. label reverse setValue: true. BoundedWrapper on: label]
textEmphasisForItem: anItem "Supply the default emphasis for list items" ^#( #norm )
textForItem: aListEntry ^aListEntry fullName asText
visualBlock "Supply the block that determins the appearance for unselected list entries." ^[:view :index | | aText anItem listEntry label | listEntry := view sequence at: index. anItem := listEntry value. aText := self textForItem: anItem. aText emphasizeAllWith: (self textEmphasisForItem: anItem). (label := listEntry displayLabel: aText) attributes: view textStyle; offset: label offset. BoundedWrapper on: label]
</methods> <methods> Tools.PickASomethingDialog <category>aspects</category>
list "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^list isNil ifTrue: [list := SelectionInList new] ifFalse: [list]
</methods> <methods> Tools.PickASomethingDialog <category>change</category>
changedSelection self list selection isNil ifTrue: [accept value: false] ifFalse: [accept value: true]
</methods> <methods> Tools.PickASomethingDialog class <category>opening</category>
pickASomethingFrom: aListOfBrowserListEntries | sd | sd := self new. sd list list: aListOfBrowserListEntries. sd open ifFalse:[^nil]. ^sd list selection
</methods> <methods> Tools.ParcelEmphasizer <category>private-status</category>
behaviorStatus: aBehavior criteria: aParcel "Compute the status for a Behavior (class or metaclass)." | parcels status definedCount extendedCount | status := Set new: 4. aBehavior isNil ifTrue: [ ^status "shouldn't happen" ]. parcels := self manager parcelsForClassOrNameSpace: aBehavior. nil == parcels ifTrue: [ ^status ]. definedCount := extendedCount := 0. parcels do: [ :parcel | ( parcel definesClass: aBehavior ) ifTrue: [ definedCount := definedCount + 1. status add: ( parcel == aParcel ifTrue: [ #defined ] ifFalse: [ #definedByOther ] ). ( parcel == aParcel and: [((aBehavior isMeta or: [aBehavior hasClassPool not]) ifTrue: [true] ifFalse: [nil == (aBehavior classVarNames detect: [:cvn| (parcel definesName: cvn in: aBehavior) not] ifNone: [])]) and: [ | defined selectors | "This is a performance-critical piece of code since it dominates computing category emphases for categories that are entirely defined by a Parcel. Hence there is some effort to optimize the comparison of defined and implemented selectors." defined := parcel definedSelectorsFor: aBehavior. selectors := aBehavior organization elements. defined size = selectors size and: [nil == (selectors detect: [:sel| (defined includes: sel) not] ifNone: [])]]]) ifTrue: [ status add: #entirelyDefined ] ]. ( parcel extendsBehavior: aBehavior) ifTrue: [ extendedCount := extendedCount + 1. status add: (parcel == aParcel ifTrue: [ #extended ] ifFalse: [ #extendedByOther ] ) ] ]. ( definedCount > 1 "more than one parcel defines the behavior" or: [ definedCount + extendedCount > 1 "may be multiply parcelled selectors - go check" and: [(self computeConflictsFor: ( Array with: aBehavior ) within: nil) first size > 0]]) ifTrue: [ status add: #conflict ]. ^status
categoryStatus: aCategory in: environment criteria: aParcel "Compute the status for aCategory." | list status definedEntirely | status := Set new: 4. environment == nil ifTrue: [ list := OrderedCollection new. Root withAllNameSpaces do: [ :env | list addAll: ( env organization thingsAtCategoryNamed: aCategory ) ]. ] ifFalse: [ list := ( environment organization thingsAtCategoryNamed: aCategory ) ]. list := list reject:[ :each | each ==nil ]. list isEmpty ifTrue: [ ^status ]. definedEntirely := true. list do: [ :aThing | | thingStatus | thingStatus := aThing isForNameSpace ifTrue: [ self nameSpaceStatus: aThing criteria: aParcel ] ifFalse: [ aThing isForClass ifTrue: [ self classStatus: aThing criteria: aParcel ] ifFalse: [ #( #entirelyDefined ) ]. "ignore bindings" ]. definedEntirely := definedEntirely and: [ thingStatus includes: #entirelyDefined ]. status addAll: thingStatus ]. definedEntirely ifFalse: [ status remove: #entirelyDefined ifAbsent: nil ]. ^status
classDataStatus: aClass criteria: aParcel "Compute the status for a Class's static variables." | parcels status definedCount names | status := Set new: 4. aClass isNil ifTrue: [ ^status "shouldn't happen" ]. names := aClass asNameSpace localBindingNames. names isEmpty ifTrue: [ ( aParcel definesClass: aClass ) ifTrue: [ status add: #entirelyDefined ]. "why?" ^status ]. parcels := self manager parcelsForClassOrNameSpace: aClass. nil == parcels ifTrue: [ ^status ]. definedCount := 0. parcels do: [ :parcel| | defined | ( defined := parcel definedNamesFor: aClass) size > 0 ifTrue: [ definedCount := definedCount + 1. parcel == aParcel ifTrue: ["This is a performance-critical piece of code since it dominates computing category emphases for categories that are entirely defined by a Parcel. Hence there is some effort to optimize the comparison of defined and implemented names." status add: (((parcel definesClass: aClass) and: [defined size = names size and: [nil == (names detect: [:name| (defined includes: name) not] ifNone: nil)]]) ifTrue: [#entirelyDefined] ifFalse: [#defined])] ifFalse: [status add: #extendedByOther]]. ( definedCount > 1 "more than one parcel defines data in aClass" and: [ (self computeDataConflictsFor: (Array with: aClass) within: nil) first size > 0]) ifTrue:[ status add: #conflict ]]. ^status
classStatus: aClass criteria: aParcel "Compute the status for a Class." | classStatus metaclassStatus entirelyDefined dataStatus | classStatus := self behaviorStatus: aClass criteria: aParcel. metaclassStatus := self behaviorStatus: aClass class criteria: aParcel. dataStatus := self classDataStatus: aClass criteria: aParcel. entirelyDefined := ( ( classStatus includes: #entirelyDefined ) and: [ metaclassStatus includes: #entirelyDefined ] ) and: [ dataStatus includes: #entirelyDefined ]. classStatus addAll: metaclassStatus. classStatus addAll: dataStatus. entirelyDefined ifFalse: [ classStatus remove: #entirelyDefined ifAbsent: nil ]. ^classStatus
dataKeyStatus: aKey owner: anOwner criteria: aParcel "Compute the status for a data key in a given class/namespace with respect to the parcels in manager and aParcelOrNil." | status parcels count | status := Set new: 4. (nil == anOwner or: [nil == aKey]) ifTrue: [^status]. nil == (parcels := self manager parcelsForClassOrNameSpace: anOwner) ifFalse: [count := 0. parcels do: [:p| (p definesName: aKey in: anOwner) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])]]. count > 1 ifTrue: [status add: #conflict]]. ^status
dataProtocolStatus: aSymbol owner: aClassOrNameSpace criteria: aParcel "Compute the status for a data protocol in a class." | thingsInProtocol status parcels | status := Set new: 4. nil == aClassOrNameSpace ifTrue: [^status]. thingsInProtocol := aClassOrNameSpace asNameSpace organization listAtCategoryNamed: aSymbol. ( thingsInProtocol isEmpty or: [nil == (parcels := self manager parcelsForClassOrNameSpace: aClassOrNameSpace)]) ifTrue: [ ^status ]. "Assume entirely defined; search for exceptions in the loop below." (aParcel notNil and: [parcels includes: aParcel]) ifTrue: [status add: #entirelyDefined]. thingsInProtocol do: [:aThing| | count | count := 0. parcels do: [:p| (p definesName: aThing in: aClassOrNameSpace) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])] ifFalse: [aParcel == p ifTrue: [status remove: #entirelyDefined ifAbsent: nil]]]. count > 1 ifTrue: [status add: #conflict]]. ^status
definedThingStatus: anObject criteria: aParcel "Compute the status for a Static." | status definedCount | status := Set new: 4. anObject isNil ifTrue: [ ^status "shouldn't happen"]. definedCount := 0. self manager parcels do: [ :parcel | ( parcel definesObject: anObject) ifTrue: [ definedCount := definedCount + 1. status add: (parcel == aParcel ifTrue: [#defined] ifFalse: [#definedByOther]). ( parcel == aParcel) ifTrue: [ status add: #entirelyDefined ] ] ]. (definedCount > 1 "more than one parcel defines the behavior") ifTrue: [status add: #conflict]. ^status
methodProtocolStatus: aSymbol class: aClass criteria: currentParcel "Compute the status for a message protocol in a class." | selectorsInProtocol status parcels | status := Set new: 4. nil == aClass ifTrue: [^status]. selectorsInProtocol := aClass organization listAtCategoryNamed: aSymbol. (selectorsInProtocol isEmpty or: [nil == (parcels := self manager parcelsForClassOrNameSpace: aClass)]) ifTrue: [^status]. "Assume entirely defined; search for exceptions in the loop below." (currentParcel notNil and: [parcels includes: currentParcel]) ifTrue: [status add: #entirelyDefined]. selectorsInProtocol do: [:aSelector| | count | count := 0. parcels do: [:p| (p definesSelector: aSelector forClass: aClass) ifTrue: [count := count + 1. status add: (currentParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])] ifFalse: [currentParcel == p ifTrue: [status remove: #entirelyDefined ifAbsent: nil]]]. count > 1 ifTrue: [status add: #conflict]]. ^status
nameSpaceStatus: anObject criteria: aParcel "Compute the status for a NameSpace." | status definedCount | status := Set new: 4. anObject isNil ifTrue: [ ^status "shouldn't happen"]. definedCount := 0. self manager parcels do: [ :parcel | ( parcel definesObject: anObject) ifTrue: [ definedCount := definedCount + 1. status add: (parcel == aParcel ifTrue: [#defined] ifFalse: [#definedByOther]). ( parcel == aParcel) ifTrue: [ status add: #entirelyDefined ] ] ]. (definedCount > 1 "more than one parcel defines the behavior") ifTrue: [status add: #conflict]. ^status
selectorStatus: aSelector class: aClass criteria: aParcel "Compute the status for a selector in a given classwith respect to the parcels in manager and aParcelOrNil." | status parcels count | status := Set new: 4. (nil == aClass or: [nil == aSelector]) ifTrue: [^status]. nil == (parcels := self manager parcelsForClassOrNameSpace: aClass) ifFalse: [count := 0. parcels do: [:p| (p definesSelector: aSelector forClass: aClass) ifTrue: [count := count + 1. status add: (aParcel == p ifTrue: [#defined] ifFalse: [#definedByOther])]]. count > 1 ifTrue: [status add: #conflict]]. ^status
</methods> <methods> Tools.ParcelEmphasizer <category>private</category>
computeConflictsFor: aSetOfClasses within: aSetOfParcelsOrNil "Answer a triple of a Set of MethodDefinitions identifying all methods that are multiply parcelled, a Set of statics that are multiply parcelled, and a Set of classes that either contain multiply parcelled methods or are themselves multiply parcelled. If aSetOfParcelsOrNil is non-nil then only include conflicts that are parcelled within aSetOfParcels Express the triple as an Array, method definitions first, bindings next, classes last." | methods bindings classes | methods := Set new: 64. bindings := IdentitySet new: 8. classes := IdentitySet new: 4. aSetOfClasses do: [:class| | parcels | (parcels := self manager parcelsForClassOrNameSpace: class) notNil ifTrue: [| instanceSelectorBag classSelectorBag staticBag classBag | instanceSelectorBag := Bag identityNew: 32. classSelectorBag := Bag identityNew: 32. staticBag := Bag identityNew: 4. classBag := Bag identityNew: 2. parcels do: [:parcel| (parcel definesClass: class) ifTrue: [classBag add: class]. instanceSelectorBag addAll: (parcel definedSelectorsFor: class). classSelectorBag addAll: (parcel definedSelectorsFor: class class). staticBag addAll: (parcel definedBindingsFor: class)]. instanceSelectorBag valuesAndCountsDo: [:sel :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesSelector: sel forClass: class]]]) ifTrue: [classes add: class. methods add: (MethodDefinition class: class selector: sel)]]. classSelectorBag valuesAndCountsDo: [:sel :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesSelector: sel forClass: class class]]]) ifTrue: [classes add: class. methods add: (MethodDefinition class: class class selector: sel)]]. classBag valuesAndCountsDo: [:clss :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [classes add: class]]. staticBag valuesAndCountsDo: [:binding :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [bindings add: binding. classes add: class]]]]. ^Array with: methods with: bindings with: classes
computeDataConflictsFor: aSetOfClasses within: aSetOfParcelsOrNil "Answer a Set of statics that are multiply parcelled return and Array with a Set of statics that have conflicts" | bindings | bindings := IdentitySet new: 8. aSetOfClasses do: [:class| | parcels | (parcels := self manager parcelsForClassOrNameSpace: class) notNil ifTrue: [| staticBag | staticBag := Bag identityNew: 4. parcels do: [:parcel| staticBag addAll: (parcel definedBindingsFor: class)]. staticBag valuesAndCountsDo: [:binding :count| (count > 1 and: [aSetOfParcelsOrNil isNil or: [aSetOfParcelsOrNil contains: [:parcel| parcel definesClass: class]]]) ifTrue: [bindings add: binding]]]]. ^Array with: bindings
currentCriteria: aBrowser id: selectionId "Answer what we are highlighting based on." ^aBrowser selectedParcelFor: selectionId
manager ^Parcel
</methods> <methods> Tools.NameSpaceGlobalCategoryBrowserHelper <category>list accessing</category>
generateListFull ^(self environment == nil) ifTrue: [Root withAllNameSpacesAndAllClasses ] ifFalse: [self category == nil ifTrue: [Root withAllNameSpacesAndAllClasses] ifFalse: [Root withAllNameSpacesAndAllClasses select: [:each | each category = self category]]]
updateListFull Cursor wait showWhile: [module setNewList: (self generateListFull asSortedCollection: [:a :b | a name < b name]) asList]
</methods> <methods> Tools.NameSpaceGlobalCategoryBrowserHelper <category>private</category>
textForItem: aListEntry ^aListEntry displayString asText
</methods> <methods> Tools.SmalltalkWorkbench class <category>browsing</category>
browseNameSpace: aNameSpace FullSystemBrowser new; initializeForNameSpace: aNameSpace; open
</methods> <methods> Tools.BrowserHelper class <category>private</category>
menuMethodPragmas <pragmas: #instance> ^Menu pragmas
</methods> <methods> Tools.MethodsBrowserHelper <category>actions</category>
openResourceEditor <menuItem: #(#EditResource #menus '&Edit Resource') nameKey: nil menu: #(#listMenu) position: 35.1> | resource editorName meth | self targetClassOrNameSpace isForNameSpace ifTrue: [^Dialog warn: (#SharedVariablesHaveNoEditor << #dialogs >> 'Shared variables have no editor') for: self interfaceWindow]. meth := self definitionOf: self selection. resource := meth method resourceType. resource == nil ifTrue: [^Dialog warn: (#ThisMethodHasNoEditor << #dialogs >> 'This method has no editor') for: self interfaceWindow]. resource = #canvas ifTrue: [editorName := #{UIPainter}]. resource = #menu ifTrue: [editorName := #{MenuEditor}]. resource = #image ifTrue: [editorName := #{UIMaskEditor}]. resource = #dataModel ifTrue: [editorName := #{LensEditor}]. resource = #query ifTrue: [editorName := #{QueryEditor}]. editorName == nil ifTrue: [^Dialog warn: ((#ThisBrowserDoesNotKnowEditorFor << #dialogs >> 'This browser does not know the editor for <1p>') expandMacrosWith: resource) for: self interfaceWindow]. self open: editorName on: meth implementingClass instanceBehavior selector: meth selector. ^resource
</methods> <methods> Tools.MethodsBrowserHelper class <category>resources</category>
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOut #value: #fileOut ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Hardcopy #catalogID: #menus #defaultString: '&Hardcopy') #nameKey: #hardcopy #value: #hardcopy ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Spawn #catalogID: #menus #defaultString: '&Spawn') #nameKey: #spawn #value: #spawn ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Se_nders #catalogID: #menus #defaultString: 'Se&nders') #nameKey: #allSenders ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Im_plementors #catalogID: #menus #defaultString: 'Im&plementors') #nameKey: #allImplementors ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #LocalSen_ders #catalogID: #menus #defaultString: 'Local Sen&ders') #nameKey: #localSenders ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #LocalImp_lementors #catalogID: #menus #defaultString: 'Local Imp&lementors') #nameKey: #localImplementors ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MoveToDot #catalogID: #menus #defaultString: '&Move To...') #nameKey: #move #value: #move ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #remove #value: #remove ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #InitializeVariable #catalogID: #menus #defaultString: '&Initialize Variable') #nameKey: #initializeStatic #value: #initializeStatic ) ) #(3 4 3 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.ClassesBrowserHelper <category>actions</category>
browseFieldAssignments "Show a menu of all instance variables of the currently selected class and its superclasses. Browse all methods which assign to the variable selected." <menuItem: #(#InstVarAssignmentsDot #menus 'Inst Var &Assignments...') nameKey: #instVarAssign menu: #(#listMenu #browse) position: 10.011 > | name | name := self forClass: self selectedItem showVariableMenu: [:class | class instVarNames] collect: [:cname | cname]. name isNil ifTrue: [^self]. self methodCollector baseClass: self selectedItem; browseAllAccessesTo: name type: #write
browseFieldReads "Show a menu of all instance variables of the currently selected class and its superclasses. Browse all methods which read the variable selected." <menuItem: #(#InstVarReadsDot #menus 'Inst Var &Reads...') nameKey: #instVarRead menu: #(#listMenu #browse) position: 10.012 > | name | name := self forClass: self selectedItem showVariableMenu: [:class | class instVarNames] collect: [:cname | cname]. name isNil ifTrue: [^self]. self methodCollector baseClass: self selectedItem; browseAllAccessesTo: name type: #read
browseLocalCallsOn "Spawn a Browser on references to anObject within the current class.." <menuItem: #(#LocalReferencesToDot #menus 'Local References &To...') nameKey: nil menu: #(#listMenu #browse) position: 21.01 > | aLiteral | aLiteral := SmalltalkWorkbench promptForSelector: (#BrowseLocalReferencesToWhatQ << #dialogs >> 'Browse local references to what?') for: self interfaceWindow. aLiteral isNil ifTrue: [^self]. ^self methodCollector baseClass: self selectedItem instanceBehavior; browseAllReferencesTo: aLiteral
browseLocalImplementorsOf "Spawn a Browser on references to anObject within the current class.." <menuItem: #(#LocalImplementorsOfDot #menus 'Local Implementors &Of...') nameKey: nil menu: #(#listMenu #browse) position: 21.015 > | aLiteral | aLiteral := SmalltalkWorkbench promptForSelector: (#BrowseLocalImplementorsOfWhatQ << #dialogs >> 'Browse local implementors of what?') withinHierarchyOf: self selectedItem instanceBehavior for: self interfaceWindow. aLiteral isNil ifTrue: [^self]. ^self methodCollector baseClass: self selectedItem instanceBehavior; browseAllImplementorsOf: aLiteral
initializeSelections "Any of the selections which may be initialized will be initialized here." <menuItem: #(#Initialize #menus 'Initialize') nameKey: nil menu: #(#listMenu) position: 30.038 > self selections do: [ :selection | selection isForClass ifTrue: [ selection initialize ] ]
searchForStringInSource "Spawn a Browser on all methods which contain a specified string." <menuItem: #(#MethodsWithPhraseDot #menus 'Methods with &Phrase...') nameKey: nil menu: #(#listMenu #browse) position: 21.03 > | string class selectors classes allSelectorsMDs | Cursor wait showWhile:[ (class := self targetClassOrNameSpace) isNil ifTrue: [^self]. class isForNameSpace ifTrue:[ classes := class allClasses ] ifFalse: [ classes := Array with: class]. string := Dialog request: (#ShowMethodsWithSourceCodeContainingColon << #dialogs >> 'Show methods with source code containing:') for: self interfaceWindow. string isEmpty ifTrue: [^self]. allSelectorsMDs := OrderedCollection new: 1000. classes do:[:eachClass | selectors := eachClass selectors. selectors := selectors select: [:sel| | s | nil ~~ (s := eachClass sourceCodeAt: sel) and: [(s indexOfSubCollection: string startingAt: 1) > 0]]. allSelectorsMDs addAll: (selectors collect: [:sel| (MethodDefinition class: eachClass selector: sel)])].]. ^self methodCollector openListBrowserOn: allSelectorsMDs asSortedCollection asArray label: ((#SourceIn1sContaining2s << #dialogs >> 'Source in <1s> containing <2s>') expandMacrosWith: class printString with: string) initialSelection: string
</methods> <methods> Tools.ClassesBrowserHelper class <category>resources</category>
commentIconColor "UIMaskEditor new openOnClass: self andSelector: #commentIconColor" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: #[255 255 255 0 240 1 255 0 247 252 255 0 247 253 127 0 246 85 191 0 247 253 223 0 246 148 15 0 247 255 239 0 246 42 111 0 247 255 239 0 246 84 239 0 247 255 239 0 246 138 111 0 247 255 239 0 246 42 175 0 247 255 239 0 247 255 239 0 247 255 239 0 247 255 239 0 247 255 239 0 247 255 239 0 247 255 239 0 240 0 15 0 255 255 255 0])
commentIconMask "UIMaskEditor new openOnClass: self andSelector: #commentIconMask" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 15 254 0 0 15 255 0 0 15 255 128 0 15 255 192 0 15 255 224 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 15 255 240 0 0 0 0 0])
definitionIconColor "UIMaskEditor new openOnClass: self andSelector: #definitionIconColor" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 4) at: 1 put: ColorValue black; at: 2 put: ColorValue red; at: 3 put: ColorValue blue; at: 4 put: ColorValue white; yourself)) usingBits: #[255 255 255 255 255 255 0 0 255 255 255 255 255 255 0 0 253 85 127 213 85 255 0 0 253 255 127 223 253 255 0 0 193 255 64 31 253 255 0 0 253 255 127 223 253 255 0 0 253 255 127 223 253 255 0 0 253 85 127 213 85 255 0 0 255 243 255 255 63 255 0 0 255 243 255 255 63 255 0 0 255 243 255 255 63 255 0 0 255 243 255 255 63 255 0 0 255 234 255 213 85 255 0 0 255 174 191 223 253 255 0 0 254 191 175 223 253 255 0 0 250 255 224 31 253 255 0 0 254 191 175 223 253 255 0 0 255 174 191 213 85 255 0 0 255 234 255 255 255 255 0 0 255 243 255 255 255 255 0 0 255 0 63 255 255 255 0 0 255 192 255 255 255 255 0 0 255 243 255 255 255 255 0 0 255 255 255 255 255 255 0 0])
definitionIconMask "UIMaskEditor new openOnClass: self andSelector: #definitionIconMask" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 0 0 0 0 31 135 240 0 31 135 240 0 127 255 240 0 31 135 240 0 31 135 240 0 31 135 240 0 2 0 128 0 2 0 128 0 2 0 128 0 2 0 128 0 7 7 240 0 15 135 240 0 31 199 240 0 63 255 240 0 31 199 240 0 15 135 240 0 7 0 0 0 2 0 0 0 15 128 0 0 7 0 0 0 2 0 0 0 0 0 0 0])
defTypeMenu "MenuEditor new openOnClass: self andSelector: #defTypeMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #rawLabel: #(#UserMessage #key: #showHierarchy #defaultString: '&Hierarchy' #catalogID: #menus ) #nameKey: #hierarchy #value: #showHierarchy #labelImage: #(#ResourceRetriever #ClassesBrowserHelper #hierarchyIcon ) ) #(#MenuItem #rawLabel: #(#UserMessage #key: #showDefinition #defaultString: '&Definition' #catalogID: #menus ) #nameKey: #definition #value: #showDefinition #labelImage: #(#ResourceRetriever #ClassesBrowserHelper #definitionIcon ) ) #(#MenuItem #rawLabel: #(#UserMessage #key: #showComment #defaultString: 'Co&mment' #catalogID: #menus ) #nameKey: #comment #value: #showComment #labelImage: #(#ResourceRetriever #ClassesBrowserHelper #commentIcon ) ) ) #(3 ) nil ) decodeAsLiteralArray
hierarchyIconColor "UIMaskEditor new openOnClass: self andSelector: #hierarchyIconColor" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 5) at: 1 put: ColorValue black; at: 2 put: ColorValue blue; at: 3 put: (ColorValue scaledRed: 0 scaledGreen: 4111 scaledBlue: 0); at: 4 put: ColorValue white; at: 5 put: ColorValue red; yourself)) usingBits: (ByteArray fromPackedString: 'L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3H"H"H"H"L3L3L3L3L3@3L3L3L3L3L3L3L3@3L3L3L3L3L3L3L3@QDQDQDQL3L3L3L3@3@3L3L3L3L3L3L3@3@3L3L3L3L3L3L3@3ADQDQDQDL3L3L3@3@3L3L3L3L3L3L3@3@3L3L3L3L3L3L3@3ADQDQDQDL3L3L3@3L3L3L3L3L3L3L3@3L3L3L3L3L3L3L3@QDQDQDQL3L3L3L3L3@3L3L3L3L3L3L3L3@3L3L3L3L3L3L3L3ADQDQDQDL3L3L3L3@3L3L3L3L3L3L3L3@3L3L3L3L3L3L3L3ADQDQDQDL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3'))
hierarchyIconMask "UIMaskEditor new openOnClass: self andSelector: #hierarchyIconMask" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 0 0 0 0 0 0 0 0 31 254 0 0 2 0 0 0 2 0 0 0 3 255 192 0 2 64 0 0 2 64 0 0 2 127 248 0 2 64 0 0 2 64 0 0 2 127 248 0 2 0 0 0 2 0 0 0 3 255 192 0 0 64 0 0 0 64 0 0 0 127 248 0 0 64 0 0 0 64 0 0 0 127 248 0 0 0 0 0 0 0 0 0])
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOut #value: #fileOut ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Hardcopy #catalogID: #menus #defaultString: '&Hardcopy') #nameKey: #hardcopy #value: #hardcopy ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Spawn #catalogID: #menus #defaultString: '&Spawn') #nameKey: #spawn #value: #spawn ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #S_pawnHierarchy #catalogID: #menus #defaultString: 'S&pawn Hierarchy') #nameKey: #spawnHierarchy #value: #spawnHierarchy ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #AddClass #catalogID: #menus #defaultString: '&Add Class') #nameKey: #add #value: #addClassVariableSize #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #FixedSize #catalogID: #menus #defaultString: '&Fixed Size') #nameKey: #addClassFixedSize #value: #addClassFixedSize ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Indexed #catalogID: #menus #defaultString: '&Indexed') #nameKey: #addClassVariableSize #value: #addClassVariableSize ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ByteIndexed #catalogID: #menus #defaultString: '&Byte Indexed') #nameKey: #addClassBytes #value: #addClassBytes ) ) #(3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Browse #catalogID: #menus #defaultString: '&Browse') #nameKey: #browse #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #InstVarReferencesDot #catalogID: #menus #defaultString: '&Inst Var References...') #nameKey: #browseFieldReferences #value: #browseFieldReferences ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #SharedVarReferencesDot #catalogID: #menus #defaultString: '&Shared Var References...') #nameKey: #browseClassVariables #value: #browseClassVariables ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ClassReferences #catalogID: #menus #defaultString: '&Class References') #nameKey: #browseClass #value: #browseClassReferences ) ) #(1 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MoveToDot #catalogID: #menus #defaultString: '&Move To...') #nameKey: #move #value: #move #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #CategoryDot #catalogID: #menus #defaultString: '&Category...') #nameKey: #move #value: #move ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #NamespaceDot #catalogID: #menus #defaultString: '&Namespace...') #nameKey: #moveNameSpace #value: #moveNameSpace ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_ParcelDot #catalogID: #menus #defaultString: '&Parcel...') #nameKey: #moveNewParcel #value: #moveNewParcel ) ) #(3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Re_nameAsDot #catalogID: #menus #defaultString: 'Re&name As...') #nameKey: #rename #value: #rename ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #remove #value: #remove ) ) #(4 2 3 ) nil ) decodeAsLiteralArray
metaMenu "MenuEditor new openOnClass: self andSelector: #metaMenu" <resource: #menu> ^#(#{Menu} #( #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #InstanceDefinitions #defaultString: '&Instance Methods' #catalogID: #menus ) #nameKey: #instance #value: #metaOff ) #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #ClassDefinitions #defaultString: '&Class Methods' #catalogID: #menus ) #nameKey: #class #value: #metaOn ) #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #Data #defaultString: '&Shared Variables' #catalogID: #menus ) #nameKey: #data #value: #metaShowData ) ) #(3 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.SimpleBrowserModule class <category>interface specs</category>
listSpec "UIPainter new openOnClass: self andSelector: #listSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #bounds: #(#{Rectangle} 458 440 658 640 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SequenceViewSpec} #properties: #(#{PropertyListDictionary} #dragOkSelector #wantToDrag: #dragEnterSelector #dragEnter: #dragOverSelector #dragOver: #dragStartSelector #doDrag: #dropSelector #drop: #dragExitSelector #dragLeave: ) #layout: #(#{LayoutFrame} 1 0 1 0 -1 1 -1 1 ) #name: #list #model: #list #callbacksSpec: #(#{UIEventCallbackSubSpec} #doubleClickSelector: #spawnBrowser #requestValueChangeSelector: #testChangeSelection: ) #menu: #listMenu #multipleSelections: true #useModifierKeys: true #selectionType: #normalSelection ) ) ) )
listSpecProtocols "UIPainter new openOnClass: self andSelector: #listSpecProtocols" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #bounds: #(#{Graphics.Rectangle} 512 384 712 584 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SequenceViewSpec} #properties: #(#{UI.PropertyListDictionary} #dragOkSelector #wantToDrag: #dragEnterSelector #dragEnter: #dragOverSelector #dragOver: #dragStartSelector #doDrag: #dropSelector #drop: #dragExitSelector #dragLeave: ) #layout: #(#{Graphics.LayoutFrame} 1 0 1 0 -1 1 -41 1 ) #name: #list #model: #list #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #spawnBrowser #requestValueChangeSelector: #testChangeSelection: ) #menu: #listMenu #multipleSelections: true #useModifierKeys: true #selectionType: #normalSelection ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 5 0 -30 1 0 0.5 ) #name: #instanceButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #instance #defaultString: 'instance' #catalogID: #labels) #select: #instance ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 0 0.6 -30 1 0 0.5 ) #name: #classButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #class #defaultString: 'class' #catalogID: #labels) #select: #class ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 5 0 -10 1 0 0.5 ) #name: #dataButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #sharedVariables #defaultString: 'shared variables' #catalogID: #labels) #select: #data ) ) ) )
listSpecProtocolsSingleSelect "UIPainter new openOnClass: self andSelector: #listSpecProtocolsSingleSelect" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #bounds: #(#{Graphics.Rectangle} 512 384 712 584 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SequenceViewSpec} #properties: #(#{UI.PropertyListDictionary} #dragOkSelector #wantToDrag: #dragEnterSelector #dragEnter: #dragOverSelector #dragOver: #dragStartSelector #doDrag: #dropSelector #drop: #dragExitSelector #dragLeave: ) #layout: #(#{Graphics.LayoutFrame} 1 0 1 0 -1 1 -41 1 ) #name: #list #model: #list #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #spawnBrowser #requestValueChangeSelector: #testChangeSelection: ) #menu: #listMenu #multipleSelections: false #useModifierKeys: true #selectionType: #normalSelection ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 5 0 -30 1 0 0.5 ) #name: #instanceButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #instance #defaultString: 'instance' #catalogID: #labels) #select: #instance ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 0 0.6 -30 1 0 0.5 ) #name: #classButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #class #defaultString: 'class' #catalogID: #labels) #select: #class ) #(#{UI.RadioButtonSpec} #layout: #(#{UI.AlignmentOrigin} 5 0 -10 1 0 0.5 ) #name: #dataButton #model: #meta #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #changeRequest ) #label: #(#{Kernel.UserMessage} #key: #sharedVariables #defaultString: 'shared variables' #catalogID: #labels) #select: #data ) ) ) )
listSpecSingleSelect "UIPainter new openOnClass: self andSelector: #listSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #bounds: #(#{Rectangle} 339 318 539 518 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SequenceViewSpec} #properties: #(#{PropertyListDictionary} #dragOkSelector #wantToDrag: #dragEnterSelector #dragEnter: #dragOverSelector #dragOver: #dragStartSelector #doDrag: #dropSelector #drop: #dragExitSelector #dragLeave: ) #layout: #(#{LayoutFrame} 1 0 1 0 -1 1 -1 1 ) #name: #list #model: #list #callbacksSpec: #(#{UIEventCallbackSubSpec} #doubleClickSelector: #spawnBrowser #requestValueChangeSelector: #testChangeSelection: ) #menu: #listMenu #multipleSelections: false #selectionType: #normalSelection ) ) ) )
</methods> <methods> Tools.HierarchicalBrowserModule class <category>interface specs</category>
listSpec "UIPainter new openOnClass: self andSelector: #listSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #bounds: #(#{Graphics.Rectangle} 324 227 524 427 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.HierarchicalViewSpec} #properties: #(#{UI.PropertyListDictionary} #dragOkSelector #wantToDrag: #dragEnterSelector #dragEnter: #dragOverSelector #dragOver: #dragStartSelector #doDrag: #dropSelector #drop: #dragExitSelector #dragLeave: ) #layout: #(#{Graphics.LayoutFrame} 0 0.0 0 0 0 0.99 0 1.0 ) #name: #list #flags: 15 #model: #list #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #doubleClick #requestValueChangeSelector: #testChangeSelection: ) #menu: #listMenu #useModifierKeys: true #selectionType: #normalSelection ) ) ) )
</methods> <methods> Tools.MethodListBrowserHelper <category>actions</category>
browseClass "Spawn a Browser on the selected method's class.." <menuItem: #(#BrowseClass #menus 'Browse Class') nameKey: nil menu: #(#listMenu) position: 20.1 > | definition | SmalltalkWorkbench browseClass: ((definition := self selection) isBindingReference ifTrue: [definition environment] ifFalse: [definition implementingClass]) instanceBehavior
</methods> <methods> Tools.NameSpaceOrganizerBrowserHelper class <category>resources</category>
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOut #value: #fileOut ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_Hardcopy #catalogID: #menus #defaultString: '&Hardcopy') #nameKey: #hardcopy #value: #hardcopy ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_Spawn #catalogID: #menus #defaultString: '&Spawn') #nameKey: #spawn #value: #spawn ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #AddDot #catalogID: #menus #defaultString: '&Add...') #nameKey: #add #value: #addCategory ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #Re_nameAsDot #catalogID: #menus #defaultString: 'Re&name As...') #nameKey: #rename #value: #rename ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #remove #value: #remove ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #FindClassDot #catalogID: #menus #defaultString: '&Find Class...') #nameKey: #findClass #value: #findClass ) ) #(3 3 1 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.DebugContextsBrowserHelper <category>actions</category>
browseClass "Browse the class of the context's receiver" <menuItem: #(#BrowseClassDot #menus 'Browse Class...') nameKey: nil menu: #(#contextMenu) position: 20.045> | ctxt | (ctxt := self browser context) notNil ifTrue: [(ctxt homeReceiver isNil and: [ctxt homeReceiver class ~~ ctxt mclass]) ifTrue: [ctxt mclass instanceBehavior browse] ifFalse: [ctxt homeReceiver browse]]
</methods> <methods> Tools.DebugContextsBrowserHelper class <category>resources</category>
baseListMenu "MenuEditor new openOnClass: self andSelector: #baseListMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MoreStack #defaultString: '&More Stack' #catalogID: #menus) #nameKey: #moreStack #value: #moreStack ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Proceed #defaultString: '&Proceed' #catalogID: #menus) #nameKey: #proceed #value: #proceed #shortcutKeyCharacter: #F7 #shortcutModifiers: 0 ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Restart #defaultString: '&Restart' #catalogID: #menus) #nameKey: #restart #value: #restart ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Senders #defaultString: '&Senders' #catalogID: #menus) #nameKey: #allSenders ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Implementors #defaultString: '&Implementors' #catalogID: #menus) #nameKey: #allImplementors ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #LocalSe_nders #defaultString: 'Local Se&nders' #catalogID: #menus) #nameKey: #localSenders ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #LocalI_mplementors #defaultString: 'Local I&mplementors' #catalogID: #menus) #nameKey: #localImplementors ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #SkipToCaret #defaultString: 'Skip to &Caret' #catalogID: #menus) #nameKey: #skipToCaret #value: #skipToCaret ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Step #defaultString: 'Ste&p' #catalogID: #menus) #nameKey: #step #value: #step #shortcutKeyCharacter: #F4 #shortcutModifiers: 0 ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Send #defaultString: 'Sen&d' #catalogID: #menus) #nameKey: #send #value: #send #shortcutKeyCharacter: #F5 #shortcutModifiers: 0 ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #CopyStack #defaultString: 'Copy Stac&k' #catalogID: #menus) #nameKey: #copyStack #value: #copyStack ) ) #(3 4 3 1 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.BrowserTabApplication class <category>resources</category>
blankIcon "UIMaskEditor new openOnClass: self andSelector: #blankIcon" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: (Core.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue red; at: 2 put: Graphics.ColorValue white; yourself)) usingBits: #[255 255 255 0 255 255 255 0 255 255 255 0 247 251 255 0 243 243 255 0 249 231 255 0 252 207 255 0 254 95 255 0 255 63 255 0 255 63 255 0 254 31 255 0 254 223 255 0 252 207 255 0 249 231 255 0 243 243 255 0 243 243 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0])
categoryIcon "UIMaskEditor new openOnClass: self andSelector: #categoryIcon" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 2 bitsPerPixel: 2 palette: (Core.MappedPalette withColors: ((Core.Array new: 3) at: 1 put: (Graphics.ColorValue scaledRed: 5460 scaledGreen: 5460 scaledBlue: 5460); at: 2 put: Graphics.ColorValue black; at: 3 put: (Graphics.ColorValue scaledRed: 0 scaledGreen: 4111 scaledBlue: 0); yourself)) usingBits: #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 170 170 170 170 128 0 0 2 170 170 170 170 128 0 0 0 0 0 0 0 0 0 0 2 170 170 170 170 128 0 0 2 170 170 170 170 128 0 0 0 0 0 0 0 0 0 0 1 85 85 85 85 64 0 0 1 85 85 85 85 64 0 0 0 0 0 0 0 0 0 0 2 170 170 170 170 128 0 0 2 170 170 170 170 128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
</methods> <methods> Tools.ParcelTabApplication class <category>resources</category>
parcelIcon "UIMaskEditor new openOnClass: self andSelector: #parcelIcon" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 2 bitsPerPixel: 2 palette: (Core.MappedPalette withColors: ((Core.Array new: 4) at: 1 put: (Graphics.ColorValue scaledRed: 5460 scaledGreen: 5460 scaledBlue: 5460); at: 2 put: Graphics.ColorValue black; at: 3 put: Graphics.ColorValue yellow; at: 4 put: (Graphics.ColorValue scaledRed: 4111 scaledGreen: 4111 scaledBlue: 0); yourself)) usingBits: #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 89 80 0 0 0 0 0 31 239 212 0 0 0 0 0 127 191 116 0 0 0 0 2 170 169 244 0 0 0 0 7 251 246 244 0 0 0 0 31 239 222 244 0 0 0 0 85 149 126 244 0 0 0 0 127 191 126 208 0 0 0 0 127 191 126 64 0 0 0 0 127 191 125 0 0 0 0 0 127 191 116 0 0 0 0 0 127 191 80 0 0 0 0 0 85 85 64 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
parcelSubMenu "MenuEditor new openOnClass: self andSelector: #parcelSubMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #AddTo #catalogID: #menus #defaultString: '&Add To') #nameKey: #parcelAddTo #value: #addSelectionToParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #RemoveFrom #catalogID: #menus #defaultString: '&Remove From') #nameKey: #parcelRemoveFrom #value: #removeSelectionFromParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MoveTo #catalogID: #menus #defaultString: '&Move To') #nameKey: #parcelMoveTo ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Locate #catalogID: #menus #defaultString: '&Locate') #nameKey: #parcelLocate ) ) #(3 1 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.ProtocolBrowserHelper class <category>resources</category>
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOut #value: #fileOut ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_Hardcopy #catalogID: #menus #defaultString: '&Hardcopy') #nameKey: #hardcopy #value: #hardcopy ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_Spawn #catalogID: #menus #defaultString: '&Spawn') #nameKey: #spawn #value: #spawn ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #AddDot #catalogID: #menus #defaultString: '&Add...') #nameKey: #add #value: #add ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #Re_nameAsDot #catalogID: #menus #defaultString: 'Re&name As...') #nameKey: #rename #value: #rename ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #remove #value: #remove ) #(#MenuItem #rawLabel: #(#{Kernel.UserMessage} #key: #_FindDot #catalogID: #menus #defaultString: '&Find...') #nameKey: #findMethod #value: #findMethod ) ) #(3 3 1 ) nil ) decodeAsLiteralArray
metaMenu "MenuEditor new openOnClass: self andSelector: #metaMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #InstanceDefinitions #defaultString: '&Instance Methods' #catalogID: #menus ) #nameKey: #instance #value: #instance ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ClassDefinitions #defaultString: '&Class Methods' #catalogID: #menus ) #nameKey: #class #value: #class ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Data #defaultString: '&Shared Variables' #catalogID: #menus ) #nameKey: #data #value: #data ) ) #(3 ) nil ) decodeAsLiteralArray
</methods> <methods> UI.TabbedDialog class <category>interface specs</category>
activeAreaSpec "UIPainter new openOnClass: self andSelector: #activeAreaSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #windowLabel #min: #(#Point 265 317 ) #max: #(#Point 265 317 ) #bounds: #(#Rectangle 260 120 525 437 ) ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 2 0 2 0 -2 1 -2 1 ) #name: #activeComponents #flags: 0 ) ) ) )
windowMenuSpec "UIPainter new openOnClass: self andSelector: #windowMenuSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #windowLabel #min: #(#{Point} 378 325 ) #bounds: #(#{Rectangle} 244 138 622 463 ) #isEventDriven: true ) #component: #(#{SpecCollection} #collection: #( #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 2 0 40 0 -2 1 -2 1 ) #name: #notebook ) #(#{MenuButtonSpec} #layout: #(#{LayoutFrame} 2 0 8 0 -2 0.5 33 0 ) #model: #preferenceChoice #callbacksSpec: #(#{UIEventCallbackSubSpec} #requestValueChangeSelector: #requestSliceChange ) #menu: #preferenceTopMenu ) ) ) )
windowNotebookSpec "UIPainter new openOnClass: self andSelector: #windowNotebookSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #windowLabel #min: #(#{Point} 523 340 ) #bounds: #(#{Rectangle} 186 175 762 517 ) #isEventDriven: true ) #component: #(#{SpecCollection} #collection: #( #(#{TabControlSpec} #layout: #(#{LayoutFrame} 2 0 5 0 -6 1 -3 1 ) #name: #notebook #model: #preferenceMasterList #callbacksSpec: #(#{UIEventCallbackSubSpec} #requestValueChangeSelector: #requestSliceChange ) #rightInset: 120 #bottomInset: 0 ) ) ) )
</methods> <methods> Tools.HierarchyBrowserHelper class <category>resources</category>
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOut #value: #fileOut ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Spawn #catalogID: #menus #defaultString: '&Spawn') #nameKey: #spawn #value: #spawn ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Add #catalogID: #menus #defaultString: '&Add') #nameKey: #add #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Namespace #catalogID: #menus #defaultString: '&Namespace') #nameKey: #addNameSpace #value: #addNameSpace ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #SharedVariable #catalogID: #menus #defaultString: '&Shared Variable') #nameKey: #addBinding #value: #addBinding ) ) #(2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MoveToDot #catalogID: #menus #defaultString: '&Move To...') #nameKey: #moveTo #value: #moveTo ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Re_nameAsDot #catalogID: #menus #defaultString: 'Re&name As...') #nameKey: #renameAs #value: #renameAs ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #remove #value: #remove ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_FindDot #catalogID: #menus #defaultString: '&Find...') #nameKey: #find #value: #find ) ) #(2 1 3 1 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.FullSystemBrowser class <category>resources</category>
acceptCancel "MenuEditor new openOnClass: self andSelector: #acceptCancel" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Accept #defaultString: '&Accept' #catalogID: #menus ) #value: #accept ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Cancel #defaultString: '&Cancel' #catalogID: #menus ) #value: #cancel ) ) #(2 ) nil ) decodeAsLiteralArray
editGroup "MenuEditor new openOnClass: self andSelector: #editGroup" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_FindDot #defaultString: '&Find...' #catalogID: #menus ) #value: #find ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_ReplaceDot #defaultString: '&Replace...' #catalogID: #menus ) #value: #replace ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Undo #defaultString: '&Undo' #catalogID: #menus ) #value: #undo ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Copy #defaultString: '&Copy' #catalogID: #menus ) #value: #copySelection ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Cu_t #defaultString: 'Cu&t' #catalogID: #menus ) #value: #cut ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Paste #defaultString: '&Paste' #catalogID: #menus ) #value: #paste ) ) #(2 1 3 ) nil ) decodeAsLiteralArray
evaluateGroup "MenuEditor new openOnClass: self andSelector: #evaluateGroup" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_DoIt #defaultString: '&Do it' #catalogID: #menus ) #value: #doIt ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_PrintIt #defaultString: '&Print it' #catalogID: #menus ) #value: #printIt ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_InspectIt #defaultString: '&Inspect it' #catalogID: #menus ) #value: #inspectIt ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #De_bugIt #defaultString: 'De&bug it' #catalogID: #menus ) #value: #debugIt ) ) #(4 ) nil ) decodeAsLiteralArray
hardcopyGroup "MenuEditor new openOnClass: self andSelector: #hardcopyGroup" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Hardcopy #defaultString: '&Hardcopy' #catalogID: #menus ) #value: #hardcopy ) ) #(1 ) nil ) decodeAsLiteralArray
menuBarEnd "MenuEditor new openOnClass: self andSelector: #menuBarEnd" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Help #defaultString: '&Help' #catalogID: #menus ) #value: #openHelpBrowser #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Topics #defaultString: '&Topics' #catalogID: #menus) #value: #displayHelp ) ) #(1 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
menuBarStart "Tools.MenuEditor new openOnClass: self andSelector: #menuBarStart" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Browser #defaultString: '&Browser' #catalogID: #menus ) #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Update #defaultString: '&Update' #catalogID: #menus ) #value: #updateLists ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Close #defaultString: '&Close' #catalogID: #menus ) #value: #closeRequest ) ) #(1 1 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Edit #defaultString: '&Edit' #catalogID: #menus ) #nameKey: #edit ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_View #defaultString: '&View' #catalogID: #menus ) #nameKey: #view ) ) #(3 ) nil ) decodeAsLiteralArray
textMenuExtras "Tools.MenuEditor new openOnClass: self andSelector: #textMenuExtras" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Format #defaultString: '&Format' #catalogID: #menus ) #value: #format ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Explain #defaultString: '&Explain' #catalogID: #menus ) #value: #explain ) ) #(2 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.FullSystemBrowser class <category>interface specs</category>
windowSpec0 "UIPainter new openOnClass: self andSelector: #windowSpec0" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #windowLabel #bounds: #(#{Rectangle} 363 313 917 712 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{SpecCollection} #collection: #( #(#{TextEditorSpec} #layout: #(#{LayoutFrame} 1 0 1 0 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu ) ) ) )
windowSpec1 "UIPainter new openOnClass: self andSelector: #windowSpec1" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #bounds: #(#{Graphics.Rectangle} 470 369 1024 768 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 0 1 -1 0.4 ) #name: #component1 #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 -1 0.4 0 1 2 0.4 ) #name: #ResizingSplitter1 #horizontal: true #minAboveSize: 25 #minBelowSize: 25 #aboveWidgets: 'component1' #belowWidgets: 'text' ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 1 0 2 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu #tabRequiresControl: true ) ) ) )
windowSpec2 "UIPainter new openOnClass: self andSelector: #windowSpec2" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #bounds: #(#{Graphics.Rectangle} 470 369 1024 768 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 -1 0.5 -1 0.4 ) #name: #component1 #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} -1 0.5 0 0 2 0.5 -1 0.4 ) #name: #ResizingSplitter2 #horizontal: false #minAboveSize: 120 #minBelowSize: 30 #aboveWidgets: 'component1' #belowWidgets: 'component2' ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 2 0.5 0 0 0 1 -1 0.4 ) #name: #component2 #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 -1 0.4 0 1 2 0.4 ) #name: #ResizingSplitter1 #horizontal: true #minAboveSize: 50 #minBelowSize: 25 #aboveWidgets: 'component1 component2 ResizingSplitter2' #belowWidgets: 'text' ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 1 0 2 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu #tabRequiresControl: true ) ) ) )
windowSpec3 "UIPainter new openOnClass: self andSelector: #windowSpec3" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #bounds: #(#{Graphics.Rectangle} 470 369 1024 768 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 0 0.333 -1 0.4 ) #name: #component1 #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.333 0 0 0 0.667 -1 0.4 ) #name: #component2 #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.667 0 0 0 1 -1 0.4 ) #name: #component3 #flags: 0 #minorKey: #list3 #clientKey: #component3 ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 -1 0.4 0 1 2 0.4 ) #name: #ResizingSplitter1 #horizontal: true #minAboveSize: 50 #minBelowSize: 25 #aboveWidgets: 'component1 component2 component3' #belowWidgets: 'text' ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 1 0 2 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu #tabRequiresControl: true ) ) ) )
windowSpec4 "UIPainter new openOnClass: self andSelector: #windowSpec4" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #bounds: #(#{Graphics.Rectangle} 470 369 1024 768 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 0 0.25 -1 0.4 ) #name: #component1 #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.25 0 0 0 0.5 -1 0.4 ) #name: #component2 #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.5 0 0 0 0.75 -1 0.4 ) #name: #component3 #flags: 0 #minorKey: #list3 #clientKey: #component3 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.75 0 0 0 1 -1 0.4 ) #name: #component4 #flags: 0 #minorKey: #list4 #clientKey: #component4 ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 -1 0.4 0 1 2 0.4 ) #name: #ResizingSplitter1 #horizontal: true #minAboveSize: 50 #minBelowSize: 25 #aboveWidgets: 'component1 component2 component3 component4' #belowWidgets: 'text' ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 1 0 2 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu #tabRequiresControl: true ) ) ) )
windowSpec5 "UIPainter new openOnClass: self andSelector: #windowSpec5" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #windowLabel #bounds: #(#{Rectangle} 169 558 723 957 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{SpecCollection} #collection: #( #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0 0 0 0 0.2 0 0.4 ) #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.2 0 0 0 0.4 0 0.4 ) #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.4 0 0 0 0.6 0 0.4 ) #flags: 0 #minorKey: #list3 #clientKey: #component3 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.6 0 0 0 0.8 0 0.4 ) #flags: 0 #minorKey: #list4 #clientKey: #component4 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.8 0 0 0 1 0 0.4 ) #flags: 0 #minorKey: #list5 #clientKey: #component5 ) #(#{TextEditorSpec} #layout: #(#{LayoutFrame} 1 0 1 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu ) ) ) )
windowSpec6 "UIPainter new openOnClass: self andSelector: #windowSpec6" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #windowLabel #bounds: #(#{Rectangle} 169 558 723 957 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{SpecCollection} #collection: #( #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0 0 0 0 0.2 0 0.4 ) #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.2 0 0 0 0.4 0 0.4 ) #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.4 0 0 0 0.6 0 0.4 ) #flags: 0 #minorKey: #list3 #clientKey: #component3 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.6 0 0 0 0.8 0 0.4 ) #flags: 0 #minorKey: #list4 #clientKey: #component4 ) #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 0 0.8 0 0 0 1 0 0.4 ) #flags: 0 #minorKey: #list5 #clientKey: #component5 ) #(#{TextEditorSpec} #layout: #(#{LayoutFrame} 1 0 1 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu ) ) ) )
</methods> <methods> Tools.FullNotebookSystemBrowser class <category>interface specs</category>
windowSpec5 "UIPainter new openOnClass: self andSelector: #windowSpec5" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #bounds: #(#{Graphics.Rectangle} 470 369 1024 768 ) #flags: 4 #menu: #menuBar #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 1 0 2 0.4 -1 1 -1 1 ) #name: #text #model: #text #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #textAccepted: ) #menu: #textMenu #tabRequiresControl: true ) #(#{UI.ResizingSplitterSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 -1 0.4 0 1 2 0.4 ) #name: #ResizingSplitter1 #horizontal: true #minAboveSize: 50 #minBelowSize: 25 #aboveWidgets: 'component1 component2 component3 notebook' #belowWidgets: 'text' ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.25 0 0 0 0.5 -1 0.4 ) #name: #component1 #flags: 0 #minorKey: #list1 #clientKey: #component1 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.5 0 0 0 0.75 -1 0.4 ) #name: #component2 #flags: 0 #minorKey: #list2 #clientKey: #component2 ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.75 0 0 0 1 -1 0.4 ) #name: #component3 #flags: 0 #minorKey: #list3 #clientKey: #component3 ) #(#{UI.ButtonTabNoteBookSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 0 0.25 -2 0.4 ) #name: #notebook #model: #majorTabs #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #changedMajorTab ) #binderWidth: 0 #majorTabsOnRight: false #rightInset: -19 #bottomInset: 7 ) ) ) )
</methods> <methods> Tools.BrowserListEntry class <category>resources</category>
CcanvasIcon "UIMaskEditor new openOnClass: self andSelector: #CcanvasIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 3) at: 1 put: ColorValue black; at: 2 put: ColorValue yellow; at: 3 put: ColorValue white; yourself)) usingBits: #[170 170 170 168 170 160 42 168 170 168 170 168 168 0 0 168 170 25 152 168 170 6 102 40 170 137 153 136 170 130 100 8 170 161 128 168 170 160 8 168 170 168 138 40 170 170 138 168 170 170 170 168 170 170 170 168 ])
CFolderIcon "UIMaskEditor new openOnClass: self andSelector: #CFolderIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 3) at: 1 put: ColorValue black; at: 2 put: ColorValue yellow; at: 3 put: ColorValue white; yourself)) usingBits: #[170 170 170 168 128 42 170 168 38 64 0 0 0 25 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 0 0 0 0 170 170 170 168])
CiconIcon "UIMaskEditor new openOnClass: self andSelector: #CiconIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 5) at: 1 put: (ColorValue scaledRed: 3822 scaledGreen: 3822 scaledBlue: 3822); at: 2 put: (ColorValue scaledRed: 0 scaledGreen: 4369 scaledBlue: 0); at: 3 put: ColorValue magenta; at: 4 put: ColorValue white; at: 5 put: ColorValue blue; yourself)) usingBits: #[51 51 51 51 51 51 51 48 51 51 51 51 51 51 51 48 51 48 0 0 0 0 3 48 51 48 51 1 16 51 3 48 51 48 51 1 16 51 3 48 51 48 0 0 0 0 3 48 51 48 34 3 48 51 3 48 51 48 34 3 48 51 3 48 51 48 0 0 0 0 3 48 51 48 51 4 64 51 3 48 51 48 51 4 64 51 3 48 51 48 0 0 0 0 3 48 51 51 51 51 51 51 51 48 51 51 51 51 51 51 51 48 ])
CMenuIcon "UIMaskEditor new openOnClass: self andSelector: #CMenuIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 5) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 0 scaledGreen: 0 scaledBlue: 4369); at: 3 put: ColorValue yellow; at: 4 put: ColorValue white; at: 5 put: (ColorValue scaledRed: 0 scaledGreen: 4915 scaledBlue: 8191); yourself)) usingBits: #[51 51 51 51 51 51 51 48 51 48 0 0 0 0 0 48 51 48 34 34 34 34 32 48 51 48 0 0 0 0 0 48 51 48 51 51 51 3 51 48 51 48 17 17 17 3 51 48 51 48 68 68 68 3 51 48 51 48 17 17 17 3 51 48 51 48 51 51 51 3 51 48 51 48 17 17 17 3 51 48 51 48 51 51 51 3 51 48 51 48 0 0 0 3 51 48 51 51 51 51 51 51 51 48 51 51 51 51 51 51 51 48 ])
CModelIcon "UIMaskEditor new openOnClass: self andSelector: #CModelIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 4) at: 1 put: ColorValue black; at: 2 put: ColorValue cyan; at: 3 put: ColorValue white; at: 4 put: (ColorValue scaledRed: 6553 scaledGreen: 6553 scaledBlue: 6553); yourself)) usingBits: #[170 170 170 168 170 168 0 40 170 131 255 192 170 132 0 16 170 133 85 80 170 165 85 80 168 0 5 80 168 162 133 64 168 0 4 40 168 162 138 168 168 0 10 168 168 162 138 168 168 0 10 168 170 170 170 168 ])
CQueryIcon "UIMaskEditor new openOnClass: self andSelector: #CQueryIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 4) at: 1 put: ColorValue black; at: 2 put: ColorValue cyan; at: 3 put: ColorValue white; at: 4 put: (ColorValue scaledRed: 6553 scaledGreen: 6553 scaledBlue: 6553); yourself)) usingBits: #[170 170 42 168 170 168 10 168 170 160 2 168 170 170 42 168 170 130 32 168 168 62 47 8 168 66 32 72 168 86 37 72 168 86 37 72 168 86 37 72 168 85 149 72 170 5 84 40 170 160 2 168 170 170 170 168 ])
CRegionsIcon "UIMaskEditor new openOnClass: self andSelector: #CRegionsIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 3) at: 1 put: ColorValue black; at: 2 put: ColorValue red; at: 3 put: ColorValue white; yourself)) usingBits: #[170 170 170 168 170 170 170 168 168 0 0 40 168 0 0 40 168 21 64 40 168 21 64 40 168 21 84 40 168 5 84 40 168 5 84 40 168 5 84 40 168 0 0 40 168 0 0 40 170 170 170 168 170 170 170 168])
CSignalIcon "UIMaskEditor new openOnClass: self andSelector: #CSignalIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 2 bitsPerPixel: 2 palette: (MappedPalette withColors: ((Array new: 3) at: 1 put: ColorValue black; at: 2 put: ColorValue yellow; at: 3 put: ColorValue white; yourself)) usingBits: #[170 160 2 168 170 161 82 168 170 133 74 168 170 133 42 168 170 21 2 168 170 1 82 168 170 161 74 168 170 133 42 168 170 132 170 168 170 20 10 168 170 1 74 168 170 161 42 168 170 132 170 168 170 130 170 168])
CVariableIcon "UIMaskEditor new openOnClass: self andSelector: #CVariableIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 3 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 5) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 5460 scaledGreen: 5460 scaledBlue: 5460); at: 3 put: ColorValue yellow; at: 4 put: ColorValue white; at: 5 put: (ColorValue scaledRed: 4111 scaledGreen: 4111 scaledBlue: 0); yourself)) usingBits: #[51 51 51 0 3 51 51 48 51 51 0 68 64 3 51 48 51 0 68 68 68 64 3 48 48 4 68 68 68 68 0 48 48 32 4 68 68 0 32 48 48 18 16 4 0 18 16 48 48 33 33 32 33 33 32 48 48 18 18 16 18 18 16 48 48 33 33 32 33 33 32 48 48 18 18 16 18 18 16 48 48 1 33 32 33 33 0 48 51 48 2 16 18 0 51 48 51 51 48 0 0 51 51 48 51 51 51 48 51 51 51 48])
MskCanvasIcon "UIMaskEditor new openOnClass: self andSelector: #MskCanvasIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 3 128 0 0 1 0 0 0 31 240 0 0 15 240 0 0 15 248 0 0 7 252 0 0 7 252 0 0 3 240 0 0 3 208 0 0 1 72 0 0 0 64 0 0 0 0 0 0 0 0 0 0 ])
MskFolderIcon "UIMaskEditor new openOnClass: self andSelector: #MskFolderIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 120 0 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 255 254 0 0 0 0 0 0])
MskIconIcon "UIMaskEditor new openOnClass: self andSelector: #MskIconIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 0 0 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 31 248 0 0 0 0 0 0 0 0 0 0 ])
MskMenuIcon "UIMaskEditor new openOnClass: self andSelector: #MskMenuIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 31 252 0 0 31 252 0 0 31 252 0 0 31 224 0 0 31 224 0 0 31 224 0 0 31 224 0 0 31 224 0 0 31 224 0 0 31 224 0 0 31 224 0 0 0 0 0 0 0 0 0 0 ])
MskModelIcon "UIMaskEditor new openOnClass: self andSelector: #MskModelIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 1 248 0 0 7 254 0 0 7 254 0 0 7 254 0 0 3 254 0 0 31 254 0 0 31 254 0 0 31 248 0 0 31 192 0 0 31 192 0 0 31 192 0 0 31 192 0 0 0 0 0 0 ])
MskQueryIcon "UIMaskEditor new openOnClass: self andSelector: #MskQueryIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 128 0 0 1 192 0 0 3 224 0 0 0 128 0 0 7 240 0 0 31 252 0 0 31 252 0 0 31 252 0 0 31 252 0 0 31 252 0 0 31 252 0 0 15 248 0 0 3 224 0 0 0 0 0 0 ])
MskSignalIcon "UIMaskEditor new openOnClass: self andSelector: #MskSignalIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[3 224 0 0 3 224 0 0 7 192 0 0 7 128 0 0 15 224 0 0 15 224 0 0 3 192 0 0 7 128 0 0 7 0 0 0 15 192 0 0 15 192 0 0 3 128 0 0 7 0 0 0 6 0 0 0])
MskVariableIcon "UIMaskEditor new openOnClass: self andSelector: #MskVariableIcon" <resource: #image> ^CachedImage on: (Image extent: 15@14 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[3 128 0 0 15 224 0 0 63 248 0 0 127 252 0 0 127 252 0 0 127 252 0 0 127 252 0 0 127 252 0 0 127 252 0 0 127 252 0 0 127 252 0 0 31 240 0 0 7 192 0 0 1 0 0 0])
</methods> <methods> Tools.BlankUI class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #labels) #min: #(#{Point} 20 20 ) #bounds: #(#{Rectangle} 260 292 460 492 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SequenceViewSpec} #layout: #(#{LayoutFrame} 1 0 1 0 -1 1 -1 1 ) #model: #blankList ) ) ) )
</methods> <methods> Tools.ParcelListBrowserHelper class <category>resources</category>
defTypeMenu "MenuEditor new openOnClass: self andSelector: #defTypeMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ParcelComment #defaultString: 'Parcel comment' #catalogID: #menus) #nameKey: #parcelComment #value: #parcelComment ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #parcelSummary #defaultString: 'Parcel summary' #catalogID: #menus ) #nameKey: #parcelSummary #value: #parcelSummary ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #DanglingReferences #defaultString: 'Dangling references' #catalogID: #menus) #nameKey: #parcelDanglingReferences #value: #parcelDanglingReferences ) ) #(3 ) nil ) decodeAsLiteralArray
listMenu "MenuEditor new openOnClass: self andSelector: #listMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_NewDot #catalogID: #menus #defaultString: '&New...') #nameKey: #newParcel #value: #newParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_LoadDot #catalogID: #menus #defaultString: '&Load...') #nameKey: #loadParcel #value: #loadParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_SaveDot #catalogID: #menus #defaultString: '&Save...') #nameKey: #saveParcelDialog #value: #saveParcelDialog ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #FileOutAsDot #catalogID: #menus #defaultString: 'File &Out As...') #nameKey: #fileOutParcel #value: #fileOutParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Re_nameAsDot #catalogID: #menus #defaultString: 'Re&name As...') #nameKey: #renameParcel #value: #renameParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #UnloadDot #catalogID: #menus #defaultString: '&Unload...') #nameKey: #unloadParcel #value: #unloadParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_RemoveDot #catalogID: #menus #defaultString: '&Remove...') #nameKey: #removeParcel #value: #removeParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Discard #catalogID: #menus #defaultString: '&Discard') #nameKey: #discardParcel #value: #discardParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Empty #catalogID: #menus #defaultString: '&Empty') #nameKey: #emptyParcel #value: #emptyParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #BuildDot #catalogID: #menus #defaultString: '&Build...') #nameKey: #buildSubMenu #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #AddFileIn #catalogID: #menus #defaultString: 'Add &File-In') #nameKey: #fileIntoParcel #value: #fileIntoParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #AddChanges #catalogID: #menus #defaultString: 'Add &Changes') #nameKey: #addChangeSet #value: #addChangeSet ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #RemoveChanges #catalogID: #menus #defaultString: '&Remove Changes') #nameKey: #removeChangeSet #value: #removeChangeSet ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #AddToChanges #catalogID: #menus #defaultString: 'Add &to Changes') #nameKey: #addToChanges #value: #addToChanges ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #RemoveFromChanges #catalogID: #menus #defaultString: 'Remove &from Changes') #nameKey: #removeFromChanges #value: #removeFromChanges ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MakeRemoveScript #catalogID: #menus #defaultString: '&Make Remove Script') #nameKey: #removeScript #value: #removeScript ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ComputePrerequisites #catalogID: #menus #defaultString: '&Compute Prerequisites') #nameKey: #showComputedPrerequisites #value: #showComputedPrerequisites ) ) #(3 4 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Browse #catalogID: #menus #defaultString: '&Browse') #nameKey: #browseSubMenu #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ImportedClassReferences #catalogID: #menus #defaultString: '&Imported Class References') #value: #browseClassImports ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ExportedClassReferences #catalogID: #menus #defaultString: '&Exported Class References') #value: #browseClassExports ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #UnparcelledMethodsUsedExclusively #catalogID: #menus #defaultString: 'Unparcelled Methods &Used Exclusively') #value: #browseExclusiveMethodImports ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #UnparcelledMethodsInDefinedClasses #catalogID: #menus #defaultString: 'Unparcelled Methods in &Defined Classes') #value: #browseUnparceledMethodsOnDefinedClasses ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ExtensionMethods #catalogID: #menus #defaultString: '&Extension Methods') #value: #browseExtensionMethods ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #OverriddenExtensions #catalogID: #menus #defaultString: '&Overridden Extensions') #value: #browseOverriddenExtensions ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #MethodsOverriddenByOthers #catalogID: #menus #defaultString: '&Methods Overridden by Others') #nameKey: #browseOverriddenByOthers #value: #browseOverriddenByOthers ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ChangedMethods #catalogID: #menus #defaultString: 'C&hanged Methods') #value: #browseChangedMethods ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Dan_glingReferences #catalogID: #menus #defaultString: 'Dan&gling References') #value: #browseDanglingReferences ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ReferencesToDot #catalogID: #menus #defaultString: '&References to...') #value: #browseSendersOf ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ImplementorsOfDot #catalogID: #menus #defaultString: '&Implementors of...') #value: #browseImplementorsOf ) ) #(4 3 2 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #Filter #catalogID: #menus #defaultString: 'Fi&lter') #nameKey: #filter #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ShowOnlyParceled #catalogID: #menus #defaultString: 'Show Only &Parceled') #nameKey: #showOnlyParceled #value: #toggleParceled ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ShowOnlyUnparceled #catalogID: #menus #defaultString: 'Show Only &Unparceled') #nameKey: #showOnlyUnparceled #value: #toggleUnparceled ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #ShowMultiplyParceled #catalogID: #menus #defaultString: 'Show &Multiply Parceled') #nameKey: #showMultiplyParceled #value: #toggleConflicts ) ) #(3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #PropertiesDot #catalogID: #menus #defaultString: '&Properties...') #value: #openParcelProperties ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #UndoLastParcelling #catalogID: #menus #defaultString: '&Undo Last Parcelling') #nameKey: #doUndo #value: #doUndo ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Inspect #catalogID: #menus #defaultString: '&Inspect') #value: #inspectParcel ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_FindDot #catalogID: #menus #defaultString: '&Find...') #nameKey: #find #value: #find ) #(#{UI.MenuItem} #rawLabel: #(#{Kernel.UserMessage} #key: #_Update #catalogID: #menus #defaultString: '&Update') #nameKey: #updateBrowser #value: #updateBrowser ) ) #(2 2 3 2 3 3 2 ) nil ) decodeAsLiteralArray
</methods> <methods> UI.PackagePropertiesDialog class <category>interface specs</category>
activeAreaSpec "UIPainter new openOnClass: self andSelector: #activeAreaSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #min: #(#{Core.Point} 265 317 ) #max: #(#{Core.Point} 418 452 ) #bounds: #(#{Graphics.Rectangle} 206 74 595 526 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 33 0 1 0 29 1 -3 1 ) #name: #activeComponents #flags: 0 ) ) ) )
deploymentPropertiesSpec "UIPainter new openOnClass: self andSelector: #deploymentPropertiesSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 335 182 728 599 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #deploymentPropertiesAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #deploymentPropertiesReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #deploymentPropertiesRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0305344 0 0.0479616 ) #label: #(#{UserMessage} #key: #warningSuppression #catalogID: #labels #defaultString: 'Warning Suppression Action:') ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 14 0 -121 0.4 -66 1 -157 0.8 ) #name: #warningSuppressionText #model: #warningSuppressionText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) ) ) )
generalPropertiesSpec "UIPainter new openOnClass: self andSelector: #generalPropertiesSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Point} 274 270 ) #bounds: #(#{Rectangle} 890 209 1286 657 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SubCanvasSpec} #layout: #(#{LayoutFrame} 10 0 40 0 0 0.9 0 0.8 ) #flags: 0 #majorKey: #{ParcelPropertiesInspector} #minorKey: #windowSpec #clientKey: #generalProperties ) #(#{LabelSpec} #layout: #(#{Point} 10 10 ) #label: #(#{UserMessage} #key: #generalPropertiesInspector #catalogID: #labels #defaultString: 'General Properties Inspector' )) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 0 0.1 0 0.9 ) #name: #acceptButton #flags: 40 #model: #generalPropertiesAccept #callbacksSpec: #(#{UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 0 0.4 0 0.9 ) #name: #resetButton #flags: 40 #model: #generalPropertiesReset #callbacksSpec: #(#{UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset') #defaultable: true ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 0 0.7 0 0.9 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) ) ) )
loadOptionsSpec "UIPainter new openOnClass: self andSelector: #loadOptionsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 327 176 720 593 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #loadOptionsAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #loadOptionsReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #loadOptionsRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0305344 0 0.0479616 ) #label: #(#{UserMessage} #key: #warningSuppression #catalogID: #labels #defaultString: 'Warning Suppression Action:') ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 14 0 -121 0.4 -66 1 -157 0.8 ) #name: #warningSuppressionText #model: #warningSuppressionText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) ) ) )
loadSpec "UIPainter new openOnClass: self andSelector: #loadSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 601 376 999 825 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 16 6 ) #label: #(#{UserMessage} #key: #preLoadAction #catalogID: #labels #defaultString: 'Pre-load Action:') ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 16 0 6 0.4 ) #label: #(#{UserMessage} #key: #postLoadAction #catalogID: #labels #defaultString: 'Post-load Action:') ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0 -64 1 -4 0.4 ) #name: #preloadText #model: #preloadText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0.4 -64 1 -4 0.8 ) #name: #postloadText #model: #postloadText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #loadAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #loadReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset') #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #loadRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) ) ) )
preReadSpec "UIPainter new openOnClass: self andSelector: #preReadSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 46 67 444 516 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 16 6 ) #label: #(#{UserMessage} #key: #preReadAction #catalogID: #labels #defaultString: 'Pre-read Action:' )) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 16 0 6 0.4 ) #label: #(#{UserMessage} #key: #PreReqVersion #catalogID: #labels #defaultString: 'Prerequisite Version Selection Action:') ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0 -64 1 -4 0.4 ) #name: #preReadText #model: #preReadText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0.4 -64 1 -4 0.8 ) #name: #versionSelectionText #model: #versionSelectionText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #preReadAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #preReadReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #preReadRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) ) ) )
prerequisitesSpec "UIPainter new openOnClass: self andSelector: #prerequisitesSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 316 176 709 593 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #prerequisitesAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #prerequisitesReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #prerequisitesRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0356234 0 0.028777 ) #label: #(#{UserMessage} #key: #deploymentPrerequisites #catalogID: #labels #defaultString: 'Deployment Prerequisites:' ) ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0 -64 1 -4 0.4 ) #name: #deploymentPrerequisitesText #model: #deploymentPrerequisitesText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0407125 0 0.414868 ) #label: #(#{UserMessage} #key: #developmentPrerequisites #catalogID: #labels #defaultString: 'Development Prerequisites:' )) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0.4 -64 1 -4 0.8 ) #name: #developmentPrerequisitesText #model: #developmentPrerequisitesText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) ) ) )
saveSpec "UIPainter new openOnClass: self andSelector: #saveSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 601 376 999 825 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #saveAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #saveReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #saveRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 16 6 ) #label: #(#{UserMessage} #key: #preSaveAction #catalogID: #labels #defaultString: 'Pre-save Action:') ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0 -64 1 -4 0.4 ) #name: #presaveText #model: #presaveText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) ) ) )
unloadSpec "UIPainter new openOnClass: self andSelector: #unloadSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{UserMessage} #key: #UnlabeledCanvas #catalogID: #labels #defaultString: 'Unlabeled Canvas' ) #min: #(#{Core.Point} 274 270 ) #bounds: #(#{Graphics.Rectangle} 601 376 999 825 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.03 0 0.85 -3 0.25 0 0.93 ) #name: #acceptButton #flags: 40 #model: #unloadAccept #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Accept #catalogID: #labels #defaultString: 'Accept' ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.25 0 0.85 -3 0.47 0 0.93 ) #name: #resetButton #flags: 40 #model: #unloadReset #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Reset #catalogID: #labels #defaultString: 'Reset' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.47 0 0.85 -3 0.69 0 0.93 ) #name: #removeButton #model: #unloadRemove #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #undisturb ) #label: #(#{UserMessage} #key: #Remove #catalogID: #labels #defaultString: 'Remove' ) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 3 0.69 0 0.85 -3 0.89 0 0.93 ) #model: #helpAction #label: #(#{UserMessage} #key: #Help #catalogID: #labels #defaultString: 'Help' ) #defaultable: true ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0 -64 1 -4 0.4 ) #name: #preunloadText #model: #preunloadText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 16 0 32 0.4 -64 1 -4 0.8 ) #name: #postunloadText #model: #postunloadText #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #disturb ) ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 16 6 ) #label: #(#{UserMessage} #key: #preUnloadAction #catalogID: #labels #defaultString: 'Pre-unload Action:') ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 16 0 6 0.4 ) #label: #(#{UserMessage} #key: #postUnloadAction #catalogID: #labels #defaultString: 'Post-unload Action:' ) ) ) ) )
windowNotebookSpec "UIPainter new openOnClass: self andSelector: #windowNotebookSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #windowLabel #min: #(#{Core.Point} 523 340 ) #bounds: #(#{Graphics.Rectangle} 260 158 830 633 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TabControlSpec} #layout: #(#{Graphics.LayoutFrame} 2 0 5 0 -35 1 -18 1 ) #name: #notebook #model: #preferenceMasterList #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestValueChangeSelector: #requestSliceChange ) #rightInset: 120 #bottomInset: 0 ) ) ) )
</methods> <methods> Tools.MorphingBrowserModule class <category>resources</category>
metaMenu "MenuEditor new openOnClass: self andSelector: #metaMenu" <resource: #menu> ^#(#{Menu} #( #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #InstanceDefinitions #defaultString: '&Instance Methods' #catalogID: #menus ) #nameKey: #instance #value: #instance ) #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #ClassDefinitions #defaultString: '&Class Methods' #catalogID: #menus ) #nameKey: #class #value: #class ) #(#{MenuItem} #rawLabel: #(#{UserMessage} #key: #Data #defaultString: '&Shared Variables' #catalogID: #menus ) #nameKey: #data #value: #data ) ) #(3 ) nil ) decodeAsLiteralArray
</methods> <methods> Tools.NamespaceTabApplication class <category>resources</category>
folderIcon "UIMaskEditor new openOnClass: self andSelector: #folderIcon" <resource: #image> ^CachedImage on: (Image extent: 15@17 depth: 2 bitsPerPixel: 2 palette: (Core.MappedPalette withColors: ((Core.Array new: 3) at: 1 put: Graphics.ColorValue black; at: 2 put: Graphics.ColorValue yellow; at: 3 put: Graphics.ColorValue white; yourself)) usingBits: #[170 170 170 168 170 170 170 168 170 170 170 168 170 170 170 168 128 42 170 168 38 64 0 0 0 25 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 38 102 102 96 25 153 153 144 0 0 0 0 170 170 170 168])
</methods> <methods> Tools.PickASomethingDialog class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: ' ' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 728 554 924 781 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0.00440529 0 0.989796 0 0.814978 ) #name: #list #flags: 15 #model: #list #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #doubleClick ) #selectionType: #highlight ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0918367 0 0.85022 0 0.357143 0 0.960352 ) #name: #ok #model: #doAccept #label: #(#{Kernel.UserMessage} #key: #OK #catalogID: #labels #defaultString: 'OK') #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.642857 0 0.85022 0 0.908163 0 0.960352 ) #name: #cancel #model: #closeCancel #label: #(#{Kernel.UserMessage} #key: #Cancel #catalogID: #labels #defaultString: 'Cancel') #defaultable: true ) ) ) )
</methods> <initialize> Tools.FullNotebookSystemBrowser </initialize> <initialize> Tools.BrowserListEntry </initialize> <initialize> UI.PackagePropertiesDialog </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>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>SimpleDialog</name> <environment>UI</environment> <super>UI.ApplicationModel</super> <private>false</private> none close accept cancel preBuildBlock postBuildBlock postOpenBlock escapeIsCancel parentView <imports></imports> <category>Interface-Dialogs</category> <attributes> <package>Interface-Dialogs</package> </attributes> </class> <class> <name>ValueHolder</name> <environment>UI</environment> <super>UI.ValueModel</super> <private>false</private> none value <imports></imports> <category>Interface-Support</category> <attributes> <package>Interface-Support</package> </attributes> </class>