'From Squeak6.0alpha of 16 October 2017 [latest update: #17429] on 20 October 2017 at 5:37:50 pm'! "Change Set: Browser spec changes Date: 20 October 2017 Author: tim@rowledge.org Changes to improve the Browser creation/building process"! !ClassListBrowser commentStamp: 'tpr 10/15/2017 16:46' prior: 0! A ClassListBrowser displays the code for an arbitrary list of classes. ClassListBrowser example1. "all classes that have the string 'Pluggable' in their names" ClassListBrowser example2. "all classes whose names start with the letter S" ClassListBrowser example3. "all variable classes" ClassListBrowser example4. "all classes with more than 100 methods" ClassListBrowser example5. "all classes that lack class comments" ClassListBrowser example6. "all classes that have class instance variables" ClassListBrowser newOnClassesNamed: #(Browser Boolean) label: 'Browser and Boolean!!'. ClassListBrowser newOnAllClasses "all classes listed alphabetically" ! !SelectorBrowser commentStamp: 'tpr 10/15/2017 16:42' prior: 0! A SelectorBrowser is more commonly referred to as the method finder; you can enter message names or more interestingly, example inputs and results to have the system try to find plausible methods that would satisfy the parameters. See SelectorBrowser>>#byExample for much more detail.! !CodeHolder methodsFor: 'commands' stamp: 'tpr 10/13/2017 11:00'! spawn: aString "Create and schedule a spawned message category browser for the currently selected message category. The initial text view contains the characters in aString. In the spawned browser, preselect the current selector (if any) as the going-in assumption, though upon acceptance this will often change" | aCategory aClass | (aClass := self selectedClassOrMetaClass) isNil ifTrue: [^ aString isEmptyOrNil ifFalse: [(Workspace new contents: aString) openLabel: 'spawned workspace']]. (aCategory := self categoryOfCurrentMethod) ifNil: [self buildClassBrowserEditString: aString] ifNotNil: [self buildMessageCategoryBrowserForClass: aClass selector: self selectedMessageName editString: aString ]! ! !CodeHolder methodsFor: 'commands' stamp: 'tpr 10/13/2017 11:00'! spawnToClass: aClass "Used to copy down code from a superclass to a subclass in one easy step, if you know what you're doing. Spawns a new message-category browser for the indicated class, populating it with the source code seen in the current tool." self categoryOfCurrentMethod ifNil: [self buildClassBrowserEditString: self contents] ifNotNil: [self buildMessageCategoryBrowserForClass: aClass selector: nil editString: self contents]! ! !CodeHolder methodsFor: 'construction' stamp: 'tpr 10/12/2017 21:27'! buildClassBrowserEditString: aString "Create and schedule a new class browser for the current selection, with initial textual contents set to aString. This is used specifically in spawning where a class is established but a method-category is not." ^Browser newOnClass: self selectedClassOrMetaClass editString: aString label: 'Class Browser: ', self selectedClassOrMetaClass name ! ! !CodeHolder methodsFor: 'construction' stamp: 'tpr 10/17/2017 17:53'! buildMessageBrowserEditString: aString "Create and schedule a new message browser for the current selection, with initial textual contents set to aString." ^ Browser newOnClass: self selectedClassOrMetaClass messageCategory: self categoryOfCurrentMethod selector: self selectedMessageName editString: aString label: 'Message Browser: ' , self selectedClassOrMetaClass name , self categoryOfCurrentMethod! ! !CodeHolder methodsFor: 'construction' stamp: 'tpr 10/13/2017 19:05'! buildMessageCategoryBrowserForClass: aClass selector: aSelectorOrNil editString: aString "Create and schedule a new class browser for the current selection, with initial textual contents set to aString. This is used specifically in spawning where a class is established but a method-category is not." ^ Browser newOnClass: aClass messageCategory: self categoryOfCurrentMethod selector: aSelectorOrNil editString: aString label: 'Message category Browser: ' , self selectedClassOrMetaClass name , self categoryOfCurrentMethod! ! !Browser methodsFor: 'accessing' stamp: 'tpr 10/10/2017 11:25'! spawn: aString "Create and schedule a fresh browser and place aString in its code pane. This method is called when the user issues the #spawn command (cmd-o) in any code pane. Whatever text was in the original code pane comes in to this method as the aString argument; the changes in the original code pane have already been cancelled by the time this method is called, so aString is the only copy of what the user had in his code pane." self selectedClassOrMetaClass ifNotNil: [^ super spawn: aString]. self hasSystemCategorySelected ifTrue: ["Open a browser with the initial codepane string set" ^ self buildSystemCategoryBrowserEditString: aString]. ^ super spawn: aString "This bail-out at least saves the text being spawned, which would otherwise be lost"! ! !Browser methodsFor: 'initialize-release' stamp: 'tpr 10/17/2017 18:00'! setSelector: aSymbol "Make the receiver point at the given selector, in the currently chosen class. If the selector is found in the class organization we also set the message category to suit" | aClass | aSymbol ifNil: [^ self]. (aClass := self selectedClassOrMetaClass) ifNil: [^ self]. (aClass organization categoryOfElement: aSymbol) ifNil: [^ self] ifNotNil: [:category | self selectMessageCategoryNamed: category; selectMessageNamed: aSymbol].! ! !Browser methodsFor: 'message category functions' stamp: 'tpr 10/13/2017 18:26'! buildMessageCategoryBrowserEditString: aString "Create and schedule a new class browser for the current selection, with initial textual contents set to aString. This is used specifically in spawning where a class is established but a method-category is not." ^ self hasMessageCategorySelected ifTrue: [Browser newOnClass: self selectedClassOrMetaClass messageCategory: self selectedMessageCategoryName selector: self selectedMessageName editString: aString label: 'Message category Browser: ' , self selectedClassOrMetaClass name , self categoryOfCurrentMethod]! ! !Browser methodsFor: 'system category functions' stamp: 'tpr 10/11/2017 17:11'! browseAllClasses "Create and schedule a new browser on all classes alphabetically." ^ClassListBrowser newOnAllClasses! ! !Browser methodsFor: 'system category functions' stamp: 'tpr 10/9/2017 16:29'! buildSystemCategoryBrowser "Open a new system category browser on the selelcted category, if there is one" self hasSystemCategorySelected ifTrue: [self class newOnCategory: self selectedSystemCategory]! ! !Browser methodsFor: 'system category functions' stamp: 'tpr 10/13/2017 16:57'! buildSystemCategoryBrowserEditString: aString "Open a new system category browser on the selelcted category, if there is one" self hasSystemCategorySelected ifTrue: [self class newOnCategory: self selectedSystemCategory editString: aString label: 'Classes in category ' , self selectedSystemCategory]! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/17/2017 17:23'! buildAndOpenCategoryBrowser "assemble the spec for a system category browser, build it and open it - use the default label" ^self buildAndOpenCategoryBrowserLabel: nil ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 16:20'! buildAndOpenCategoryBrowserLabel: aLabelString "assemble the spec for a system category browser, build it and open it" | builder windowSpec | builder := ToolBuilder default. windowSpec := self buildCategoryBrowserWith: builder. aLabelString ifNotNil:[:str| windowSpec label: str]. builder open: windowSpec. ^self ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:35'! buildAndOpenClassBrowserLabel: aLabelString "assemble the spec for a class browser, build it and open it" | builder max windowSpec catPaneHeight| builder := ToolBuilder default. catPaneHeight := Preferences standardListFont height + 5 "top margin/border" + 5 "bottom margin/border". max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4]. windowSpec :=self buildWindowWith: builder specs: { (self topConstantHeightFrame: self buttonHeight fromLeft: 0 width: 0.5) -> [self buildClassListSingletonWith: builder]. (self frameOffsetFromTop: self buttonHeight fromLeft: 0 width: 0.5 bottomFraction: max) -> [self buildMessageCategoryListWith: builder]. (self topConstantHeightFrame: self buttonHeight fromLeft: 0.5 width: 0.5) -> [self buildSwitchesWith: builder]. (self frameOffsetFromTop: self buttonHeight fromLeft: 0.5 width: 0.5 bottomFraction: max) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. windowSpec label: aLabelString. builder open: windowSpec. ^self ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:04'! buildAndOpenFullBrowser "assemble the spec for a full system browser, build it and open it" | builder windowSpec | builder := ToolBuilder default. "the build-but-don't-open phase is factored out to support the prototypicalToolWindow facility" windowSpec := self buildDefaultBrowserWith: builder. builder open: windowSpec. ^self ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:35'! buildAndOpenMessageCategoryBrowserLabel: aLabelString "assemble the spec for a messasge category browser, build it and open it" | builder max windowSpec| builder := ToolBuilder default. max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4]. windowSpec :=self buildWindowWith: builder specs: { (0@0 corner: 1.0@0.08) -> [self buildMessageListCatSingletonWith: builder]. (0.0@0.08 corner: 1.0@max) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. windowSpec label: aLabelString. builder open: windowSpec. ^self ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 16:18'! buildCategoryBrowserWith: builder "assemble the spec for a system category browser, build it and return it" | max windowSpec catPaneHeight| catPaneHeight := Preferences standardListFont height + 5 "top margin/border" + 5 "bottom margin/border". max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4]. windowSpec := self buildWindowWith: builder specs: { (LayoutFrame fractions: (0@0 corner: 1.0@0) offsets: (0@0 corner: 0@catPaneHeight)) -> [self buildSystemCatListSingletonWith: builder]. ((self classListFrame: max fromTop: 0 fromLeft: 0 width: 0.333) topOffset: catPaneHeight) -> [self buildClassListWith: builder]. (self switchesFrame: max fromLeft: 0 width: 0.333) -> [self buildSwitchesWith: builder]. (LayoutFrame fractions: (0.333@0 corner: 0.666@max) offsets: (0@catPaneHeight corner: 0@0)) -> [self buildMessageCategoryListWith: builder]. (LayoutFrame fractions: (0.666@0 corner: 1@max) offsets: (0@catPaneHeight corner: 0@0)) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. ^builder build: windowSpec ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:04'! buildDefaultBrowserWith: builder "assemble the spec for a full system browser, build it and return the built but not opened morph" "this build-but-don't-open phase is factored out to support the prototypicalToolWindow facility" | max windowSpec | max := self wantsOptionalButtons ifTrue:[0.42] ifFalse:[0.5]. windowSpec := self buildWindowWith: builder specs: { (0@0 corner: 0.25@max) -> [self buildSystemCategoryListWith: builder]. (self classListFrame: max) -> [self buildClassListWith: builder]. (self switchesFrame: max) -> [self buildSwitchesWith: builder]. (0.5@0 corner: 0.75@max) -> [self buildMessageCategoryListWith: builder]. (0.75@0 corner: 1@max) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. ^builder build: windowSpec! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:05'! buildWith: builder "Create the ui for the browser" "Browser is a bit of an oddity in the ToolBuilder>build: world since the class provides several dfferent UIs rather than the one-per-class idiom of ToolBuilder. Here we are building the full browser version" ^self buildDefaultBrowserWith: builder ! ! !Browser methodsFor: 'toolbuilder' stamp: 'tpr 10/16/2017 17:55'! setMultiWindowFor: windowSpec "set the multi-window style for the windowSpec according to both the users preference and the browser's ability" (self class canUseMultiWindowBrowsers and: [self class useMultiWindowBrowsers]) ifTrue: [windowSpec multiWindowStyle: #labelButton]. ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 15:22'! fullOnClass: aClass "Open a new full browser set to class." "Browser fullOnClass: Browser" ^ self new setClass: aClass; buildAndOpenFullBrowser! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 15:22'! fullOnClass: aClass category: category "Open a new full browser set to class and message category." "Browser fullOnClass: Browser category: 'controls' " ^ self new setClass: aClass; selectMessageCategoryNamed: category; buildAndOpenFullBrowser! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 15:24'! fullOnClass: aClass selector: aSelector "Open a new full browser set to the class and selector." "Browser fullOnClass: Browser selector: #defaultWindowColor" ^ self new setClass: aClass selector: aSelector; buildAndOpenFullBrowser! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 18:10'! newOnCategory: aCategory "Open a new browser on this category" "Browser newOnCategory: 'Tools-Browser'" ^self newOnCategory: aCategory label: 'Classes in category ', aCategory ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 18:11'! newOnCategory: aCategory editString: aString label: aLabel "Open a new browser on this category (testing first for existence) with aString pre-selected in the code pane. We have to be a bit sneaky to do the string insertion since it cannot be handled until after the actual browser is built and opened" "Browser newOnCategory: 'Tools-Browser' editString: 'test string edit setup' label: 'Testing category browser with set edit string'" | newBrowser | newBrowser := self newOnCategory: aCategory label: aLabel. aString ifNotNil:[newBrowser changed: #editString with: aString]. ^ newBrowser ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 18:11'! newOnCategory: aCategory label: aLabel "Open a new browser on this category (testing first for existence)." "Browser newOnCategory: 'Tools-Browser' label: 'Testing category browser'" | newBrowser newCat | newBrowser := self new. newCat := aCategory asSymbol. (newBrowser systemCategoryList includes: newCat) ifTrue: [ newBrowser selectSystemCategory: newCat ] ifFalse: [ ^ self inform: 'No such category' ]. newBrowser buildAndOpenCategoryBrowserLabel: aLabel. ^ newBrowser ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:19'! newOnClass: aClass editString: aString label: aLabel "Open a new class browser on this class with aString pre-selected in the code pane. We have to be a bit sneaky to do the string insertion since it cannot be handled until after the actual browser is built and opened" "Browser newOnClass: Browser editString: 'test string edit setup' label: 'Testing category browser with set edit string'" | newBrowser| newBrowser := self newOnClass: aClass label: aLabel. newBrowser editSelection: #newMessage. aString ifNotNil:[newBrowser changed: #editString with: aString]. ^ newBrowser ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:18'! newOnClass: aClass label: aLabel "Open a new class browser on this class and set the label." "Browser newOnClass: Browser label: 'A specific label that I want'" | newBrowser | newBrowser := self new. newBrowser setClass: aClass. ^ newBrowser buildAndOpenClassBrowserLabel: aLabel ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/13/2017 16:51'! newOnClass: aClass messageCategory: aCategory ^ self newOnClass: aClass messageCategory: aCategory editString: nil label: 'Message Category Browser (' , aClass name, ')'.! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/13/2017 16:48'! newOnClass: aClass messageCategory: aCategory editString: aString label: aLabel "Open a new message protocol browser on this class & protocol with aString pre-selected in the code pane. We have to be a bit sneaky to do the string insertion since it cannot be handled until after the actual browser is built and opened" ^self newOnClass: aClass messageCategory: aCategory selector: nil editString: aString label: aLabel! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:24'! newOnClass: aClass messageCategory: aCategory selector: aSelector editString: aString label: aLabel "Open a new message protocol browser on this class & protocol with aString pre-selected in the code pane. We have to be a bit sneaky to do the string insertion since it cannot be handled until after the actual browser is built and opened" "Browser newOnClass: Browser messageCategory: 'controls' selector: #decorateButtons editString: 'test string edit setup' label: 'Testing class browser with set edit string'" | newBrowser| newBrowser := self new. "setting up a new browser for a specific class, category and selector requires this order of messages since the #selectMessageCategoryNamed: carefully nils the chosen selector; thus we can't use the more obvious seeming #setClass:selector: method" newBrowser setClass: aClass; selectMessageCategoryNamed: aCategory; selectMessageNamed: aSelector. newBrowser buildAndOpenMessageCategoryBrowserLabel: 'Message Category Browser (' , aClass name, ')'. aString ifNotNil:[newBrowser changed: #editString with: aString]. ^newBrowser! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:25'! newOnClass: aClass selector: aSymbol "Open a new class browser on this class." "Browser newOnClass: Browser selector: #decorateButtons" | newBrowser | newBrowser := self new. newBrowser setClass: aClass selector: aSymbol. ^ newBrowser buildAndOpenClassBrowserLabel: 'Class Browser: ', aClass name ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 15:31'! openBrowser "Open a standard system browser with the generic category/class/protocol/message lists" "Browser openBrowser" ^ self new buildAndOpenFullBrowser ! ! !Browser class methodsFor: 'instance creation' stamp: 'tpr 10/18/2017 15:08'! prototypicalToolWindow "Answer an example of myself seen in a tool window, for the benefit of parts-launching tools" ^ ToolBuilder default build: self ! ! !FileContentsBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/17/2017 17:23'! buildAndOpenBrowser "assemble the spec for a file contents browser, build it and open it" "The browser may have either the full 4-pane layout or the simpler 3-pane version, depending on whether we have 1 or more packages to look at" contentsSymbol := self defaultDiffsSymbol. "#showDiffs or #prettyDiffs" ^ self packages size = 1 ifTrue:[ self systemCategoryListIndex: 1. self buildAndOpenCategoryBrowser] ifFalse: [self buildAndOpenFullBrowser]! ! !FileContentsBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 16:21'! buildWith: builder "Depending upon whether we have a single package or multiple packages, we use different window specs. " self packages ifNil:[^self error: self class name, ' cannot be built without any packages; see class instance creation methods' ]. ^ self packages size = 1 ifTrue:[ self systemCategoryListIndex: 1; buildCategoryBrowserWith: builder] ifFalse: [super buildWith: builder]! ! !FileContentsBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/17/2017 17:24'! defaultBrowserTitle ^ 'File Contents Browser' ! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 17:24'! browseFiles: fileList "Open a browser on the packages found within the files in the list; we expect the list to contain acceptable filename strings. If there is more than one package found the browser will be a full system browser, otherwise it will be a category browser" | browser | Cursor wait showWhile: [ | organizer packageDict | packageDict := Dictionary new. organizer := SystemOrganizer defaultList: Array new. fileList do: [:fileName | | package | package := FilePackage fromFileNamed: fileName. packageDict at: package packageName put: package. organizer classifyAll: package classes keys under: package packageName]. (browser := self systemOrganizer: organizer) packages: packageDict]. ^ browser buildAndOpenBrowser ! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 17:29'! browseStream: aStream aStream setConverterForCode. self browseStream: aStream named: aStream name! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 17:26'! browseStream: aStream named: aString "Read an already opened file stream into a browser" | browser | Cursor wait showWhile: [ | package packageDict organizer | packageDict := Dictionary new. browser := self new. organizer := SystemOrganizer defaultList: Array new. package := (FilePackage new fullName: aString; fileInFrom: aStream). packageDict at: package packageName put: package. organizer classifyAll: package classes keys under: package packageName. (browser := self systemOrganizer: organizer) packages: packageDict]. ^ browser buildAndOpenBrowser ! ! !HierarchyBrowser methodsFor: 'class list' stamp: 'tpr 10/13/2017 16:33'! classList "each time we update the class list make sure to check that all the classes we think we should display are in fact in the environment" classDisplayList := classDisplayList select: [:each | (self environment valueOf: each withBlanksTrimmed asSymbol) notNil]. ^ classDisplayList! ! !HierarchyBrowser methodsFor: 'menu messages' stamp: 'tpr 10/10/2017 10:07'! buildClassBrowserEditString: aString "Open a hierarchy browser on the currently selected class; the string has to be ignored in this case" self spawnHierarchy! ! !HierarchyBrowser methodsFor: 'menu messages' stamp: 'tpr 10/15/2017 17:13'! systemCatSingletonKey: aChar from: aView "This appears to be obsolete now that the hierarchybrowser has not category view" ^ self systemCatListKey: aChar from: aView! ! !HierarchyBrowser methodsFor: 'menu messages' stamp: 'tpr 10/15/2017 17:13'! systemCatSingletonMenu: aMenu "This appears to be obsolete now that the hierarchybrowser has not category view" ^ aMenu labels: 'find class... (f) browse printOut fileOut update rename... remove' lines: #(1 4) selections: #(findClass buildSystemCategoryBrowser printOutSystemCategory fileOutSystemCategory updateSystemCategories renameSystemCategory removeSystemCategory ) ! ! !HierarchyBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:12'! buildAndOpenBrowserLabel: aLabelString "assemble the spec for a class list/hierarchy browser, build it and open it" | builder windowSpec | builder := ToolBuilder default. windowSpec := self buildDefaultBrowserWith: builder. aLabelString ifNotNil:[:str| windowSpec label: str]. builder open: windowSpec. ^self ! ! !HierarchyBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:45'! buildDefaultBrowserWith: builder "assemble the spec for a hierarchical browser, build it and return the built but not opened morph" "this build-but-don't-open phase is factored out to support the prototypicalToolWindow facility" | max windowSpec | self setupIfNotInitialisedYet. max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4]. windowSpec := self buildWindowWith: builder specs: { (self classListFrame: max fromTop: 0 fromLeft: 0 width: 0.333) -> [self buildClassListWith: builder]. (self switchesFrame: max fromLeft: 0 width: 0.333) -> [self buildSwitchesWith: builder]. (LayoutFrame fractions: (0.333@0 corner: 0.666@max) offsets: (0@0 corner: 0@0)) -> [self buildMessageCategoryListWith: builder]. (LayoutFrame fractions: (0.666@0 corner: 1@max) offsets: (0@0 corner: 0@0)) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. ^builder build: windowSpec! ! !HierarchyBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 16:39'! setupIfNotInitialisedYet "HierarchyBrowser needs some initialisation to work in the ToolBuilder>build: world since there has to be a list of classes ready to be listed. As a default we use the full Object class tree" classDisplayList ifNil:[ self initHierarchyForClass: Object]! ! !HierarchyBrowser methodsFor: 'multi-window support' stamp: 'tpr 10/15/2017 17:15'! isHierarchy "This almost certainly needs implementing in ClassListBrowser to return false" ^true! ! !ClassListBrowser methodsFor: 'initialization' stamp: 'tpr 10/17/2017 17:16'! defaultBrowserTitle ^ 'Class List Browser' ! ! !ClassListBrowser methodsFor: 'initialization' stamp: 'fbs 3/9/2011 11:42'! initAlphabeticListing | tab stab index | self systemOrganizer: SystemOrganization. metaClassIndicated := false. classDisplayList := Smalltalk classNames.! ! !ClassListBrowser methodsFor: 'initialization' stamp: 'tpr 10/12/2017 14:32'! initForClassesNamed: nameList "Initialize the receiver for the class-name-list" self systemOrganizer: SystemOrganization. metaClassIndicated := false. classDisplayList := nameList copy! ! !ClassListBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 16:40'! setupIfNotInitialisedYet "ClassListBrowser needs some initialisation to work in the ToolBuilder>build: world since there has to be a list of classes ready to be listed. As a default we use the full list of classes in the system" classDisplayList ifNil:[self initAlphabeticListing]! ! !HierarchyBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:37'! openBrowser "Open a default hierarchy browser on Object - ie the entire class tree, so it may take a moment - with class/protocol/message lists" "HierarchyBrowser openBrowser" | newBrowser | newBrowser := self new initHierarchyForClass: Object. ^ newBrowser buildAndOpenBrowserLabel: nil ! ! !ClassListBrowser class methodsFor: 'examples' stamp: 'tpr 10/12/2017 14:43'! example2 "Put up a ClassListBrowser that shows all classes whose names start with the letter S" self newOnClassesNamed: (self systemNavigation allClasses collect: [:c | c name] thenSelect: [:aName | aName first == $S]) label: 'All classes starting with S' "ClassListBrowser example2"! ! !ClassListBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/12/2017 14:39'! browseClassesSatisfying: classBlock title: aTitle "Put up a ClassListBrowser showing all classes that satisfy the classBlock." self newOnClassesNamed: (self systemNavigation allClasses select: [:c | (classBlock value: c) == true] thenCollect: [:c | c name]) label: aTitle! ! !ClassListBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/18/2017 15:47'! newOnAllClasses "Open a browser on all the classes in the system, listed alphabetically" "NB - what meaning does 'all classes' have in an environment that is not the root? - what might alphabetic ordering need to do for non-latin languages?" "ClassListBrowser newOnAllClasses" | newBrowser | newBrowser := self new. ^ newBrowser buildAndOpenBrowserLabel: 'All Classes Alphabetically' ! ! !ClassListBrowser class methodsFor: 'instance creation' stamp: 'tpr 10/17/2017 16:33'! newOnClassesNamed: aListOfClassNames label: aString "Open a browser on all the classes in the list, set the label to aString since we may need to specify to the user what the list includes" "ClassListBrowser newOnClassesNamed: #(Browser Boolean) label: 'Browser and Boolean!!'." | newBrowser | newBrowser := self new. newBrowser initForClassesNamed: aListOfClassNames. ^ newBrowser buildAndOpenBrowserLabel: aString ! ! !PackagePaneBrowser methodsFor: 'toolbuilder' stamp: 'tpr 10/18/2017 15:36'! buildDefaultBrowserWith: builder "assemble the spec for a full 5-pane browser - package, category, class, protocol & message lists, build it and return the built but not opened morph. the build-but-don't-open phase is factored out to support the prototypicalToolWindow facility" "PackagePaneBrowser fullOnClass: Browser." | max windowSpec | max := self wantsOptionalButtons ifTrue:[0.42] ifFalse:[0.5]. windowSpec := self buildWindowWith: builder specs: { (0@0 corner: 0.15@max) -> [self buildPackageListWith: builder]. (0.15@0 corner: 0.35@max) -> [self buildSystemCategoryListWith: builder]. (self classListFrame: max fromLeft: 0.35 width: 0.25) -> [self buildClassListWith: builder]. (self switchesFrame: max fromLeft: 0.35 width: 0.25) -> [self buildSwitchesWith: builder]. (0.6@0 corner: 0.75@max) -> [self buildMessageCategoryListWith: builder]. (0.75@0 corner: 1@max) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. self setMultiWindowFor:windowSpec. ^builder build: windowSpec! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'tpr 10/9/2017 15:31'! browseClassFromIt "Launch a browser for the class indicated by the current selection. If multiple classes matching the selection exist, let the user choose among them." | aClass | self lineSelectAndEmptyCheck: [^ self]. aClass := UIManager default classFromPattern: self selection string withCaption: 'choose a class to browse...'. aClass ifNil: [^ view flash]. self terminateAndInitializeAround: [ToolSet browseClass: aClass].! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'tpr 10/9/2017 15:49'! browseIt "Launch a browser for the current selection, if appropriate" | aSymbol | self flag: #yoCharCases. Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. (aSymbol := self selectedSymbol) isNil ifTrue: [^ view flash]. self terminateAndInitializeAround: [aSymbol first isUppercase ifTrue: [| anEntry | anEntry := (Smalltalk at: aSymbol ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry isNil ifTrue: [^ view flash]. (anEntry isBehavior or: [ anEntry isTrait ]) ifFalse: [ anEntry := anEntry class ]. "more confusion here; prior version was using SystemBrowser default here and yet the rest of the method is going via systemNaviagation" ToolSet browse: anEntry selector: nil. ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]]! ! !StandardToolSet class methodsFor: 'browsing' stamp: 'tpr 10/13/2017 16:52'! browseMessageCategory: aCategory inClass: aClass "Open a message category browser." ^ SystemBrowser default newOnClass: aClass messageCategory: aCategory! ! !StandardToolSet class methodsFor: 'browsing' stamp: 'tpr 10/13/2017 16:30'! openClassListBrowser: anArray title: aString "Open a class list browser on the list of classes named" ^ClassListBrowser newOnClassesNamed: anArray label: aString ! ! !SystemNavigation methodsFor: 'browse' stamp: 'tpr 10/11/2017 14:32'! browseClassesWithNamesContaining: aString caseSensitive: caseSensitive "SystemNavigation default browseClassesWithNamesContaining: 'eMorph' caseSensitive: true " "Launch a class-list list browser on all classes whose names containg aString as a substring." | suffix aList | suffix := caseSensitive ifTrue: [' (case-sensitive)'] ifFalse: [' (use shift for case-sensitive)']. aList := OrderedCollection new. Cursor wait showWhile: [Smalltalk allClassesDo: [:class | (class name includesSubstring: aString caseSensitive: caseSensitive) ifTrue: [aList add: class name]]]. aList size > 0 ifTrue: [ToolSet openClassListBrowser: aList asSet sorted title: 'Classes whose names contain ' , aString , suffix]! ! !TextEditor methodsFor: 'menu messages' stamp: 'tpr 10/9/2017 15:41'! browseClassFromIt "Launch a hierarchy browser for the class indicated by the current selection. If multiple classes matching the selection exist, let the user choose among them." | aClass | self lineSelectAndEmptyCheck: [ ^ self ]. aClass := UIManager default classFromPattern: self selection string withBlanksTrimmed withCaption: 'choose a class to browse...' in: model environment. aClass ifNil: [ ^ morph flash ]. "OK, so do we actually need to go via systemNavigation or is ToolSet ok" self systemNavigation spawnHierarchyForClass: aClass selector: nil! ! !TextEditor methodsFor: 'menu messages' stamp: 'tpr 10/9/2017 15:48'! browseIt "Launch a browser for the current selection, if appropriate" | aSymbol anEntry maybeBrowseInstVar | Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. maybeBrowseInstVar := [| selectionString | selectionString := self selection asString. ([model selectedClass] on: Error do: [:ex|]) ifNotNil: [:class| (class allInstVarNames includes: selectionString) ifTrue: [self systemNavigation browseAllAccessesTo: selectionString from: (class classThatDefinesInstanceVariable: selectionString). ^nil]]]. (aSymbol := self selectedSymbol) ifNil: [maybeBrowseInstVar value. ^morph flash]. aSymbol first isUppercase ifTrue: [anEntry := (model environment valueOf: aSymbol ifAbsent: [ ([model selectedClass] on: Error do: [:ex|]) ifNotNil: [:class| (class bindingOf: aSymbol) ifNotNil: "e.g. a class var" [:binding| self systemNavigation browseAllCallsOn: binding. ^ nil]]. self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry ifNil: [^ morph flash]. (anEntry isBehavior and: [anEntry name == aSymbol]) ifFalse: "When is this ever false?" [anEntry := anEntry class]. "more confusion here; prior version was using SystemBrowser default here and yet the rest of the method is going via systemNaviagation" ToolSet browseClass: anEntry] ifFalse: [self systemNavigation browseAllImplementorsOf: aSymbol. maybeBrowseInstVar value]! ! !ToolBuilder class methodsFor: 'accessing' stamp: 'tpr 10/9/2017 10:51'! default "Answer the default tool builder" ^ UIManager default toolBuilder ! ! !ToolSet class methodsFor: 'browsing' stamp: 'tpr 10/12/2017 14:38'! openClassListBrowser: anArray title: aString "Open a class list browser on the list of classes named" self default ifNil:[^self inform: 'Cannot open ClassListBrowser']. ^self default openClassListBrowser: anArray title: aString! ! PackagePaneBrowser class removeSelector: #prototypicalToolWindow! PackagePaneBrowser removeSelector: #openEditString:! !PackagePaneBrowser reorganize! ('class list' classList packageClasses selectedClass) ('dragNDrop' changeCategoryForClass:srcSystemCategory:atListMorph:internal:copy:) ('dragNDrop util' dstCategoryDstListMorph:internal:) ('initialize-release' defaultBrowserTitle labelString systemOrganizer:) ('package list' categoryExistsForPackage hasPackageSelected mainPackageMenu: package packageList packageListIndex packageListIndex: packageListKey:from: packageMenu: updatePackages) ('system category list' hasSystemCategorySelected selectCategoryForClass: selectedSystemCategory systemCategoryList systemCategoryListIndex) ('multi-window support' isPackage multiWindowName multiWindowNameForState: restoreToPackage:category:className:protocol:selector:mode:meta: saveMultiWindowState) ('toolbuilder' buildDefaultBrowserWith: buildPackageListWith:) ('user interface' defaultWindowColor) ('class functions') ! ClassListBrowser removeSelector: #initForClassesNamed:title:! HierarchyBrowser removeSelector: #assureSelectionsShow! HierarchyBrowser removeSelector: #buildWith:! HierarchyBrowser removeSelector: #initAlphabeticListing! HierarchyBrowser removeSelector: #openEditString:! HierarchyBrowser removeSelector: #openSystemCatEditString:! FileContentsBrowser removeSelector: #createViews! Browser class removeSelector: #newOnMessageCategory:inClass:! Browser class removeSelector: #openBrowserView:label:! Browser removeSelector: #openEditString:! Browser removeSelector: #openMessageCatEditString:! Browser removeSelector: #openOnClassWithEditString:! Browser removeSelector: #openSystemCatEditString:! !Browser reorganize! ('*46Deprecated' classComment:notifying: defineMessage:notifying: messageListSingleton optionalAnnotationHeight optionalButtonHeight potentialClassNames) ('*Etoys-Squeakland-class functions' buildClassBrowser) ('*Etoys-Squeakland-drag and drop' overwriteDialogHierarchyChange:higher:sourceClassName:destinationClassName:methodSelector:) ('*Etoys-Squeakland-initialize-release' browserWindowActivated) ('*Etoys-Squeakland-message functions' buildMessageBrowser) ('*SUnitTools-class list functions' testRunTests) ('*SUnitTools-menus' testsClassListMenu: testsSystemCategoryMenu:) ('*SUnitTools-system category functions' hasSystemCategoryWithTestsSelected testRunTestsCategory) ('*services-base' browseReference: classCategoryMenuServices: classListMenuServices: messageCategoryMenuServices: methodReference optionalButtonRow selectReference:) ('accessing' contents contents:notifying: contentsSelection couldBrowseAnyClass doItReceiver editSelection editSelection: environment newClassContents noteSelectionIndex:for: request:initialAnswer: selectEnvironment: spawn: suggestCategoryToSpawnedBrowser:) ('annotation' annotation annotation:) ('class comment pane' annotationForClassCommentFor: annotationForClassDefinitionFor: noCommentNagString stripNaggingAttributeFromComment:) ('class functions' addAllMethodsToCurrentChangeSet classCommentText classDefinitionText classListMenu: classListMenu:shifted: classListMenuMore: copyClass createInstVarAccessors defineClass:notifying: editClass editComment explainSpecial: fileOutClass findMethod hierarchy makeNewSubclass plusButtonHit printOutClass removeClass renameClass shiftedClassListMenu: shiftedClassListMenuMore:) ('class list' classIconAt: classList classListIndex classListIndex: classListIndexOf: classListSingleton createHierarchyTreeOf: defaultClassList flattenHierarchyTree:on:indent: flattenHierarchyTree:on:indent:by: hasClassSelected hierarchicalClassList recent selectClass: selectClassNamed: selectedClass selectedClassName) ('code pane' aboutToStyle: compileMessage:notifying: showBytecodes) ('controls' decorateButtons) ('copying' veryDeepInner:) ('drag and drop' dragFromClassList: dragFromMessageList: dropOnMessageCategories:at: dropOnSystemCategories:at: wantsMessageCategoriesDrop: wantsSystemCategoriesDrop:) ('initialize-release' classListFrame: classListFrame:fromLeft:width: classListFrame:fromTop:fromLeft:width: defaultBrowserTitle frameOffsetFromTop:fromLeft:width:bottomFraction: labelString methodCategoryChanged setClass: setClass:selector: setSelector: switchesFrame: switchesFrame:fromLeft:width: systemCatSingletonKey:from: systemOrganizer: topConstantHeightFrame:fromLeft:width:) ('message category functions' addCategory alphabetizeMessageCategories buildMessageCategoryBrowser buildMessageCategoryBrowserEditString: canShowMultipleMessageCategories categoryOfCurrentMethod changeMessageCategories: editMessageCategories fileOutMessageCategories highlightMessageList:with: mainMessageCategoryMenu: messageCategoryMenu: printOutMessageCategories removeEmptyCategories removeMessageCategory renameCategory showHomeCategory) ('message category list' categorizeAllUncategorizedMethods hasMessageCategorySelected messageCatListSingleton messageCategoryList messageCategoryListIndex messageCategoryListIndex: messageCategoryListKey:from: messageCategoryListSelection rawMessageCategoryList recategorizeMethodSelector: selectMessageCategoryNamed: selectedMessageCategoryName setOriginalCategoryIndexForCurrentMethod toggleCategorySelectionForCurrentMethod) ('message functions' addExtraShiftedItemsTo: browseAllCommentsForClass defineMessageFrom:notifying: inspectInstances inspectSubInstances mainMessageListMenu: messageListMenu:shifted: removeMessage removeMessageFromBrowser shiftedMessageListMenu:) ('message list' hasMessageSelected lastMessageName messageHelpAt: messageHelpFor: messageIconAt: messageIconFor: messageIconHelpFor: messageList messageListIndex messageListIndex: messageListIndexOf: reformulateList selectMessageNamed: selectedMessage selectedMessageName selectedMessageName:) ('metaclass' classCommentIndicated classDefinitionIndicated classMessagesIndicated classOrMetaClassOrganizer indicateClassMessages indicateInstanceMessages instanceMessagesIndicated metaClassIndicated metaClassIndicated: selectedClassOrMetaClass selectedClassOrMetaClassName setClassDefinition setClassOrganizer) ('multi-window support' arrowKey:from: classHierarchy isHierarchy isPackage multiWindowName multiWindowNameForState: okToClose restoreMultiWindowState: restoreToCategory:className:protocol:selector:mode:meta: saveMultiWindowState) ('pluggable menus - hooks' classListMenuHook:shifted: messageCategoryMenuHook:shifted: messageListMenuHook:shifted: systemCategoryMenuHook:shifted:) ('self-updating' didCodeChangeElsewhere) ('system category functions' addSystemCategory alphabetizeSystemCategories browseAllClasses buildSystemCategoryBrowser buildSystemCategoryBrowserEditString: changeSystemCategories: classNotFound editSystemCategories fileOutSystemCategory findClass mainSystemCategoryMenu: printOutSystemCategory removeSystemCategory renameSystemCategory systemCatSingletonMenu: systemCategoryMenu: updateSystemCategories) ('system category list' hasSystemCategorySelected indexIsOne indexIsOne: selectCategoryForClass: selectSystemCategory: selectedEnvironment selectedSystemCategory selectedSystemCategoryName systemCatListKey:from: systemCategoryList systemCategoryListIndex systemCategoryListIndex: systemCategorySingleton) ('toolbuilder' buildAndOpenCategoryBrowser buildAndOpenCategoryBrowserLabel: buildAndOpenClassBrowserLabel: buildAndOpenFullBrowser buildAndOpenMessageCategoryBrowserLabel: buildCategoryBrowserWith: buildClassListSingletonWith: buildClassListWith: buildDefaultBrowserWith: buildMessageCategoryListWith: buildMessageListCatSingletonWith: buildMessageListWith: buildSwitchesWith: buildSystemCatListSingletonWith: buildSystemCategoryListWith: buildWith: setMultiWindowFor:) ('traits' addSpecialMenu: addTrait defineTrait:notifying: newClass newTrait) ('user interface' addModelItemsToWindowMenu: defaultWindowColor) !