'From Squeak3.1alpha of 28 February 2001 [latest update: #3868] on 20 March 2001 at 10:47:34 pm'! "Change Set: lexicon-sw Date: 20 March 2001 Author: Scott Wallace Introduces two related tools to the system: ¥ Lexicon, an integrated protocol browser directed at a class ¥ InstanceBrowser, a Lexicon bound to a specific instance. These tools are navigation-based (rather than multi-window based) and combine functionality formerly distributed variously among the following tools: class browser, protocol browser, 'senders' browser, method finder, changed-message browser, inst-var-refs browser, inst-var-defs browser, class-var-refs browser, etoy Viewers, ¥ Cmd-p is hooked up to launch these new tools when issued in appropriate places in morphic inspectors and browsers. ¥ The companion update 'lexiconSupport' provides all the related changes that are outside the ProtocolBrowser hierarchy."! ProtocolBrowser subclass: #Lexicon instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited ' classVariableNames: '' poolDictionaries: '' category: 'System-Protocols'! !Lexicon commentStamp: 'sw 3/19/2001 08:12' prior: 0! An instance of Lexicon shows the a list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list. A variant with a search pane rather than a category list is also implemented. categoryList the list of categories categoryListIndex index of currently-selected category targetObject optional -- an instance being viewed targetClass the class being viewed lastSearchString the last string searched for lastSendersSearchSelector the last senders search selector limitClass optional -- the limit class to search for selectorsVisited list of selectors visited selectorsActive not presently in use, subsumed by selectorsVisited currentVocabulary the vocabulary currently installed currentQuery what the query category relates to: #senders #selectorName #currentChangeSet! Lexicon subclass: #InstanceBrowser instanceVariableNames: 'objectViewed ' classVariableNames: '' poolDictionaries: '' category: 'System-Protocols'! !ProtocolBrowser methodsFor: 'private' stamp: 'sw 12/28/2000 14:09'! setClassAndSelectorIn: csBlock "Decode strings of the form ( [class])" | i classAndSelString selString sel | classAndSelString _ (sel _ self selection) ifNotNil: [selString _ sel asString. i _ selString indexOf: $(. "Rearrange to [class] , and use MessageSet" (selString copyFrom: i + 1 to: selString size - 1) , ' ' , (selString copyFrom: 1 to: i - 1) withoutTrailingBlanks]. MessageSet parse: classAndSelString toClassAndSelector: csBlock! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 12/14/2000 06:50'! defaultBackgroundColor "Answer the default background color for the window -- here, a cheerful green" ^ Color r: 0.878 g: 1.000 b: 0.878 "Color fromUser ()"! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 12/18/2000 16:12'! initListFrom: selectorCollection highlighting: aClass "Make up the messageList with items from aClass in boldface. Provide a final filtering in that only selectors whose implementations fall within my limitClass will be shown." | defClass item | messageList := OrderedCollection new. selectorCollection do: [:selector | defClass _ aClass whichClassIncludesSelector: selector. (defClass notNil and: [defClass includesBehavior: self limitClass]) ifTrue: [item _ selector, ' (' , defClass name , ')'. item _ item asText. defClass == aClass ifTrue: [item allBold]. "(self isThereAnOverrideOf: selector) ifTrue: [item addAttribute: TextEmphasis struckOut]." "The above has a germ of a good idea but could be very slow" messageList add: item]]! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 3/20/2001 12:18'! openOnClass: aTargetClass inWorld: aWorld showingSelector: aSelector "Create and open a SystemWindow to house the receiver, showing the categories pane. The target-object parameter is optional -- if nil, the browser will be associated with the class as a whole but not with any particular instance of it." | window aListMorph catListFraction msgListFraction | currentVocabulary ifNil: [currentVocabulary _ Vocabulary fullVocabulary]. limitClass ifNil: [limitClass _ ProtoObject]. targetClass _ aTargetClass. window _ self windowWithLabel: self startingWindowTitle. catListFraction _ 0.15. msgListFraction _ 0.2. window addMorph: self newCategoryPane frame: (0 @ 0 corner: 1 @ catListFraction). aListMorph _ PluggableListMorph on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. aListMorph setNameTo: 'messageList'. aListMorph menuTitleSelector: #messageListSelectorTitle. window addMorph: aListMorph frame: (0 @ catListFraction corner: 1 @ (catListFraction + msgListFraction)). self addLowerPanesTo: window at: (0 @ (catListFraction + msgListFraction) corner: 1@1) with: nil. window openInWorld: aWorld. self reformulateCategoryList. aSelector ifNotNil: [self selectSelectorItsNaturalCategory: aSelector] ifNil: [self categoryListIndex: 1]. self adjustWindowTitle. ! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 1/30/2001 22:24'! openWithSearchPaneOn: aTargetClass inWorld: aWorld "Create and open a SystemWindow to house the receiver, search-pane variant. Only sender is currently unsent; a disused branch but still for the moment retained" | window aListMorph aTextMorph baseline typeInPane | targetClass _ aTargetClass. window _ self windowWithLabel: 'Vocabulary of ', aTargetClass nameForViewer. window addMorph: self newSearchPane frame: (0@0 extent: 1@0.05). aListMorph _ PluggableListMorph on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. aListMorph menuTitleSelector: #messageListSelectorTitle. window addMorph: aListMorph frame: (0@0.05 extent: 1@0.25). self wantsAnnotationPane ifFalse: [baseline _ 0.25] ifTrue: [aTextMorph _ PluggableTextMorph on: self text: #annotation accept: nil readSelection: nil menu: nil. aTextMorph askBeforeDiscardingEdits: false. window addMorph: aTextMorph frame: (0@0.25 corner: 1@0.35). baseline _ 0.35]. self wantsOptionalButtons ifTrue: [window addMorph: self optionalButtonRow frame: ((0@baseline corner: 1 @ (baseline + 0.08))). baseline _ baseline + 0.08]. typeInPane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. typeInPane retractable: false. window addMorph: typeInPane frame: (0 @ baseline corner: 1 @ 1). window setUpdatablePanesFrom: #(messageList). window openInWorld: aWorld. self flag: #deferred. "self initListFrom: aTargetClass allCategoriesInProtocol asSortedCollection highlighting: aTargetClass" "(Lexicon new useProtocol: Protocol fullProtocol) openWithSearchPaneOn: TileMorph inWorld: self currentWorld" ! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 1/24/2001 21:25'! wantsAnnotationPane "This kind of browser always wants annotation panes, so answer true" ^ true! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 1/24/2001 18:49'! wantsOptionalButtons "This kind of browser always wants optional buttons, so answer true" ^ true! ! !Lexicon methodsFor: 'initialization' stamp: 'sw 12/18/2000 23:19'! windowWithLabel: aLabel "Answer a SystemWindow associated with the receiver, with appropriate border characteristics" | window | (window _ SystemWindow labelled: aLabel) model: self. "window borderWidth: 1; borderColor: self defaultBackgroundColor darker." ^ window ! ! !Lexicon methodsFor: 'basic operation' stamp: 'sw 3/20/2001 16:06'! annotation "Provide a line of annotation material for a middle pane." | aCategoryName | self selectedMessageName ifNotNil: [^ super annotation]. (aCategoryName _ self selectedCategoryName) ifNil: [^ self hasSearchPane ifTrue: ['type a message name or fragment in the top pane and hit RETURN or ENTER'] ifFalse: ['' "currentVocabulary documentation"]]. (aCategoryName = self class queryCategoryName) ifTrue: [^ self queryCharacterization]. #( (allCategoryName 'Shows all methods, whatever other category they belong to') (viewedCategoryName 'Methods visited recently. Use "-" button to remove a method from this category.') (queryCategoryName 'Query results')) do: [:pair | (self categoryWithNameSpecifiedBy: pair first) = aCategoryName ifTrue: [^ pair second]]. ^ currentVocabulary categoryCommentFor: aCategoryName! ! !Lexicon methodsFor: 'basic operation' stamp: 'sw 12/5/2000 15:50'! displaySelector: aSelector "Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category" | detectedItem messageIndex | self chooseCategory: (self categoryDefiningSelector: aSelector). detectedItem _ messageList detect: [:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self beep]. messageIndex _ messageList indexOf: detectedItem. self messageListIndex: messageIndex! ! !Lexicon methodsFor: 'basic operation' stamp: 'sw 1/12/2001 00:34'! messageListIndex: anIndex "Set the message list index as indicated, and update the history list if appropriate" | newSelector current | current _ self selectedMessageName. super messageListIndex: anIndex. (newSelector _ self selectedMessageName) ifNotNil: [self updateSelectorsVisitedfrom: current to: newSelector]! ! !Lexicon methodsFor: 'category list' stamp: 'sw 3/7/2001 12:19'! categoriesPane "If there is a pane defined by #categoryList in my containing window, answer it, else answer nil" ^ self listPaneWithSelector: #categoryList! ! !Lexicon methodsFor: 'category list' stamp: 'sw 3/20/2001 12:13'! categoryDefiningSelector: aSelector "Answer a category in which aSelector occurs" | categoryNames | categoryNames _ categoryList copyWithoutAll: #('-- all --'). ^ currentVocabulary categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: self targetObject ofClass: targetClass! ! !Lexicon methodsFor: 'category list' stamp: 'sw 3/20/2001 12:12'! categoryList "Answer the category list for the protcol, creating it if necessary, and prepending the -- all -- category, and appending the other special categories for search results, etc." | specialCategoryNames | categoryList ifNil: [specialCategoryNames _ #(queryCategoryName viewedCategoryName "searchCategoryName sendersCategoryName changedCategoryName activeCategoryName") collect: [:sym | self class perform: sym]. categoryList _ (Array with: self class allCategoryName), specialCategoryNames, (currentVocabulary categoryListForInstance: self targetObject ofClass: targetClass limitClass: limitClass)]. ^ categoryList! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/12/2000 19:37'! categoryListIndex "Answer the index of the currently-selected item in in the category list" ^ categoryListIndex ifNil: [categoryListIndex _ 1]! ! !Lexicon methodsFor: 'category list' stamp: 'sw 3/20/2001 20:19'! categoryListIndex: anIndex "Set the category list index as indicated" | categoryName aList found existingSelector | existingSelector _ self selectedMessageName. categoryListIndex _ anIndex. anIndex > 0 ifTrue: [categoryName _ categoryList at: anIndex] ifFalse: [contents _ nil]. self changed: #categoryListIndex. found _ false. #( (viewedCategoryName selectorsVisited) (queryCategoryName selectorsRetrieved)) do: [:pair | categoryName = (self class perform: pair first) ifTrue: [aList _ self perform: pair second. found _ true]]. found ifFalse: [aList _ currentVocabulary allMethodsInCategory: categoryName forInstance: self targetObject ofClass: targetClass]. categoryName = self class queryCategoryName ifFalse: [autoSelectString _ nil]. self initListFrom: aList highlighting: targetClass. messageListIndex _ 0. self changed: #messageList. contents _ nil. self contentsChanged. self selectWithinCurrentCategoryIfPossible: existingSelector. self adjustWindowTitle! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/12/2000 11:50'! categoryListKey: aChar from: aView "The user hit a command-key while in the category-list. Do something" (aChar == $f and: [self hasSearchPane not]) ifTrue: [^ self obtainNewSearchString].! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/12/2000 11:50'! categoryListMenu: aMenu shifted: aBoolean "Answer the menu for the category list" ^ aMenu labels: 'find...(f)' lines: #() selections: #(obtainNewSearchString)! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/1/2000 22:13'! categoryListMenuTitle "Answer the menu title for the category list menu" ^ 'categories'! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/13/2000 10:38'! categoryWithNameSpecifiedBy: aSelector "Answer the category name obtained by sending aSelector to my class. This provides a way to avoid hard-coding the wording of conventions such as '-- all --'" ^ self class perform: aSelector! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/1/2000 23:01'! chooseCategory: aCategory "Choose the category of the given name, if there is one" self categoryListIndex: (categoryList indexOf: aCategory ifAbsent: [^ self beep])! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/28/2000 13:46'! newCategoryPane "Formulate a category pane for insertion into the receiver's pane list" | aListMorph | aListMorph _ PluggableListMorph on: self list: #categoryList selected: #categoryListIndex changeSelected: #categoryListIndex: menu: #categoryListMenu:shifted: keystroke: #categoryListKey:from:. aListMorph setNameTo: 'categoryList'. aListMorph menuTitleSelector: #categoryListMenuTitle. ^ aListMorph! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/11/2000 14:47'! reformulateCategoryList "Reformulate the category list" categoryList _ nil. self categoryListIndex: 0. self changed: #categoryList. self contentsChanged! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/11/2000 14:52'! selectWithinCurrentCategoryIfPossible: aSelector "If the receiver's message list contains aSelector, navigate right to it without changing categories" | detectedItem messageIndex | aSelector ifNil: [^ self]. detectedItem _ messageList detect: [:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self]. messageIndex _ messageList indexOf: detectedItem. self messageListIndex: messageIndex ! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/12/2000 19:38'! selectedCategoryName "Answer the selected category name" ^ categoryList ifNotNil: [categoryList at: categoryListIndex ifAbsent: [nil]]! ! !Lexicon methodsFor: 'category list' stamp: 'sw 12/11/2000 14:52'! showCategoriesPane "Show the categories pane instead of the search pane" | aPane | (aPane _ self searchPane) ifNil: [^ self beep]. self containingWindow replacePane: aPane with: self newCategoryPane. categoryList _ nil. self changed: #categoryList. self changed: #messageList! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 10:35'! decorateButtons "Change screen feedback for any buttons in the UI of the receiver that may wish it." super decorateButtons. #( (seeAlso blue) (obtainNewSearchString blue) (setSendersSearch blue)) do: [:pair | (self buttonWithSelector: pair first) borderColor: (Color colorFrom: pair last)]. #( (navigateToPreviousMethod green) (navigateToNextMethod green) (removeFromSelectorsVisited green)) do: [:pair | (self buttonWithSelector: pair first) borderWidth: 0]. #((showMainCategory (darkGray))) do: [:pair | (self buttonWithSelector: pair first) ifNotNilDo: [:aButton | aButton borderColor: (Color colorFrom: pair last)]] ! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 10:03'! homeCategoryButton "Answer a button that brings up a menu. Useful when adding new features, but at present is between uses" ^ IconicButton new target: self; borderWidth: 0; labelGraphic: (ScriptingSystem formAtKey: #Cat); color: Color transparent; actWhen: #buttonUp; actionSelector: #showMainCategory; setBalloonText: 'show this method''s home category'; yourself! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 13:07'! mostGenericButton "Answer a button that reports on, and allow the user to modify, the most generic class to show" | aButton | aButton _ UpdatingSimpleButtonMorph newWithLabel: 'All'. aButton setNameTo: 'limit class'. aButton target: self; wordingSelector: #limitClassString; actionSelector: #chooseLimitClass. aButton setBalloonText: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. aButton actWhen: #buttonDown. aButton color: (Color r: 0.652 g: 0.935 b: 1.0). aButton borderColor: Color black. ^ aButton! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 10:34'! optionalButtonPairs "Answer a tuple (formerly pairs) defining buttons, in the format: button label selector to send help message" ^ #( ('view' seeAlso 'view a method called by this method') ('find' obtainNewSearchString 'find methods by name search') ('senders' setSendersSearch 'find methods I implement that send a given message') ('<' navigateToPreviousMethod 'view the previous active method') ('>' navigateToNextMethod 'view the next active method') ('-' removeFromSelectorsVisited 'remove this method from my active list')) " ('cat' showMainCategory 'show this method''s home category') ('inheritance' methodHierarchy 'browse method inheritance green: sends to super tan: has override(s) mauve: both of the above')"! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 16:30'! optionalButtonRow "Answer the row of control buttons for the browser" | aRow | aRow _ super optionalButtonRow. aRow addMorphBack: self homeCategoryButton. aRow addMorphFront: (Morph new extent: (4@10)) beTransparent. aRow addMorphFront: self mostGenericButton. Preferences menuButtonInToolPane ifFalse: "put this guy there if the preference suppresed it above" [aRow addMorphFront: self menuButton]. ^ aRow! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 3/20/2001 19:47'! searchToggleButton "Return a checkbox governing whether a search pane or a categories pane is used. No senders at the moment, but this feature might be useful someday." | outerButton aButton | outerButton _ AlignmentMorph newRow. outerButton wrapCentering: #center; cellPositioning: #leftCenter. outerButton color: Color transparent. outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap. outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox). aButton target: self; actionSelector: #toggleSearch; getSelector: #hasSearchPane. outerButton addMorphBack: (StringMorph contents: 'search') lock. outerButton setBalloonText: 'If checked, then a search pane is used, if not, then a categories pane will be seen instead'. ^ outerButton ! ! !Lexicon methodsFor: 'history' stamp: 'sw 12/14/2000 14:35'! navigateToNextMethod "Navigate to the 'next' method in the current viewing sequence" | anIndex aSelector | self selectorsVisited size == 0 ifTrue: [^ self]. anIndex _ (aSelector _ self selectedMessageName) notNil ifTrue: [selectorsVisited indexOf: aSelector ifAbsent: [selectorsVisited size]] ifFalse: [1]. self selectedCategoryName == self class viewedCategoryName ifTrue: [self selectWithinCurrentCategory: (selectorsVisited atWrap: (anIndex + 1))] ifFalse: [self displaySelector: (selectorsVisited atWrap: (anIndex + 1))]! ! !Lexicon methodsFor: 'history' stamp: 'sw 12/14/2000 14:35'! navigateToPreviousMethod "Navigate to the 'previous' method in the current viewing sequence" | anIndex aSelector | self selectorsVisited size == 0 ifTrue: [^ self]. anIndex _ (aSelector _ self selectedMessageName) notNil ifTrue: [selectorsVisited indexOf: aSelector ifAbsent: [selectorsVisited size]] ifFalse: [selectorsVisited size]. self selectedCategoryName == self class viewedCategoryName ifTrue: [self selectWithinCurrentCategory: (selectorsVisited atWrap: (anIndex - 1))] ifFalse: [self displaySelector: (selectorsVisited atWrap: (anIndex - 1))]! ! !Lexicon methodsFor: 'history' stamp: 'sw 12/5/2000 16:27'! navigateToRecentMethod "Put up a menu of recent selectors visited and navigate to the one chosen" | visited aSelector | (visited _ self selectorsVisited) size > 1 ifTrue: [visited _ visited copyFrom: 1 to: (visited size min: 20). aSelector _ (SelectionMenu selections: visited) startUpWithCaption: 'Recent methods visited in this browser'. aSelector isEmptyOrNil ifFalse: [self displaySelector: aSelector]]! ! !Lexicon methodsFor: 'history' stamp: 'sw 3/19/2001 10:58'! removeFromSelectorsVisited "Remove the currently-selected method from the active set" | aSelector | (aSelector _ self selectedMessageName) ifNil: [^ self]. self removeFromSelectorsVisited: aSelector. self chooseCategory: self class viewedCategoryName! ! !Lexicon methodsFor: 'history' stamp: 'sw 3/19/2001 07:43'! removeFromSelectorsVisited: aSelector "remove aSelector from my history list" self selectorsVisited remove: aSelector ifAbsent: []! ! !Lexicon methodsFor: 'history' stamp: 'sw 12/5/2000 16:27'! selectorsVisited "Answer the list of selectors visited in this tool" ^ selectorsVisited ifNil: [selectorsVisited _ OrderedCollection new]! ! !Lexicon methodsFor: 'history' stamp: 'sw 12/11/2000 08:49'! updateSelectorsVisitedfrom: oldSelector to: newSelector "Update the list of selectors visited." newSelector == oldSelector ifTrue: [^ self]. self selectorsVisited remove: newSelector ifAbsent: []. (selectorsVisited includes: oldSelector) ifTrue: [selectorsVisited add: newSelector after: oldSelector] ifFalse: [selectorsVisited add: newSelector] ! ! !Lexicon methodsFor: 'limit class' stamp: 'sw 3/19/2001 06:41'! chooseLimitClass "Put up a menu allowing the user to choose the most generic class to show" | aMenu | aMenu _ MenuMorph new defaultTarget: self. targetClass withAllSuperclasses do: [:aClass | aClass == ProtoObject ifTrue: [aMenu addLine]. aMenu add: aClass name selector: #setLimitClass: argument: aClass. aClass == limitClass ifTrue: [aMenu lastItem color: Color red]. aClass == targetClass ifTrue: [aMenu addLine]]. aMenu addTitle: 'Show only methods implemented at or above...'. "heh heh -- somebody please find nice wording here!!" aMenu popUpInWorld: self currentWorld! ! !Lexicon methodsFor: 'limit class' stamp: 'sw 12/13/2000 06:48'! limitClass "Answer the most generic class to show in the browser. By default, we go all the way up to ProtoObject" ^ limitClass ifNil: [limitClass _ ProtoObject]! ! !Lexicon methodsFor: 'limit class' stamp: 'sw 12/13/2000 06:49'! limitClass: aClass "Set the most generic class to show as indicated" limitClass _ aClass! ! !Lexicon methodsFor: 'limit class' stamp: 'sw 3/20/2001 13:07'! limitClassString "Answer a string representing the current choice of most-generic-class-to-show" | most | (most _ self limitClass) == ProtoObject ifTrue: [^ 'All']. most == targetClass ifTrue: [^ most name]. ^ 'Only through ', most name! ! !Lexicon methodsFor: 'limit class' stamp: 'sw 1/12/2001 00:17'! setLimitClass: aClass "Set aClass as the limit class for this browser" | currentClass currentSelector | currentClass _ self selectedClassOrMetaClass. currentSelector _ self selectedMessageName. self limitClass: aClass. categoryList _ nil. self categoryListIndex: 0. self changed: #categoryList. self changed: #methodList. self changed: #contents. self adjustWindowTitle. self hasSearchPane ifTrue: [self setMethodListFromSearchString]. self maybeReselectClass: currentClass selector: currentSelector ! ! !Lexicon methodsFor: 'model glue' stamp: 'sw 3/20/2001 12:11'! doItReceiver "This class's classPool has been jimmied to be the classPool of the class being browsed. A doIt in the code pane will let the user see the value of the class variables. Here, if the receiver is affiliated with a specific instance, we give give that primacy" ^ self targetObject ifNil: [self selectedClass ifNil: [FakeClassPool new]]! ! !Lexicon methodsFor: 'model glue' stamp: 'sw 3/20/2001 10:17'! okayToAccept "Answer whether it is okay to accept the receiver's input" | ok aClass reply | (ok _ super okayToAccept) ifTrue: [((aClass _ self selectedClassOrMetaClass) ~~ targetClass) ifTrue: [reply _ PopUpMenu withCaption: 'Caution!! This would be accepted into class ', aClass name, '. Is that okay?' chooseFrom: {'okay, no problem'. 'cancel - let me reconsider'. 'compile into ', targetClass name, ' instead'. 'compile into a new uniclass'}. reply = 1 ifTrue: [^ true]. reply ~~ 2 ifTrue: [self notYetImplemented]. ^ false]]. ^ ok! ! !Lexicon methodsFor: 'model glue' stamp: 'sw 3/20/2001 12:25'! targetObject "Answer the object to which this tool is bound." ^ nil! ! !Lexicon methodsFor: 'menu commands' stamp: 'sw 3/20/2001 20:39'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. aMenu addList: #( ('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) "('toggle search pane' toggleSearch)" - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('inst var refs (local)' setLocalInstVarRefs) ('inst var defs (local)' setLocalInstVarDefs) ('class var refs (local)' setLocalClassVarRefs) - ('inst var refs' browseInstVarRefs) ('inst var defs' browseInstVarDefs) ('class var refs' browseClassVarRefs) - ('more...' shiftedYellowButtonActivity)). aMenu popUpInWorld: ActiveWorld! ! !Lexicon methodsFor: 'menu commands' stamp: 'sw 3/20/2001 22:23'! removeMessage "Remove the selected message from the system." messageListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. super removeMessage. "my #reformulateList method, called from the super #removeMethod method, will however try to preserve the selection, so we take pains to clobber it by the below..." messageListIndex _ 0. self changed: #messageList. self changed: #messageListIndex. contents _ nil. self contentsChanged! ! !Lexicon methodsFor: 'menu commands' stamp: 'sw 12/12/2000 20:10'! showMainCategory "Continue to show the current selector, but show it within the context of its primary category" | aSelector | (aSelector _ self selectedMessageName) ifNotNil: [self preserveSelectorIfPossibleSurrounding: [self setToShowSelector: aSelector]]! ! !Lexicon methodsFor: 'new-window queries' stamp: 'sw 12/15/2000 12:28'! browseClassVarRefs "Let the search pertain to the target class regardless of selection" targetClass browseClassVarRefs! ! !Lexicon methodsFor: 'new-window queries' stamp: 'sw 12/15/2000 12:29'! browseInstVarDefs "Let the search pertain to the target class regardless of selection" targetClass browseInstVarDefs! ! !Lexicon methodsFor: 'new-window queries' stamp: 'sw 12/15/2000 12:29'! browseInstVarRefs "Let the search pertain to the target class regardless of selection" targetClass browseInstVarRefs! ! !Lexicon methodsFor: 'search' stamp: 'sw 12/11/2000 15:26'! hasSearchPane "Answer whether receiver has a search pane" ^ self searchPane notNil! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 18:55'! lastSearchString "Answer the last search string, initializing it to an empty string if it has not been initialized yet" ^ currentQueryParameter ifNil: [currentQueryParameter _ 'contents']! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 18:54'! lastSearchString: aString "Make a note of the last string searched for in the receiver" currentQueryParameter _ aString asString. currentQuery _ #selectorName. self setMethodListFromSearchString. ^ true! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 19:00'! lastSendersSearchSelector "Answer the last senders search selector, initializing it to a default value if it does not already have a value" ^ currentQueryParameter ifNil: [currentQueryParameter _ #flag:]! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 18:54'! methodListFromSearchString: fragment "Answer a method list of methods whose selectors match the given fragment" | aList searchFor | currentQueryParameter _ fragment. currentQuery _ #selectorName. searchFor _ fragment asString asLowercase withBlanksTrimmed. aList _ targetClass allSelectorsUnderstood select: [:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. searchFor size > 0 ifTrue: [aList _ aList select: [:aSelector | aSelector includesSubstring: searchFor caseSensitive: false]]. ^ aList asSortedArray ! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 18:58'! obtainNewSearchString "Put up a box allowing the user to enter a fresh search string" | fragment | fragment _ FillInTheBlank request: 'type method name or fragment: ' initialAnswer: self currentQueryParameter. fragment ifNil: [^ self]. (fragment _ fragment copyWithout: $ ) size == 0 ifTrue: [^ self]. currentQueryParameter _ fragment. fragment _ fragment asLowercase. currentQuery _ #selectorName. self categoryListIndex: (categoryList indexOf: self class queryCategoryName). self messageListIndex: 0! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 12:13'! selectorsMatching "Anwer a list of selectors in the receiver that match the current search string" | fragment aList | fragment _ self lastSearchString asLowercase. aList _ targetClass allSelectorsUnderstood select: [:aSelector | (aSelector includesSubstring: fragment caseSensitive: false) and: [currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]]. ^ aList asSortedArray! ! !Lexicon methodsFor: 'search' stamp: 'sw 3/20/2001 18:56'! setMethodListFromSearchString "Set the method list of the receiver based on matches from the search string" | fragment aList | self okToChange ifFalse: [^ self]. fragment _ currentQueryParameter. fragment _ fragment asString asLowercase withBlanksTrimmed. aList _ targetClass allSelectorsUnderstood select: [:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. fragment size > 0 ifTrue: [aList _ aList select: [:aSelector | aSelector includesSubstring: fragment caseSensitive: false]]. aList size == 0 ifTrue: [^ self beep]. self initListFrom: aList asSortedArray highlighting: targetClass. messageListIndex _ messageListIndex min: messageList size. self changed: #messageList ! ! !Lexicon methodsFor: 'search' stamp: 'sw 12/18/2000 16:40'! showSearchPane "Given that the receiver is showing the categories pane, replace that with a search pane. Though there is a residual UI for obtaining this variant, it is obscure and the integrity of the protocol-category-browser when there is no categories pane is not necessarily assured at the moment." | aPane | (aPane _ self categoriesPane) ifNil: [^ self beep]. self containingWindow replacePane: aPane with: self newSearchPane. categoryList _ nil. self changed: #categoryList. self changed: #messageList! ! !Lexicon methodsFor: 'search' stamp: 'sw 12/11/2000 14:46'! toggleSearch "Toggle the determination of whether a categories pane or a search pane shows" self hasSearchPane ifTrue: [self showCategoriesPane] ifFalse: [self showSearchPane]! ! !Lexicon methodsFor: 'selection' stamp: 'sw 12/14/2000 17:38'! categoryOfSelector: aSelector "Answer the name of the defining category for aSelector, or nil if none" | classDefiningSelector | classDefiningSelector _ targetClass classThatUnderstands: aSelector. classDefiningSelector ifNil: [^ nil]. "can happen for example if one issues this from a change-sorter for a message that is recorded as having been removed" ^ classDefiningSelector whichCategoryIncludesSelector: aSelector! ! !Lexicon methodsFor: 'selection' stamp: 'sw 3/20/2001 12:12'! selectImplementedMessageAndEvaluate: aBlock "Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector. If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any. In this variant, only selectors " | selector method messages | (selector _ self selectedMessageName) ifNil: [^ self]. method _ (self selectedClassOrMetaClass ifNil: [^ self]) compiledMethodAt: selector ifAbsent: []. (method isNil or: [(messages _ method messages) size == 0]) ifTrue: [^ aBlock value: selector]. (messages size == 1 and: [messages includes: selector]) ifTrue: [^ aBlock value: selector]. "If only one item, there is no choice" messages _ messages select: [:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. Smalltalk showMenuOf: messages withFirstItem: selector ifChosenDo: [:sel | aBlock value: sel]! ! !Lexicon methodsFor: 'selection' stamp: 'sw 3/19/2001 12:14'! selectSelectorItsNaturalCategory: aSelector "Make aSelector be the current selection of the receiver, with the category being its home category." | cat catIndex detectedItem | cat _ self categoryOfSelector: aSelector. catIndex _ categoryList indexOf: cat ifAbsent: ["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category" 1]. self categoryListIndex: catIndex. detectedItem _ messageList detect: [:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self]. self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! ! !Lexicon methodsFor: 'selection' stamp: 'sw 12/14/2000 13:48'! selectWithinCurrentCategory: aSelector "If aSelector is one of the selectors seen in the current category, select it" | detectedItem | detectedItem _ self messageList detect: [:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self]. self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! ! !Lexicon methodsFor: 'selection' stamp: 'sw 12/11/2000 10:13'! selectedMessage "Answer the source method for the currently selected message." | source | (categoryList notNil and: [(categoryListIndex isNil or: [categoryListIndex == 0])]) ifTrue: [^ '---']. self setClassAndSelectorIn: [:class :selector | class ifNil: [^ 'here would go the documentation for the protocol category, if any.']. source _ class sourceMethodAt: selector ifAbsent: [currentCompiledMethod _ nil. ^ 'Missing']. currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: [nil]. self showingDocumentation ifTrue: [^ self commentContents]. Preferences browseWithPrettyPrint ifTrue: [source _ class compilerClass new format: source in: class notifying: nil decorated: Preferences colorWhenPrettyPrinting]. self showDiffs ifTrue: [source _ self diffFromPriorSourceFor: source]. ^ source asText makeSelectorBoldIn: class]! ! !Lexicon methodsFor: 'selection' stamp: 'sw 1/26/2001 19:42'! setToShowSelector: aSelector "Set up the receiver so that it will show the given selector" | catName catIndex detectedItem messageIndex aList | catName _ (aList _ currentVocabulary categoriesContaining: aSelector forClass: targetClass) size > 0 ifTrue: [aList first] ifFalse: [self class allCategoryName]. catIndex _ categoryList indexOf: catName ifAbsent: [1]. self categoryListIndex: catIndex. detectedItem _ messageList detect: [:anItem | (anItem upTo: $ ) asString asSymbol == aSelector] ifNone: [^ self]. messageIndex _ messageList indexOf: detectedItem. self messageListIndex: messageIndex ! ! !Lexicon methodsFor: 'senders' stamp: 'sw 3/20/2001 12:10'! navigateToASender "Present the user with a list of senders of the currently-selected message, and navigate to the chosen one" | allCalls selectorSet chosen aSelector | aSelector _ self selectedMessageName. allCalls _ Smalltalk allCallsOn: aSelector. selectorSet _ Set new. allCalls do: [:anItem | MessageSet parse: anItem toClassAndSelector: [:cl :sel | selectorSet add: sel]]. selectorSet _ selectorSet select: [:sel | currentVocabulary includesSelector: sel forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. selectorSet size == 0 ifTrue: [^ self beep]. self okToChange ifFalse: [^ self]. chosen _ (SelectionMenu selections: selectorSet asSortedArray) startUp. chosen isEmptyOrNil ifFalse: [self displaySelector: chosen]! ! !Lexicon methodsFor: 'senders' stamp: 'sw 3/20/2001 12:13'! selectorsSendingSelectedSelector "Assumes lastSendersSearchSelector is already set" | allCalls selectorSet | autoSelectString _ (self lastSendersSearchSelector upTo: $:) asString. allCalls _ Smalltalk allCallsOn: self lastSendersSearchSelector. selectorSet _ Set new. allCalls do: [:anItem | MessageSet parse: anItem toClassAndSelector: [:cl :sel | ((currentVocabulary includesSelector: sel forInstance: self targetObject ofClass: targetClass limitClass: limitClass) and: [targetClass includesBehavior: cl]) ifTrue: [selectorSet add: sel]]]. ^ selectorSet asSortedArray! ! !Lexicon methodsFor: 'senders' stamp: 'sw 3/20/2001 19:46'! setSendersSearch "Put up a list of messages sent in the current message, find all methods of the browsee which send the one the user chooses, and show that list in the message-list pane, with the 'query results' item selected in the category-list pane" | allCalls selectorSet aSelector aString | self selectedMessageName ifNil: [aString _ FillInTheBlank request: 'Type selector to search for' initialAnswer: 'flag:'. aString isEmptyOrNil ifTrue: [^ self]. Symbol hasInterned: aString ifTrue: [:sel | aSelector _ sel]] ifNotNil: [self selectMessageAndEvaluate: [:sel | aSelector _ sel]]. aSelector ifNil: [^ self]. allCalls _ Smalltalk allCallsOn: aSelector. selectorSet _ Set new. allCalls do: [:anItem | MessageSet parse: anItem toClassAndSelector: [:cl :sel | selectorSet add: sel]]. selectorSet _ selectorSet select: [:sel | currentVocabulary includesSelector: sel forInstance: self targetObject ofClass: targetClass limitClass: limitClass]. selectorSet size > 0 ifTrue: [currentQuery _ #senders. currentQueryParameter _ aSelector. self categoryListIndex: (categoryList indexOf: self class queryCategoryName). self messageListIndex: 0]! ! !Lexicon methodsFor: 'transition' stamp: 'sw 3/20/2001 12:11'! maybeReselectClass: aClass selector: aSelector "The protocol or limitClass may have changed, so that there is a different categoryList. Formerly, the given class and selector were selected; if it is possible to do so, reselect them now" aClass ifNil: [^ self]. (currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass) ifTrue: [self selectSelectorItsNaturalCategory: aSelector]! ! !Lexicon methodsFor: 'transition' stamp: 'sw 3/20/2001 00:41'! noteAcceptanceOfCodeFor: newSelector "The user has submitted new code for the given selector; take a note of it. NB that the selectors-changed list gets added to here, but is not currently used in the system." (self selectorsVisited includes: newSelector) ifFalse: [selectorsVisited add: newSelector].! ! !Lexicon methodsFor: 'transition' stamp: 'sw 12/11/2000 14:46'! preserveSelectorIfPossibleSurrounding: aBlock "Make a note of the currently-selected method; perform aBlock and then attempt to reestablish that same method as the selected one in the new circumstances" | aClass aSelector | aClass _ self selectedClassOrMetaClass. aSelector _ self selectedMessageName. aBlock value. self hasSearchPane ifTrue: [self setMethodListFromSearchString] ifFalse: [self maybeReselectClass: aClass selector: aSelector]! ! !Lexicon methodsFor: 'transition' stamp: 'sw 12/11/2000 02:00'! reformulateList "Make the category list afresh, and reselect the current selector if appropriate" self preserveSelectorIfPossibleSurrounding: [super reformulateList. self categoryListIndex: categoryListIndex]! ! !Lexicon methodsFor: 'transition' stamp: 'sw 1/12/2001 00:33'! reformulateListNoting: newSelector "A method has possibly been submitted for the receiver with newSelector as its selector; If the receiver has a way of reformulating its message list, here is a chance for it to do so" super reformulateListNoting: newSelector. newSelector ifNotNil: [self displaySelector: newSelector]! ! !Lexicon methodsFor: 'transition' stamp: 'sw 12/19/2000 18:27'! retainMethodSelectionWhileSwitchingToCategory: aCategoryName "retain method selection while switching the category-pane selection to show the category of the given name" | aSelectedName | aSelectedName _ self selectedMessageName. self categoryListIndex: (categoryList indexOf: aCategoryName ifAbsent: [^ self]). aSelectedName ifNotNil: [self selectWithinCurrentCategory: aSelectedName] ! ! !Lexicon methodsFor: 'vocabulary' stamp: 'sw 1/26/2001 19:48'! chooseVocabulary "Put up a dialog affording the user a chance to choose a different vocabulary to be installed in the receiver" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: 'Choose a vocabulary blue = current red = imperfect'. aMenu addStayUpItem. Vocabulary allVocabularies do: [:aVocabulary | (targetClass implementsVocabulary: aVocabulary) ifTrue: [aMenu add: aVocabulary vocabularyName selector: #switchToVocabulary: argument: aVocabulary. (targetClass fullyImplementsVocabulary: aVocabulary) ifFalse: [aMenu lastItem color: Color red]. aVocabulary == currentVocabulary ifTrue: [aMenu lastItem color: Color blue]. aMenu balloonTextForLastItem: aVocabulary documentation]]. aMenu popUpInWorld: self currentWorld! ! !Lexicon methodsFor: 'vocabulary' stamp: 'sw 1/26/2001 19:45'! currentVocabularyString "Answer a string representing the receiver's current protocol" ^ currentVocabulary vocabularyName! ! !Lexicon methodsFor: 'vocabulary' stamp: 'sw 1/26/2001 19:40'! switchToVocabulary: aVocabulary "Make aVocabulary be the current one in the receiver" self preserveSelectorIfPossibleSurrounding: [self useVocabulary: aVocabulary. self reformulateCategoryList. self adjustWindowTitle] ! ! !Lexicon methodsFor: 'vocabulary' stamp: 'sw 1/26/2001 19:37'! useVocabulary: aVocabulary "Set up the receiver to use the given vocabulary" currentVocabulary _ aVocabulary! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 18:59'! currentQueryParameter "Answer the current query parameter" ^ currentQueryParameter ifNil: [currentQueryParameter _ 'contents']! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 21:00'! queryCharacterization "Answer a characterization of the most recent query" currentQuery == #selectorName ifTrue: [^ 'All methods whose names include "', self lastSearchString, '"']. currentQuery == #senders ifTrue: [^ 'All methods that send #', self lastSendersSearchSelector]. currentQuery == #currentChangeSet ifTrue: [^ 'Methods in the current change set']. currentQuery == #instVarRefs ifTrue: [^ 'Methods that refer to instance variable "', currentQueryParameter, '"']. currentQuery == #instVarDefs ifTrue: [^ 'Methods that store into instance variable "', currentQueryParameter, '"']. currentQuery == #classVarRefs ifTrue: [^ 'Methods that refer to class variable "', currentQueryParameter, '"']. ^ 'Results of queries will show up here'! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 12:11'! seeAlso "Present a menu offering the selector of the currently selected message, as well as of all messages sent by it. If the chosen selector is showable in the current browser, show it here, minding unsubmitted edits however" self selectImplementedMessageAndEvaluate: [:aSelector | ((currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass) "i.e., is this aSelector available in this browser" and: [self okToChange]) ifTrue: [self displaySelector: aSelector] ifFalse: [self beep. "Smalltalk browseAllImplementorsOf: aSelector"]]. "Initially I tried making this open an external implementors browser in this case, but later decided that the user model for this was unstable"! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 12:13'! seeAlso: aSelector "If the requested selector is showable in the current browser, show it here, minding unsubmitted edits however" ((currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass) "i.e., is aSelector available in this browser" and: [self okToChange]) ifTrue: [self displaySelector: aSelector] ifFalse: [self beep]! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 12:11'! selectorsChanged "Return a list of methods in the current change set (or satisfying some other such criterion) that are in the protocol of this object" | aList aClass targetedClass | targetedClass _ self targetObject ifNotNil: [self targetObject class] ifNil: [targetClass]. aList _ OrderedCollection new. Smalltalk changes methodChanges associationsDo: [:classChgAssoc | classChgAssoc value associationsDo: [:methodChgAssoc | (methodChgAssoc value == #change or: [methodChgAssoc value == #add]) ifTrue: [(aClass _ targetedClass classThatUnderstands: methodChgAssoc key) ifNotNil: [(aClass name = classChgAssoc key) ifTrue: [aList add: methodChgAssoc key]]]]]. ^ aList! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:22'! selectorsDefiningInstVar "Return a list of methods that define a given inst var that are in the protocol of this object" | aList | aList _ OrderedCollection new. targetClass withAllSuperclassesDo: [:aClass | (aClass whichSelectorsStoreInto: currentQueryParameter asString) do: [:sel | sel ~~ #DoIt ifTrue: [aList add: sel]]]. ^ aList! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 21:10'! selectorsReferringToClassVar "Return a list of methods that refer to given class var that are in the protocol of this object" | aList aClass | aClass _ targetClass classThatDefinesClassVariable: currentQueryParameter. aList _ OrderedCollection new. (Smalltalk allCallsOn: (aClass classPool associationAt: currentQueryParameter asSymbol)) do: [:elem | MessageSet parse: elem toClassAndSelector: [:cl :sel | (targetClass isKindOf: cl class) ifTrue: [aList add: sel]]]. ^ aList! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:14'! selectorsReferringToInstVar "Return a list of methods that refer to a given inst var that are in the protocol of this object" | aList | aList _ OrderedCollection new. targetClass withAllSuperclassesDo: [:aClass | (aClass whichSelectorsAccess: currentQueryParameter asString) do: [:sel | sel ~~ #DoIt ifTrue: [aList add: sel]]]. ^ aList! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:02'! selectorsRetrieved "Anwer a list of selectors in the receiver that have been retrieved for the query category" currentQuery == #senders ifTrue: [^ self selectorsSendingSelectedSelector]. currentQuery == #selectorName ifTrue: [^ self selectorsMatching]. currentQuery == #currentChangeSet ifTrue: [^ self selectorsChanged]. currentQuery == #instVarRefs ifTrue: [^ self selectorsReferringToInstVar]. currentQuery == #instVarDefs ifTrue: [^ self selectorsDefiningInstVar]. currentQuery == #classVarRefs ifTrue: [^ self selectorsReferringToClassVar]. currentQuery == #myInitials ifTrue: [^ self selectorsAuthoredByMe]. ^ #()! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:41'! setLocalClassVarRefs "Put up a list of the class variables in the viewed object, and when the user selects one, let the query results category show all the references to that class variable." | aName | (aName _ targetClass chooseClassVarName) ifNil: [^ self]. currentQuery _ #classVarRefs. currentQueryParameter _ aName. self showQueryResultsCategory! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:21'! setLocalInstVarDefs "Put up a list of the instance variables in the viewed object, and when the user seletcts one, let the query results category show all the references to that instance variable." | instVarToProbe | targetClass chooseInstVarThenDo: [:aName | instVarToProbe _ aName]. instVarToProbe isEmptyOrNil ifTrue: [^ self]. currentQuery _ #instVarDefs. currentQueryParameter _ instVarToProbe. self showQueryResultsCategory! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:16'! setLocalInstVarRefs "Put up a list of the instance variables in the viewed object, and when the user seletcts one, let the query results category show all the references to that instance variable." | instVarToProbe | targetClass chooseInstVarThenDo: [:aName | instVarToProbe _ aName]. instVarToProbe isEmptyOrNil ifTrue: [^ self]. currentQuery _ #instVarRefs. currentQueryParameter _ instVarToProbe. self showQueryResultsCategory! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/19/2001 09:39'! showMethodsInCurrentChangeSet "Set the current query to be for methods in the current change set" currentQuery _ #currentChangeSet. self categoryListIndex: (categoryList indexOf: self class queryCategoryName). self messageListIndex: 0! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sw 3/20/2001 20:16'! showQueryResultsCategory "Point the receiver at the query-results category and set the search string accordingly" autoSelectString _ self currentQueryParameter. self categoryListIndex: (categoryList indexOf: self class queryCategoryName). self messageListIndex: 0! ! !Lexicon methodsFor: 'window title' stamp: 'sw 3/19/2001 08:45'! addModelItemsToWindowMenu: aMenu "Add model-related item to the window menu" super addModelItemsToWindowMenu: aMenu. aMenu add: 'choose vocabulary...' target: self action: #chooseVocabulary! ! !Lexicon methodsFor: 'window title' stamp: 'sw 3/20/2001 16:42'! adjustWindowTitle "Set the title of the receiver's window, if any, to reflect the current choices" | aWindow aLabel catName | (catName _ self selectedCategoryName) ifNil: [^ self]. (aWindow _ self containingWindow) ifNil: [^ self]. aLabel _ nil. #( (viewedCategoryName 'Messages already viewed - ') (allCategoryName 'All messages - ')) do: [:aPair | catName = (self categoryWithNameSpecifiedBy: aPair first) ifTrue: [aLabel _ aPair second]]. aLabel ifNil: [aLabel _ catName = self class queryCategoryName ifTrue: [self queryCharacterization, ' - '] ifFalse: ['Vocabulary of ']]. aWindow setLabel: aLabel, (self targetObject ifNil: [targetClass]) nameForViewer! ! !Lexicon methodsFor: 'window title' stamp: 'sw 3/20/2001 12:18'! startingWindowTitle "Answer the initial window title to apply" ^ 'Vocabulary of ', targetClass nameForViewer! ! !InstanceBrowser methodsFor: 'initialization' stamp: 'sw 3/20/2001 13:03'! defaultBackgroundColor "Answer the default background color for the window" ^ (Color r: 0.935 g: 0.430 b: 0.839) lighter lighter "Color fromUser " "23 haveFullProtocolBrowsed"! ! !InstanceBrowser methodsFor: 'initialization' stamp: 'sw 3/20/2001 12:16'! openOnObject: anObject inWorld: aWorld showingSelector: aSelector "Create and open a SystemWindow to house the receiver, showing the categories pane." objectViewed _ anObject. self openOnClass: anObject class inWorld: aWorld showingSelector: aSelector! ! !InstanceBrowser methodsFor: 'menu commands' stamp: 'sw 3/20/2001 13:20'! inspectViewee "Open an Inspector on the object I view" objectViewed inspect! ! !InstanceBrowser methodsFor: 'menu commands' stamp: 'sw 3/20/2001 16:39'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. aMenu addList: #( ('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) "('toggle search pane' toggleSearch)" - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('inst var refs' browseInstVarRefs) ('inst var defs' browseInstVarDefs) ('class var refs' browseClassVarRefs) - ('viewer on me' viewViewee) ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). aMenu popUpInWorld: ActiveWorld! ! !InstanceBrowser methodsFor: 'menu commands' stamp: 'sw 3/20/2001 13:19'! viewViewee "Open a viewer on the object I view" objectViewed beViewed! ! !InstanceBrowser methodsFor: 'target-object access' stamp: 'sw 3/20/2001 12:10'! objectViewed: anObject "Set the receiver's objectViewed" objectViewed _ anObject! ! !InstanceBrowser methodsFor: 'target-object access' stamp: 'sw 3/20/2001 12:10'! targetObject "Answer the object to which this tool is bound" ^ objectViewed! ! !InstanceBrowser methodsFor: 'window title' stamp: 'sw 3/20/2001 12:18'! startingWindowTitle "Answer the initial window title to apply" ^ 'Vocabulary of ', objectViewed nameForViewer! ! !Lexicon class methodsFor: 'visible category names' stamp: 'sw 12/14/2000 14:15'! activeCategoryName "Answer the name to be used for the active-methods category" true ifTrue: [^ #'-- current working set --']. '-- current working set --' asSymbol "Placed here so a message-strings-containing-it query will find this method" ! ! !Lexicon class methodsFor: 'visible category names' stamp: 'sw 12/13/2000 10:56'! allCategoryName "Answer the name to be used for the all category" true ifTrue: [^ #'-- all --']. '-- all --' asSymbol "Placed here so a message-strings-containing-it query will find this method" ! ! !Lexicon class methodsFor: 'visible category names' stamp: 'sw 3/19/2001 08:17'! queryCategoryName "Answer the name to be used for the query-results category" true ifTrue: [^ #'-- query results --']. ^ '-- query results --' asSymbol "Placed here so a message-strings-containing-it query will find this method"! ! !Lexicon class methodsFor: 'visible category names' stamp: 'sw 12/13/2000 10:54'! sendersCategoryName "Answer the name to be used for the senders-results category" true ifTrue: [^ #'-- "senders" results --']. ^ '-- "senders" results --'. "so methods-strings-containing will find this"! ! !Lexicon class methodsFor: 'visible category names' stamp: 'sw 3/19/2001 08:03'! viewedCategoryName "Answer the name to be used for the previously-viewed-methods category" true ifTrue: [^ #'-- active --']. ^ '-- active --' asSymbol "For benefit of method-strings-containing-it search" ! ! Lexicon class removeSelector: #changedCategoryName! Lexicon class removeSelector: #searchCategoryName! !InstanceBrowser reorganize! ('initialization' defaultBackgroundColor openOnObject:inWorld:showingSelector:) ('menu commands' inspectViewee offerMenu viewViewee) ('target-object access' objectViewed: targetObject) ('window title' startingWindowTitle) ! Lexicon removeSelector: #addToActiveSet! Lexicon removeSelector: #addToActiveSet:! Lexicon removeSelector: #openOnClass:targetObject:inWorld:showingSelector:! Lexicon removeSelector: #removeFromActiveSet! Lexicon removeSelector: #removeFromActiveSet:! Lexicon removeSelector: #selectSelector:! Lexicon removeSelector: #selectorsActive! !Lexicon reorganize! ('initialization' defaultBackgroundColor initListFrom:highlighting: openOnClass:inWorld:showingSelector: openWithSearchPaneOn:inWorld: wantsAnnotationPane wantsOptionalButtons windowWithLabel:) ('basic operation' annotation displaySelector: messageListIndex:) ('category list' categoriesPane categoryDefiningSelector: categoryList categoryListIndex categoryListIndex: categoryListKey:from: categoryListMenu:shifted: categoryListMenuTitle categoryWithNameSpecifiedBy: chooseCategory: newCategoryPane reformulateCategoryList selectWithinCurrentCategoryIfPossible: selectedCategoryName showCategoriesPane) ('control buttons' chooseVocabularyButton decorateButtons homeCategoryButton mostGenericButton optionalButtonPairs optionalButtonRow searchToggleButton) ('history' navigateToNextMethod navigateToPreviousMethod navigateToRecentMethod removeFromSelectorsVisited removeFromSelectorsVisited: selectorsVisited updateSelectorsVisitedfrom:to:) ('limit class' chooseLimitClass limitClass limitClass: limitClassString setLimitClass:) ('model glue' doItReceiver okayToAccept targetObject) ('menu commands' offerMenu removeMessage showMainCategory) ('new-window queries' browseClassVarRefs browseInstVarDefs browseInstVarRefs) ('search' hasSearchPane lastSearchString lastSearchString: lastSendersSearchSelector methodListFromSearchString: obtainNewSearchString selectorsMatching setMethodListFromSearchString showSearchPane toggleSearch) ('selection' categoryOfSelector: selectImplementedMessageAndEvaluate: selectSelectorItsNaturalCategory: selectWithinCurrentCategory: selectedMessage setToShowSelector:) ('senders' navigateToASender selectorsSendingSelectedSelector setSendersSearch) ('transition' maybeReselectClass:selector: noteAcceptanceOfCodeFor: preserveSelectorIfPossibleSurrounding: reformulateList reformulateListNoting: retainMethodSelectionWhileSwitchingToCategory:) ('vocabulary' chooseVocabulary currentVocabularyString switchToVocabulary: useVocabulary:) ('within-tool queries' currentQueryParameter queryCharacterization seeAlso seeAlso: selectorsChanged selectorsDefiningInstVar selectorsReferringToClassVar selectorsReferringToInstVar selectorsRetrieved setLocalClassVarRefs setLocalInstVarDefs setLocalInstVarRefs showMethodsInCurrentChangeSet showQueryResultsCategory) ('window title' addModelItemsToWindowMenu: adjustWindowTitle desiredWindowLabelHeightIn: startingWindowTitle) ! ProtocolBrowser removeSelector: #selectedClass! ProtocolBrowser removeSelector: #selectedClass:!