[squeak-dev] The Trunk: Tools-ul.340.mczcommits at source.squeak.org commits at source.squeak.orgFri Apr 15 22:25:47 UTC 2011
Levente Uzonyi uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ul.340.mcz ==================== Summary ==================== Name: Tools-ul.340 Author: ul Time: 15 April 2011, 11:56:59.464 pm UUID: 1f3b4d96-c061-c146-a611-20cd1cedfacf Ancestors: Tools-nice.305, Tools-fbs.339 Merged. =============== Diff against Tools-nice.305 =============== Item was changed: CodeHolder subclass: #Browser + instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer editSelection metaClassIndicated selectedSystemCategory selectedClassName selectedMessageName selectedMessageCategoryName' - instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated' classVariableNames: 'ListClassesHierarchically RecentClasses' poolDictionaries: '' category: 'Tools-Browser'! !Browser commentStamp: '<historical>' prior: 0! I represent a query path into the class descriptions, the software of the system.! Item was changed: ----- Method: Browser class>>newOnCategory: (in category 'instance creation') ----- newOnCategory: aCategory "Browse the system category of the given name. 7/13/96 sw" "Browser newOnCategory: 'Interface-Browser'" + | newBrowser newCat | + newBrowser := self new.. + newCat := aCategory asSymbol. + (newBrowser systemCategoryList includes: newCat) + ifTrue: [ newBrowser selectSystemCategory: newCat ] + ifFalse: [ ^ self inform: 'No such category' ]. + - | newBrowser catList | - newBrowser := self new. - catList := newBrowser systemCategoryList. - newBrowser systemCategoryListIndex: - (catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']). ^ self openBrowserView: (newBrowser openSystemCatEditString: nil) label: 'Classes in category ', aCategory ! Item was changed: ----- Method: Browser>>addCategory (in category 'message category functions') ----- addCategory "Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection" + | labels reject lines menuIndex newName oldCategory | - | labels reject lines menuIndex oldIndex newName | self okToChange ifFalse: [^ self]. + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. labels := OrderedCollection with: 'new...'. reject := Set new. reject addAll: self selectedClassOrMetaClass organization categories; add: ClassOrganizer nullCategory; add: ClassOrganizer default. lines := OrderedCollection new. self selectedClassOrMetaClass allSuperclasses do: [:cls | | cats | cls = Object ifFalse: [ cats := cls organization categories reject: [:cat | reject includes: cat]. cats isEmpty ifFalse: [ lines add: labels size. labels addAll: cats asSortedCollection. reject addAll: cats]]]. newName := (labels size = 1 or: [ menuIndex := (UIManager default chooseFrom: labels lines: lines title: 'Add Category'). menuIndex = 0 ifTrue: [^ self]. menuIndex = 1]) ifTrue: [ self request: 'Please type new category name' initialAnswer: 'category name'] ifFalse: [ labels at: menuIndex]. + oldCategory := self selectedMessageCategoryName. - oldIndex := messageCategoryListIndex. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. self classOrMetaClassOrganizer addCategory: newName + before: (self hasMessageCategorySelected + ifFalse: [nil] + ifTrue: [self selectedMessageCategoryName]). - before: (messageCategoryListIndex = 0 - ifTrue: [nil] - ifFalse: [self selectedMessageCategoryName]). self changed: #messageCategoryList. + self selectMessageCategoryNamed: + (oldCategory isNil + ifTrue: [self classOrMetaClassOrganizer categories last] + ifFalse: [oldCategory]). - self messageCategoryListIndex: - (oldIndex = 0 - ifTrue: [self classOrMetaClassOrganizer categories size + 1] - ifFalse: [oldIndex]). self changed: #messageCategoryList. ! Item was changed: ----- Method: Browser>>addSystemCategory (in category 'system category functions') ----- addSystemCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" + | oldSelection newName | - | oldIndex newName | self okToChange ifFalse: [^ self]. + oldSelection := self selectedSystemCategory. - oldIndex := systemCategoryListIndex. newName := self request: 'Please type new category name' initialAnswer: 'Category-Name'. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. systemOrganizer addCategory: newName + before: self selectedSystemCategory. + self selectSystemCategory: + (oldSelection isNil + ifTrue: [ self systemCategoryList last ] + ifFalse: [ oldSelection ]). - before: (systemCategoryListIndex = 0 - ifTrue: [nil] - ifFalse: [self selectedSystemCategoryName]). - self systemCategoryListIndex: - (oldIndex = 0 - ifTrue: [self systemCategoryList size] - ifFalse: [oldIndex]). self changed: #systemCategoryList.! Item was changed: ----- Method: Browser>>alphabetizeMessageCategories (in category 'message category functions') ----- alphabetizeMessageCategories + self hasClassSelected ifFalse: [^ false]. - classListIndex = 0 ifTrue: [^ false]. self okToChange ifFalse: [^ false]. self classOrMetaClassOrganizer sortCategories. self clearUserEditFlag. self editClass. + self selectClassNamed: selectedClassName. - self classListIndex: classListIndex. ^ true! Item was changed: ----- Method: Browser>>alphabetizeSystemCategories (in category 'system category functions') ----- alphabetizeSystemCategories self okToChange ifFalse: [^ false]. systemOrganizer sortCategories. + self selectSystemCategory: nil. - self systemCategoryListIndex: 0. self changed: #systemCategoryList. ! Item was changed: ----- Method: Browser>>buildMessageCategoryBrowserEditString: (in category 'message category functions') ----- buildMessageCategoryBrowserEditString: aString "Create and schedule a message category browser for the currently selected message category. The initial text view contains the characters in aString." "wod 6/24/1998: set newBrowser classListIndex so that it works whether the receiver is a standard or a Hierarchy Browser." | newBrowser | + ^ self hasMessageCategorySelected + ifFalse: [ nil ] - messageCategoryListIndex ~= 0 ifTrue: [newBrowser := Browser new. + newBrowser selectSystemCategory: self selectedSystemCategory. + newBrowser selectClass: self selectedClass. + newBrowser metaClassIndicated: self metaClassIndicated. + newBrowser selectMessageCategoryNamed: self selectedMessageCategoryName. + newBrowser selectMessageNamed: self selectedMessageName. - newBrowser systemCategoryListIndex: systemCategoryListIndex. - newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName). - newBrowser metaClassIndicated: metaClassIndicated. - newBrowser messageCategoryListIndex: messageCategoryListIndex. - newBrowser messageListIndex: messageListIndex. self class openBrowserView: (newBrowser openMessageCatEditString: aString) label: 'Message Category Browser (' , + newBrowser selectedClassOrMetaClassName , ')'. + newBrowser.].! - newBrowser selectedClassOrMetaClassName , ')']! Item was changed: ----- Method: Browser>>buildSystemCategoryBrowserEditString: (in category 'system category functions') ----- buildSystemCategoryBrowserEditString: aString "Create and schedule a new system category browser with initial textual contents set to aString." | newBrowser | + self hasSystemCategorySelected - systemCategoryListIndex > 0 ifTrue: [newBrowser := self class new. + newBrowser selectSystemCategory: self selectedSystemCategory. - newBrowser systemCategoryListIndex: systemCategoryListIndex. newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName. self class openBrowserView: (newBrowser openSystemCatEditString: aString) + label: 'Classes in category ', newBrowser selectedSystemCategory]! - label: 'Classes in category ', newBrowser selectedSystemCategoryName]! Item was changed: ----- Method: Browser>>changeMessageCategories: (in category 'message category functions') ----- changeMessageCategories: aString "The characters in aString represent an edited version of the the message categories for the selected class. Update this information in the system and inform any dependents that the categories have been changed. This message is invoked because the user had issued the categories command and edited the message categories. Then the user issued the accept command." self classOrMetaClassOrganizer changeFromString: aString. self clearUserEditFlag. self editClass. + self selectClassNamed: selectedClassName. - self classListIndex: classListIndex. ^ true! Item was changed: ----- Method: Browser>>classHierarchy (in category 'multi-window support') ----- classHierarchy | behavior newBrowser | (behavior := self selectedClassOrMetaClass) isNil ifTrue: [^self]. (self isPackage "PackageBrowser pains can't support a hierarchy browser; not sure why." or: [multiWindowState isNil]) ifTrue: [^super classHierarchy]. (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior) + selectMessageCategoryNamed: self selectedMessageCategoryName; + selectMessageNamed: self selectedMessageName; - messageCategoryListIndex: messageCategoryListIndex; - messageListIndex: messageListIndex; editSelection: editSelection. multiWindowState addWindow: newBrowser ! Item was changed: ----- Method: Browser>>classListIndex (in category 'class list') ----- classListIndex "Answer the index of the current class selection." + ^ self classListIndexOf: self selectedClassName.! - ^classListIndex! Item was changed: ----- Method: Browser>>classListIndex: (in category 'class list') ----- classListIndex: anInteger + | newClassName | + newClassName := self classList at: anInteger ifAbsent: [ nil ]. + newClassName := newClassName ifNotNil: [newClassName withoutLeadingBlanks asSymbol]. + self selectClassNamed: newClassName.! - "Set anInteger to be the index of the current class selection." - - | className currentMessageCategoryName currentMessageName | - currentMessageCategoryName := [self selectedMessageCategoryName] - on: Error - do: [:ex| ex return: nil]. - currentMessageName := [self selectedMessageName] - on: Error - do: [:ex| ex return: nil]. - - classListIndex := anInteger. - self setClassOrganizer. - - "Try to reselect the category and/or selector if the new class has them." - messageCategoryListIndex := self messageCategoryList - indexOf: currentMessageCategoryName - ifAbsent: [0]. - messageListIndex := messageCategoryListIndex = 0 - ifTrue: [0] - ifFalse: [self messageList - indexOf: currentMessageName - ifAbsent: [0]]. - - messageListIndex ~= 0 ifTrue: - [self editSelection: #editMessage] ifFalse: - [messageCategoryListIndex ~= 0 ifTrue: - [self editSelection: #newMessage] ifFalse: - [self classCommentIndicated - ifTrue: [] - ifFalse: [self editSelection: (anInteger = 0 - ifTrue: [(metaClassIndicated or: [ systemCategoryListIndex = 0 ]) - ifTrue: [#none] - ifFalse: [#newClass]] - ifFalse: [#editClass])]]]. - contents := nil. - self selectedClass isNil - ifFalse: [className := self selectedClass name. - (RecentClasses includes: className) - ifTrue: [RecentClasses remove: className]. - RecentClasses addFirst: className. - RecentClasses size > 16 - ifTrue: [RecentClasses removeLast]]. - self changed: #classSelectionChanged. - self changed: #classCommentText. - self changed: #classListIndex. "update my selection" - self changed: #messageCategoryList. - self changed: #messageList. - self changed: #relabel. - self contentsChanged! Item was changed: ----- Method: Browser>>classListIndexOf: (in category 'class list') ----- classListIndexOf: className | classList | classList := self classList. + classList := classList collect: [:ea | ea withoutLeadingBlanks asSymbol]. - self class listClassesHierarchically - ifTrue: [classList := classList collect: [:ea | ea withoutLeadingBlanks asSymbol]]. ^ classList indexOf: className.! Item was changed: ----- Method: Browser>>compileMessage:notifying: (in category 'code pane') ----- compileMessage: aText notifying: aController "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." + | fallBackCategoryName originalSelectorName result fallBackMethodName | - | fallBackCategoryIndex fallBackMethodIndex originalSelectorName result | self selectedMessageCategoryName ifNil: [ self selectOriginalCategoryForCurrentMethod ifFalse:["Select the '--all--' category" self messageCategoryListIndex: 1]]. self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory ifTrue: [ "User tried to save a method while the ALL category was selected" + fallBackCategoryName := selectedMessageCategoryName. + fallBackMethodName := selectedMessageName. - fallBackCategoryIndex := messageCategoryListIndex. - fallBackMethodIndex := messageListIndex. editSelection == #newMessage ifTrue: [ "Select the 'as yet unclassified' category" + selectedMessageCategoryName := nil. - messageCategoryListIndex := 0. (result := self defineMessageFrom: aText notifying: aController) ifNil: ["Compilation failure: reselect the original category & method" + selectedMessageCategoryName := fallBackCategoryName. + selectedMessageName := fallBackMethodName] - messageCategoryListIndex := fallBackCategoryIndex. - messageListIndex := fallBackMethodIndex] ifNotNil: [self setSelector: result]] ifFalse: [originalSelectorName := self selectedMessageName. self setOriginalCategoryIndexForCurrentMethod. + selectedMessageName := fallBackMethodName := originalSelectorName. - messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName. (result := self defineMessageFrom: aText notifying: aController) ifNotNil: [self setSelector: result] ifNil: [ "Compilation failure: reselect the original category & method" + selectedMessageCategoryName := fallBackCategoryName. + selectedMessageName := fallBackMethodName. - messageCategoryListIndex := fallBackCategoryIndex. - messageListIndex := fallBackMethodIndex. ^ result notNil]]. self changed: #messageCategoryList. ^ result notNil] ifFalse: [ "User tried to save a method while the ALL category was NOT selected" ^ (self defineMessageFrom: aText notifying: aController) notNil]! Item was changed: ----- Method: Browser>>contents (in category 'accessing') ----- contents "Depending on the current selection, different information is retrieved. Answer a string description of that information. This information is the method of the currently selected class and message." | comment theClass latestCompiledMethod | latestCompiledMethod := currentCompiledMethod. currentCompiledMethod := nil. editSelection == #newTrait + ifTrue: [^ClassDescription newTraitTemplateIn: self selectedSystemCategory]. - ifTrue: [^ClassDescription newTraitTemplateIn: self selectedSystemCategoryName]. editSelection == #none ifTrue: [^ '']. editSelection == #editSystemCategories ifTrue: [^ systemOrganizer printString]. editSelection == #newClass ifTrue: [^ (theClass := self selectedClass) ifNil: + [Class template: self selectedSystemCategory] - [Class template: self selectedSystemCategoryName] ifNotNil: + [Class templateForSubclassOf: theClass category: self selectedSystemCategory]]. - [Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]]. editSelection == #editClass ifTrue: [^self classDefinitionText]. editSelection == #editComment ifTrue: [(theClass := self selectedClass) ifNil: [^ '']. comment := theClass comment. currentCompiledMethod := theClass organization commentRemoteStr. ^ comment size = 0 ifTrue: ['This class has not yet been commented.'] ifFalse: [comment]]. editSelection == #hierarchy ifTrue: [^self selectedClassOrMetaClass printHierarchy]. editSelection == #editMessageCategories ifTrue: [^ self classOrMetaClassOrganizer printString]. editSelection == #newMessage ifTrue: [^ (theClass := self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass sourceCodeTemplate]]. editSelection == #editMessage ifTrue: [^ self editContentsWithDefault: [currentCompiledMethod := latestCompiledMethod. self selectedMessage]]. self error: 'Browser internal error: unknown edit selection.'! Item was changed: ----- Method: Browser>>contentsSelection (in category 'accessing') ----- contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" + self hasMessageCategorySelected & (self hasMessageSelected not) - messageCategoryListIndex > 0 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection"! Item was changed: ----- Method: Browser>>copyClass (in category 'class functions') ----- copyClass | originalClass originalName copysName | + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. originalClass := self selectedClass. originalName := originalClass name. copysName := self request: 'Please type new class name' initialAnswer: originalName. copysName = '' ifTrue: [^ self]. " Cancel returns '' " copysName := copysName asSymbol. copysName = originalName ifTrue: [^ self]. (Smalltalk hasClassNamed: copysName) ifTrue: [^ self error: copysName , ' already exists']. Cursor wait showWhile: [ | newDefinition newMetaDefinition newClass | newDefinition := originalClass definition copyReplaceAll: originalName printString with: copysName printString. newClass := Compiler evaluate: newDefinition logged: true. newMetaDefinition := originalClass class definition copyReplaceAll: originalClass class name with: newClass class name. Compiler evaluate: newMetaDefinition logged: true. newClass copyAllCategoriesFrom: originalClass. newClass class copyAllCategoriesFrom: originalClass class. originalClass hasComment ifTrue: [ newClass comment: originalClass comment ] ]. self classListIndex: 0. self changed: #classList! Item was changed: ----- Method: Browser>>defaultClassList (in category 'class list') ----- defaultClassList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." + + ^ self hasSystemCategorySelected + ifTrue: [systemOrganizer listAtCategoryNamed: self selectedSystemCategory] + ifFalse: [Array new].! - - ^ systemCategoryListIndex = 0 - ifTrue: [Array new] - ifFalse: [systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! Item was changed: ----- Method: Browser>>editClass (in category 'class functions') ----- editClass "Retrieve the description of the class definition." + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. self messageCategoryListIndex: 0. self editSelection: #editClass. self changed: #contents. self changed: #classCommentText. ! Item was changed: ----- Method: Browser>>editComment (in category 'class functions') ----- editComment "Retrieve the description of the class comment." + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. self messageCategoryListIndex: 0. metaClassIndicated := false. self editSelection: #editComment. self changed: #classSelectionChanged. self changed: #messageCategoryList. self changed: #messageList. self decorateButtons. self contentsChanged ! Item was changed: ----- Method: Browser>>editMessageCategories (in category 'message category functions') ----- editMessageCategories "Indicate to the receiver and its dependents that the message categories of the selected class have been changed." self okToChange ifFalse: [^ self]. + self hasClassSelected - classListIndex ~= 0 ifTrue: [self messageCategoryListIndex: 0. self editSelection: #editMessageCategories. self changed: #editMessageCategories. self contentsChanged]! Item was changed: ----- Method: Browser>>editSystemCategories (in category 'system category functions') ----- editSystemCategories "Retrieve the description of the class categories of the system organizer." self okToChange ifFalse: [^ self]. + self selectSystemCategory: nil. - self systemCategoryListIndex: 0. self editSelection: #editSystemCategories. self changed: #editSystemCategories. self contentsChanged! Item was changed: ----- Method: Browser>>fileOutClass (in category 'class functions') ----- fileOutClass "Print a description of the selected class onto a file whose name is the category name followed by .st." Cursor write showWhile: + [self hasClassSelected ifTrue: [self selectedClass fileOut]]! - [classListIndex ~= 0 ifTrue: [self selectedClass fileOut]]! Item was changed: ----- Method: Browser>>fileOutMessageCategories (in category 'message category functions') ----- fileOutMessageCategories "Print a description of the selected message category of the selected class onto an external file." Cursor write showWhile: + [self hasMessageCategorySelected - [messageCategoryListIndex ~= 0 ifTrue: [self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName]]! Item was changed: ----- Method: Browser>>fileOutSystemCategory (in category 'system category functions') ----- fileOutSystemCategory "Print a description of each class in the selected category onto a file whose name is the category name followed by .st." + self hasSystemCategorySelected + ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategory]! - systemCategoryListIndex ~= 0 - ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! Item was changed: ----- Method: Browser>>flattenHierarchyTree:on:indent: (in category 'class list') ----- flattenHierarchyTree: classHierarchy on: col indent: indent + ^ self + flattenHierarchyTree: classHierarchy + on: col + indent: indent + by: Character space.! - - | plusIndent | - plusIndent := String space. - classHierarchy do: [:assoc | - | class childs | - class := assoc key. - col add: indent , class name. - childs := assoc value. - self - flattenHierarchyTree: childs - on: col - indent: indent , plusIndent]. - ^ col! Item was added: + ----- Method: Browser>>flattenHierarchyTree:on:indent:by: (in category 'class list') ----- + flattenHierarchyTree: classHierarchy on: col indent: indent by: indentChars + "Recursively add to col the names in classHierarchy indenting to show the hierarchical relationship. Use indentChars to do the indenting: spaces, tabs, etc." + | plusIndent | + plusIndent := indentChars. + classHierarchy do: [:assoc | + | class childs | + class := assoc key. + col add: indent , class name. + childs := assoc value. + self + flattenHierarchyTree: childs + on: col + indent: indent , plusIndent + by: indentChars]. + ^ col! Item was added: + ----- Method: Browser>>hasClassSelected (in category 'class list') ----- + hasClassSelected + ^ selectedClassName notNil.! Item was added: + ----- Method: Browser>>hasMessageCategorySelected (in category 'message category list') ----- + hasMessageCategorySelected + ^ self selectedMessageCategoryName notNil.! Item was added: + ----- Method: Browser>>hasMessageSelected (in category 'message list') ----- + hasMessageSelected + ^ self selectedMessageName notNil.! Item was added: + ----- Method: Browser>>hasSystemCategorySelected (in category 'system category list') ----- + hasSystemCategorySelected + ^ self selectedSystemCategory notNil.! Item was changed: ----- Method: Browser>>hierarchy (in category 'class functions') ----- hierarchy "Display the inheritance hierarchy of the receiver's selected class." + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. self messageCategoryListIndex: 0. self editSelection: #hierarchy. self changed: #editComment. self contentsChanged. ^ self! Item was added: + ----- Method: Browser>>lastMessageName (in category 'message list') ----- + lastMessageName + ^ self messageList last.! Item was changed: ----- Method: Browser>>messageCategoryList (in category 'message category list') ----- messageCategoryList "Answer the selected category of messages." + self hasClassSelected + ifTrue: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories] + ifFalse: [^ Array new]! - classListIndex = 0 - ifTrue: [^ Array new] - ifFalse: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories]! Item was changed: ----- Method: Browser>>messageCategoryListIndex (in category 'message category list') ----- messageCategoryListIndex "Answer the index of the selected message category." + ^self messageCategoryList indexOf: selectedMessageCategoryName ifAbsent: [0].! - ^messageCategoryListIndex! Item was changed: ----- Method: Browser>>messageCategoryListIndex: (in category 'message category list') ----- messageCategoryListIndex: anInteger "Set the selected message category to be the one indexed by anInteger." + selectedMessageCategoryName := nil. + self selectMessageCategoryNamed: (self messageCategoryList at: anInteger ifAbsent: [nil]).! - messageCategoryListIndex := anInteger. - messageListIndex := 0. - self changed: #messageCategorySelectionChanged. - self changed: #messageCategoryListIndex. "update my selection" - self changed: #messageList. - self editSelection: (anInteger > 0 - ifTrue: [#newMessage] - ifFalse: [self classListIndex > 0 - ifTrue: [#editClass] - ifFalse: [#newClass]]). - contents := nil. - self contentsChanged.! Item was changed: ----- Method: Browser>>messageList (in category 'message list') ----- messageList "Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range. Otherwise, answer an empty Array If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero." | sel | (sel := self messageCategoryListSelection) ifNil: [ ^ self classOrMetaClassOrganizer ifNil: [Array new] ifNotNil: [self classOrMetaClassOrganizer allMethodSelectors] "^ Array new" ]. ^ sel = ClassOrganizer allCategory ifTrue: [self classOrMetaClassOrganizer ifNil: [Array new] ifNotNil: [self classOrMetaClassOrganizer allMethodSelectors]] ifFalse: + [(self classOrMetaClassOrganizer listAtCategoryNamed: self selectedMessageCategoryName ) + ifNil: [selectedMessageCategoryName := nil. Array new]]! - [(self classOrMetaClassOrganizer listAtCategoryNumber: messageCategoryListIndex - 1) - ifNil: [messageCategoryListIndex := 0. Array new]]! Item was changed: ----- Method: Browser>>messageListIndex (in category 'message list') ----- messageListIndex "Answer the index of the selected message selector into the currently selected message category." + ^ self messageListIndexOf: self selectedMessageName! - ^messageListIndex! Item was changed: ----- Method: Browser>>messageListIndex: (in category 'message list') ----- messageListIndex: anInteger "Set the selected message selector to be the one indexed by anInteger." + self selectMessageNamed: (self messageList at: anInteger ifAbsent: [nil])! - messageListIndex := anInteger. - self editSelection: (anInteger > 0 - ifTrue: [#editMessage] - ifFalse: [self messageCategoryListIndex > 0 - ifTrue: [#newMessage] - ifFalse: [self classListIndex > 0 - ifTrue: [#editClass] - ifFalse: [#newClass]]]). - contents := nil. - self changed: #messageListIndex. "update my selection" - self contentsChanged. - self decorateButtons.! Item was added: + ----- Method: Browser>>messageListIndexOf: (in category 'message list') ----- + messageListIndexOf: aString + ^ self messageList indexOf: aString.! Item was changed: ----- Method: Browser>>metaClassIndicated: (in category 'metaclass') ----- metaClassIndicated: trueOrFalse "Indicate whether browsing instance or class messages." metaClassIndicated := trueOrFalse. self setClassOrganizer. + self hasSystemCategorySelected ifTrue: + [self editSelection: (self hasClassSelected + ifFalse: [metaClassIndicated - systemCategoryListIndex > 0 ifTrue: - [self editSelection: (classListIndex = 0 - ifTrue: [metaClassIndicated ifTrue: [#none] ifFalse: [#newClass]] + ifTrue: [#editClass])]. + selectedMessageCategoryName := nil. + selectedMessageName := nil. - ifFalse: [#editClass])]. - messageCategoryListIndex := 0. - messageListIndex := 0. contents := nil. self changed: #classSelectionChanged. self changed: #messageCategoryList. self changed: #messageList. self changed: #contents. self changed: #annotation. self decorateButtons ! Item was changed: ----- Method: Browser>>noteSelectionIndex:for: (in category 'accessing') ----- noteSelectionIndex: anInteger for: aSymbol aSymbol == #systemCategoryList ifTrue: + [self systemCategoryListIndex: anInteger]. - [systemCategoryListIndex := anInteger]. aSymbol == #classList ifTrue: + [self classListIndex: anInteger]. - [classListIndex := anInteger]. aSymbol == #messageCategoryList ifTrue: + [self messageCategoryListIndex: anInteger]. - [messageCategoryListIndex := anInteger]. aSymbol == #messageList ifTrue: + [self messageListIndex: anInteger].! - [messageListIndex := anInteger].! Item was changed: ----- Method: Browser>>plusButtonHit (in category 'class functions') ----- plusButtonHit "Cycle among definition, comment, and hierachy" editSelection == #editComment ifTrue: [self hierarchy. ^ self]. editSelection == #hierarchy ifTrue: [self editSelection: #editClass. + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. self changed: #editComment. self contentsChanged. ^ self]. self editComment! Item was changed: ----- Method: Browser>>printOutClass (in category 'class functions') ----- printOutClass "Print a description of the selected class onto a file whose name is the category name followed by .html." Cursor write showWhile: + [self hasClassSelected ifTrue: [self selectedClass fileOutAsHtml: true]]! - [classListIndex ~= 0 ifTrue: [self selectedClass fileOutAsHtml: true]]! Item was changed: ----- Method: Browser>>printOutMessageCategories (in category 'message category functions') ----- printOutMessageCategories "Print a description of the selected message category of the selected class onto an external file in Html format." Cursor write showWhile: + [self hasMessageCategorySelected - [messageCategoryListIndex ~= 0 ifTrue: [self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName asHtml: true]]! Item was changed: ----- Method: Browser>>printOutSystemCategory (in category 'system category functions') ----- printOutSystemCategory "Print a description of each class in the selected category as Html." Cursor write showWhile: + [self hasSystemCategorySelected + ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategory - [systemCategoryListIndex ~= 0 - ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName asHtml: true ]] ! Item was changed: ----- Method: Browser>>rawMessageCategoryList (in category 'message category list') ----- rawMessageCategoryList + ^ self hasClassSelected + ifTrue: [self classOrMetaClassOrganizer categories] + ifFalse: [Array new]! - ^ classListIndex = 0 - ifTrue: [Array new] - ifFalse: [self classOrMetaClassOrganizer categories]! Item was changed: ----- Method: Browser>>reformulateList (in category 'message list') ----- reformulateList "If the receiver has a way of reformulating its message list, here is a chance for it to do so" super reformulateList. + (self messageList includes: self selectedMessageName) + ifFalse: [ self selectMessageNamed: self lastMessageName ].! - messageListIndex > self messageList size ifTrue: [ self messageListIndex: self messageList size ]! Item was changed: ----- Method: Browser>>removeMessage (in category 'message functions') ----- removeMessage "If a message is selected, create a Confirmer so the user can verify that the currently selected message should be removed from the system. If so, remove it. If the Preference 'confirmMethodRemoves' is set to false, the confirmer is bypassed." | messageName confirmation | + self hasMessageSelected not - messageListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. messageName := self selectedMessageName. confirmation := self systemNavigation confirmRemovalOf: messageName on: self selectedClassOrMetaClass. confirmation = 3 ifTrue: [^ self]. self selectedClassOrMetaClass removeSelector: messageName. + self selectMessageNamed: nil. - self messageListIndex: 0. self changed: #messageList. self setClassOrganizer. "In case organization not cached" confirmation = 2 ifTrue: [self systemNavigation browseAllCallsOn: messageName]! Item was changed: ----- Method: Browser>>removeMessageCategory (in category 'message category functions') ----- removeMessageCategory "If a message category is selected, create a Confirmer so the user can verify that the currently selected message category should be removed from the system. If so, remove it." | messageCategoryName | + self hasMessageCategorySelected ifFalse: [^ self]. - messageCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. messageCategoryName := self selectedMessageCategoryName. (self messageList size = 0 or: [self confirm: 'Are you sure you want to remove this method category and all its methods?']) ifTrue: [self selectedClassOrMetaClass removeCategory: messageCategoryName. + self selectMessageCategoryNamed: nil. - self messageCategoryListIndex: 0. self changed: #classSelectionChanged]. self changed: #messageCategoryList. ! Item was changed: ----- Method: Browser>>removeSystemCategory (in category 'system category functions') ----- removeSystemCategory "If a class category is selected, create a Confirmer so the user can verify that the currently selected class category and all of its classes should be removed from the system. If so, remove it." + self hasSystemCategorySelected ifFalse: [^ self]. - systemCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (self classList size = 0 or: [self confirm: 'Are you sure you want to remove this system category and all its classes?']) ifTrue: + [systemOrganizer removeSystemCategory: self selectedSystemCategory. + self selectSystemCategory: nil. - [systemOrganizer removeSystemCategory: self selectedSystemCategoryName. - self systemCategoryListIndex: 0. self changed: #systemCategoryList]! Item was changed: ----- Method: Browser>>renameCategory (in category 'message category functions') ----- renameCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" + | oldName newName | + self hasClassSelected ifFalse: [^ self]. - | oldIndex oldName newName | - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. + self hasMessageCategorySelected ifFalse: [^ self]. + - (oldIndex := messageCategoryListIndex) = 0 ifTrue: [^ self]. oldName := self selectedMessageCategoryName. newName := self request: 'Please type new category name' initialAnswer: oldName. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. newName = oldName ifTrue: [^ self]. self classOrMetaClassOrganizer renameCategory: oldName toBe: newName. + self selectClassNamed: selectedClassName. + self selectMessageCategoryNamed: oldName. - self classListIndex: classListIndex. - self messageCategoryListIndex: oldIndex. self changed: #messageCategoryList. ! Item was changed: ----- Method: Browser>>renameClass (in category 'class functions') ----- renameClass | oldName newName obs | + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 - ifTrue: [^ self]. self okToChange ifFalse: [^ self]. oldName := self selectedClass name. newName := self request: 'Please type new class name' initialAnswer: oldName. newName = '' ifTrue: [^ self]. "Cancel returns ''" newName := newName asSymbol. newName = oldName ifTrue: [^ self]. (self selectedClass environment includesKey: newName) ifTrue: [^ self error: newName , ' already exists']. self selectedClass rename: newName. self changed: #classList. self classListIndex: (self classListIndexOf: newName). obs := self systemNavigation allCallsOn: (self selectedClass environment associationAt: newName). obs isEmpty ifFalse: [self systemNavigation browseMessageList: obs name: 'Obsolete References to ' , oldName autoSelect: oldName]! Item was changed: ----- Method: Browser>>renameSystemCategory (in category 'system category functions') ----- renameSystemCategory "Prompt for a new category name and add it before the current selection, or at the end if no current selection" + | oldSelection newName | + oldSelection := self selectedSystemCategory. + oldSelection isNil - | oldIndex oldName newName | - (oldIndex := systemCategoryListIndex) = 0 ifTrue: [^ self]. "no selection" self okToChange ifFalse: [^ self]. + - oldName := self selectedSystemCategoryName. newName := self request: 'Please type new category name' + initialAnswer: oldSelection. - initialAnswer: oldName. newName isEmpty ifTrue: [^ self] ifFalse: [newName := newName asSymbol]. + oldSelection = newName ifTrue: [^ self]. - oldName = newName ifTrue: [^ self]. systemOrganizer + renameCategory: oldSelection - renameCategory: oldName toBe: newName. + self selectSystemCategory: oldSelection. - self systemCategoryListIndex: oldIndex. self changed: #systemCategoryList.! Item was changed: ----- Method: Browser>>restoreToCategory:className:protocol:selector:mode:meta: (in category 'multi-window support') ----- restoreToCategory: category className: className protocol: protocol selector: selector mode: editMode meta: metaBool + self selectSystemCategory: category. - self systemCategoryListIndex: (self systemCategoryList indexOf: category). self classListIndex: (self classListIndexOf: className). self metaClassIndicated: metaBool. self messageCategoryListIndex: (self messageCategoryList indexOf: protocol). self messageListIndex: (self messageList indexOf: selector). editSelection := editMode. self contentsChanged; decorateButtons! Item was changed: ----- Method: Browser>>saveMultiWindowState (in category 'multi-window support') ----- saveMultiWindowState ^Message selector: #restoreToCategory:className:protocol:selector:mode:meta: + arguments: { self selectedSystemCategory. - arguments: { self selectedSystemCategoryName. self selectedClassName. self selectedMessageCategoryName. self selectedMessageName. self editSelection. self metaClassIndicated }! Item was changed: ----- Method: Browser>>selectCategoryForClass: (in category 'system category list') ----- selectCategoryForClass: theClass + self selectSystemCategory: theClass category.! - - self systemCategoryListIndex: (self systemCategoryList indexOf: theClass category) - ! Item was changed: ----- Method: Browser>>selectClass: (in category 'class list') ----- selectClass: classNotMeta + ^ self selectClassNamed: + (classNotMeta + ifNil: [ nil ] + ifNotNil: [ classNotMeta name ]).! - - self classListIndex: (self classListIndexOf: classNotMeta name)! Item was added: + ----- Method: Browser>>selectClassNamed: (in category 'class list') ----- + selectClassNamed: aSymbolOrString + | className currentMessageCategoryName currentMessageName | + currentMessageCategoryName := [self selectedMessageCategoryName] + on: Error + do: [:ex| ex return: nil]. + currentMessageName := [self selectedMessageName] + on: Error + do: [:ex| ex return: nil]. + + selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. + self setClassOrganizer. + + "Try to reselect the category and/or selector if the new class has them." + selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName) + ifTrue: [currentMessageCategoryName] + ifFalse: [nil]. + selectedMessageName := (self hasMessageCategorySelected + ifTrue: [ currentMessageName ] + ifFalse: [ nil ]). + + self hasMessageSelected ifTrue: + [self editSelection: #editMessage] ifFalse: + [self hasMessageCategorySelected ifTrue: + [self editSelection: #newMessage] ifFalse: + [self classCommentIndicated + ifTrue: [self editSelection: #editComment] + ifFalse: [self editSelection: (self hasClassSelected not + ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ]) + ifTrue: [#none] + ifFalse: [#newClass]] + ifFalse: [#editClass])]]]. + contents := nil. + self selectedClass isNil + ifFalse: [className := self selectedClass name. + (RecentClasses includes: className) + ifTrue: [RecentClasses remove: className]. + RecentClasses addFirst: className. + RecentClasses size > 16 + ifTrue: [RecentClasses removeLast]]. + self changed: #classSelectionChanged. + self changed: #classCommentText. + self changed: #classListIndex. "update my selection" + self changed: #messageCategoryList. + self changed: #messageList. + self changed: #relabel. + self contentsChanged! Item was changed: ----- Method: Browser>>selectMessageCategoryNamed: (in category 'message category list') ----- selectMessageCategoryNamed: aSymbol "Given aSymbol, select the category with that name. Do nothing if aSymbol doesn't exist." + selectedMessageCategoryName := aSymbol. + + selectedMessageName := nil. + self changed: #messageCategorySelectionChanged. + self changed: #messageCategoryListIndex. "update my selection" + self changed: #messageList. + self editSelection: (aSymbol notNil + ifTrue: [#newMessage] + ifFalse: [self hasClassSelected + ifTrue: [#editClass] + ifFalse: [#newClass]]). + contents := nil. + self contentsChanged.! - self messageCategoryListIndex: (self messageCategoryList indexOf: aSymbol ifAbsent: [ 1])! Item was added: + ----- Method: Browser>>selectMessageNamed: (in category 'message list') ----- + selectMessageNamed: aSymbolOrString + | name | + name := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. + selectedMessageName := name. + + self editSelection: (name notNil + ifTrue: [#editMessage] + ifFalse: [self messageCategoryListIndex > 0 + ifTrue: [#newMessage] + ifFalse: [self hasClassSelected + ifTrue: [#editClass] + ifFalse: [#newClass]]]). + contents := nil. + self changed: #messageListIndex. "update my selection" + self contentsChanged. + self decorateButtons.! Item was changed: ----- Method: Browser>>selectOriginalCategoryForCurrentMethod (in category 'message category list') ----- selectOriginalCategoryForCurrentMethod "private - Select the message category for the current method. Note: This should only be called when somebody tries to save a method that they are modifying while ALL is selected. Returns: true on success, false on failure." | aSymbol selectorName | aSymbol := self categoryOfCurrentMethod. selectorName := self selectedMessageName. (aSymbol notNil and: [aSymbol ~= ClassOrganizer allCategory]) ifTrue: + [selectedMessageCategoryName := aSymbol. + selectedMessageName := selectorName. - [messageCategoryListIndex := (self messageCategoryList indexOf: aSymbol). - messageListIndex := (self messageList indexOf: selectorName). self changed: #messageCategorySelectionChanged. self changed: #messageCategoryListIndex. "update my selection" self changed: #messageList. self changed: #messageListIndex. ^ true]. ^ false! Item was added: + ----- Method: Browser>>selectSystemCategory: (in category 'system category list') ----- + selectSystemCategory: aSymbol + "Set the selected system category. Update all other selections to be deselected." + + selectedSystemCategory := aSymbol. + selectedClassName := nil. + selectedMessageCategoryName := nil. + selectedMessageName := nil. + self editSelection: ( aSymbol isNil ifTrue: [#none] ifFalse: [#newClass]). + metaClassIndicated := false. + self setClassOrganizer. + contents := nil. + self changed: #systemCategorySelectionChanged. + self changed: #systemCategoryListIndex. "update my selection" + self changed: #classList. + self changed: #messageCategoryList. + self changed: #messageList. + self changed: #relabel. + self contentsChanged! Item was changed: ----- Method: Browser>>selectedClassName (in category 'class list') ----- selectedClassName + ^ selectedClassName.! - - | className | - className := self classList - at: classListIndex - ifAbsent: [^ nil]. - self class listClassesHierarchically ifTrue: [ - className := className withoutLeadingBlanks asSymbol]. - ^ className.! Item was changed: ----- Method: Browser>>selectedEnvironment (in category 'system category list') ----- selectedEnvironment "Answer the name of the selected system category or nil." + self hasSystemCategorySelected ifFalse: [^nil]. - systemCategoryListIndex = 0 ifTrue: [^nil]. ^ Smalltalk! Item was changed: ----- Method: Browser>>selectedMessageCategoryName (in category 'message category list') ----- selectedMessageCategoryName "Answer the name of the selected message category, if any. Answer nil otherwise." + ^ selectedMessageCategoryName! - messageCategoryListIndex = 0 ifTrue: [^nil]. - ^self messageCategoryList at: messageCategoryListIndex! Item was changed: ----- Method: Browser>>selectedMessageName (in category 'message list') ----- selectedMessageName "Answer the message selector of the currently selected message, if any. Answer nil otherwise." + ^ selectedMessageName.! - | aList | - messageListIndex = 0 ifTrue: [^ nil]. - ^ (aList := self messageList) size >= messageListIndex - ifTrue: - [aList at: messageListIndex] - ifFalse: - [nil]! Item was added: + ----- Method: Browser>>selectedSystemCategory (in category 'system category list') ----- + selectedSystemCategory + ^ selectedSystemCategory! Item was changed: ----- Method: Browser>>selectedSystemCategoryName (in category 'system category list') ----- selectedSystemCategoryName "Answer the name of the selected system category or nil." + ^ self selectedSystemCategory.! - systemCategoryListIndex = 0 ifTrue: [^nil]. - ^self systemCategoryList at: systemCategoryListIndex! Item was changed: ----- Method: Browser>>setClassOrganizer (in category 'metaclass') ----- setClassOrganizer "Install whatever organization is appropriate" | theClass | classOrganizer := nil. metaClassOrganizer := nil. + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. theClass := self selectedClass ifNil: [ ^self ]. classOrganizer := theClass organization. metaClassOrganizer := theClass classSide organization.! Item was changed: ----- Method: Browser>>setOriginalCategoryIndexForCurrentMethod (in category 'message category list') ----- setOriginalCategoryIndexForCurrentMethod "private - Set the message category index for the currently selected method. Note: This should only be called when somebody tries to save a method that they are modifying while ALL is selected." + selectedMessageCategoryName := self categoryOfCurrentMethod.! - messageCategoryListIndex := self messageCategoryList indexOf: self categoryOfCurrentMethod - ! Item was changed: ----- Method: Browser>>spawn: (in category 'accessing') ----- 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: + ["This choice is slightly useless but is the historical implementation" + ^ self buildSystemCategoryBrowserEditString: aString]. - systemCategoryListIndex ~= 0 - ifTrue: - ["This choice is slightly useless but is the historical implementation" - ^ self buildSystemCategoryBrowserEditString: aString]. ^ super spawn: aString "This bail-out at least saves the text being spawned, which would otherwise be lost"! Item was changed: ----- Method: Browser>>systemCategoryListIndex (in category 'system category list') ----- systemCategoryListIndex "Answer the index of the selected class category." + ^ self systemCategoryList indexOf: self selectedSystemCategory.! - ^systemCategoryListIndex! Item was changed: ----- Method: Browser>>systemCategoryListIndex: (in category 'system category list') ----- systemCategoryListIndex: anInteger "Set the selected system category index to be anInteger. Update all other selections to be deselected." + + self selectSystemCategory: (self systemCategoryList at: anInteger ifAbsent: [ nil ])! - - systemCategoryListIndex := anInteger. - classListIndex := 0. - messageCategoryListIndex := 0. - messageListIndex := 0. - self editSelection: ( anInteger = 0 ifTrue: [#none] ifFalse: [#newClass]). - metaClassIndicated := false. - self setClassOrganizer. - contents := nil. - self changed: #systemCategorySelectionChanged. - self changed: #systemCategoryListIndex. "update my selection" - self changed: #classList. - self changed: #messageCategoryList. - self changed: #messageList. - self changed: #relabel. - self contentsChanged! Item was changed: ----- Method: Browser>>systemCategorySingleton (in category 'system category list') ----- systemCategorySingleton | cat | + cat := self selectedSystemCategory. - cat := self selectedSystemCategoryName. ^ cat ifNil: [Array new] ifNotNil: [Array with: cat]! Item was changed: ----- Method: Browser>>systemOrganizer: (in category 'initialize-release') ----- systemOrganizer: aSystemOrganizer "Initialize the receiver as a perspective on the system organizer, aSystemOrganizer. Typically there is only one--the system variable SystemOrganization." contents := nil. systemOrganizer := aSystemOrganizer. + selectedSystemCategory := nil. + selectedMessageCategoryName := nil. + selectedClassName := nil. + selectedMessageName := nil. - systemCategoryListIndex := 0. - classListIndex := 0. - messageCategoryListIndex := 0. - messageListIndex := 0. metaClassIndicated := false. self setClassOrganizer. self editSelection: #none.! Item was removed: - ----- Method: Browser>>toggleClassListIndex: (in category 'class list') ----- - toggleClassListIndex: anInteger - "If anInteger is the current class index, deselect it. Else make it the - current class selection." - - self classListIndex: - (classListIndex = anInteger - ifTrue: [0] - ifFalse: [anInteger])! Item was removed: - ----- Method: Browser>>toggleMessageCategoryListIndex: (in category 'message category list') ----- - toggleMessageCategoryListIndex: anInteger - "If the currently selected message category index is anInteger, deselect - the category. Otherwise select the category whose index is anInteger." - - self messageCategoryListIndex: - (messageCategoryListIndex = anInteger - ifTrue: [0] - ifFalse: [anInteger])! Item was removed: - ----- Method: Browser>>toggleMessageListIndex: (in category 'message list') ----- - toggleMessageListIndex: anInteger - "If the currently selected message index is anInteger, deselect the message - selector. Otherwise select the message selector whose index is anInteger." - - self messageListIndex: - (messageListIndex = anInteger - ifTrue: [0] - ifFalse: [anInteger])! Item was removed: - ----- Method: Browser>>toggleSystemCategoryListIndex: (in category 'system category list') ----- - toggleSystemCategoryListIndex: anInteger - "If anInteger is the current system category index, deselect it. Else make - it the current system category selection." - - self systemCategoryListIndex: - (systemCategoryListIndex = anInteger - ifTrue: [0] - ifFalse: [anInteger])! Item was changed: ----- Method: Browser>>veryDeepInner: (in category 'copying') ----- veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. See DeepCopier class comment." super veryDeepInner: deepCopier. "systemOrganizer := systemOrganizer. clone has the old value. we share it" "classOrganizer := classOrganizer clone has the old value. we share it" "metaClassOrganizer := metaClassOrganizer clone has the old value. we share it" + selectedSystemCategory := selectedSystemCategory veryDeepCopyWith: deepCopier. + selectedClassName := selectedClassName veryDeepCopyWith: deepCopier. + selectedMessageCategoryName := selectedMessageCategoryName veryDeepCopyWith: deepCopier. + selectedMessageName := selectedMessageName veryDeepCopyWith: deepCopier. - systemCategoryListIndex := systemCategoryListIndex veryDeepCopyWith: deepCopier. - classListIndex := classListIndex veryDeepCopyWith: deepCopier. - messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier. - messageListIndex := messageListIndex veryDeepCopyWith: deepCopier. editSelection := editSelection veryDeepCopyWith: deepCopier. metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier. ! Item was changed: ----- Method: ClassListBrowser>>initForClassesNamed:title: (in category 'initialization') ----- initForClassesNamed: nameList title: aTitle "Initialize the receiver for the class-name-list and title provided" self systemOrganizer: SystemOrganization. metaClassIndicated := false. defaultTitle := aTitle. + classDisplayList := nameList copy. - classList := nameList copy. self class openBrowserView: (self openSystemCatEditString: nil) label: aTitle "ClassListBrowser new initForClassesNamed: #(Browser CategoryViewer) title: 'Frogs'"! Item was changed: ----- Method: CodeHolder>>spawn: (in category 'commands') ----- 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" | newBrowser 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: [newBrowser := Browser new setClass: aClass selector: self selectedMessageName. self suggestCategoryToSpawnedBrowser: newBrowser. + ^ Browser openBrowserView: (newBrowser openMessageCatEditString: aString) - Browser openBrowserView: (newBrowser openMessageCatEditString: aString) label: 'category "', aCategory, '" in ', newBrowser selectedClassOrMetaClassName]! Item was changed: ----- Method: CodeHolder>>spawnHierarchy (in category 'traits') ----- spawnHierarchy "Create and schedule a new hierarchy browser on the currently selected class or meta." | newBrowser aSymbol aBehavior messageCatIndex selectedClassOrMetaClass | (selectedClassOrMetaClass := self selectedClassOrMetaClass) ifNil: [^ self]. selectedClassOrMetaClass isTrait ifTrue: [^self]. newBrowser := HierarchyBrowser new initHierarchyForClass: selectedClassOrMetaClass. ((aSymbol := self selectedMessageName) notNil and: [(MessageSet isPseudoSelector: aSymbol) not]) ifTrue: [aBehavior := selectedClassOrMetaClass. messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol. newBrowser messageCategoryListIndex: messageCatIndex + 1. newBrowser messageListIndex: ((aBehavior organization listAtCategoryNumber: messageCatIndex) indexOf: aSymbol)]. Browser openBrowserView: (newBrowser openSystemCatEditString: nil) label: newBrowser labelString. Smalltalk isMorphic ifTrue: ["this workaround only needed in morphic" + newBrowser assureSelectionsShow]. + ^ newBrowser.! - newBrowser assureSelectionsShow]! Item was changed: ----- Method: FileContentsBrowser>>browseSenders (in category 'other') ----- browseSenders "Create and schedule a message set browser on all senders of the currently selected message selector. Do nothing if no message is selected." + self hasMessageSelected - messageListIndex ~= 0 ifTrue: [self systemNavigation browseAllCallsOn: self selectedMessageName]! Item was changed: ----- Method: FileContentsBrowser>>changeMessageCategories: (in category 'other') ----- changeMessageCategories: aString "The characters in aString represent an edited version of the the message categories for the selected class. Update this information in the system and inform any dependents that the categories have been changed. This message is invoked because the user had issued the categories command and edited the message categories. Then the user issued the accept command." self classOrMetaClassOrganizer changeFromString: aString. self unlock. self editClass. + self selectClassNamed: selectedClassName. - self classListIndex: classListIndex. ^ true! Item was changed: ----- Method: FileContentsBrowser>>classList (in category 'class list') ----- classList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." + (self hasSystemCategorySelected not or:[self selectedPackage isNil]) - (systemCategoryListIndex = 0 or:[self selectedPackage isNil]) ifTrue: [^Array new] ifFalse: [^self selectedPackage classes keys asArray sort].! Item was changed: ----- Method: FileContentsBrowser>>findClass (in category 'class list') ----- findClass | pattern foundClass classNames index foundPackage | self okToChange ifFalse: [^ self classNotFound]. pattern := (UIManager default request: 'Class Name?') asLowercase. pattern isEmpty ifTrue: [^ self]. classNames := Set new. self packages do:[:p| classNames addAll: p classes keys]. classNames := classNames asArray select: [:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0]. classNames isEmpty ifTrue: [^ self]. index := classNames size = 1 ifTrue: [1] ifFalse: [(UIManager default chooseFrom: classNames lines: #())]. index = 0 ifTrue: [^ self]. foundPackage := nil. foundClass := nil. self packages do:[:p| (p classes includesKey: (classNames at: index)) ifTrue:[ foundClass := p classes at: (classNames at: index). foundPackage := p]]. foundClass isNil ifTrue:[^self]. + self selectSystemCategory: foundPackage packageName asSymbol. - self systemCategoryListIndex: (self systemCategoryList indexOf: foundPackage packageName asSymbol). self classListIndex: (self classList indexOf: foundClass name). ! Item was changed: ----- Method: FileContentsBrowser>>labelString (in category 'other') ----- labelString "Answer the string for the window title" + ^ 'File Contents Browser ', (self selectedSystemCategory ifNil: [''])! - ^ 'File Contents Browser ', (self selectedSystemCategoryName ifNil: [''])! Item was changed: ----- Method: FileContentsBrowser>>removeClass (in category 'removing') ----- removeClass | class | + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. class := self selectedClass. (self confirm:'Are you certain that you want to delete the class ', class name, '?') ifFalse:[^self]. self selectedPackage removeClass: class. self classListIndex: 0. self changed: #classList.! Item was changed: ----- Method: FileContentsBrowser>>removeMessage (in category 'removing') ----- removeMessage | messageName | + self hasMessageSelected + ifFalse: [^ self]. - messageListIndex = 0 - ifTrue: [^ self]. self okToChange ifFalse: [^ self]. messageName := self selectedMessageName. (self selectedClass confirmRemovalOf: messageName) ifFalse: [^ false]. self selectedClassOrMetaClass removeMethod: self selectedMessageName. + self selectMessageNamed: nil. - self messageListIndex: 0. self setClassOrganizer. "In case organization not cached" self changed: #messageList! Item was changed: ----- Method: FileContentsBrowser>>removeMessageCategory (in category 'removing') ----- removeMessageCategory "If a message category is selected, create a Confirmer so the user can verify that the currently selected message category should be removed from the system. If so, remove it." | messageCategoryName | + self hasMessageCategorySelected ifFalse: [^ self]. - messageCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. messageCategoryName := self selectedMessageCategoryName. (self messageList size = 0 or: [self confirm: 'Are you sure you want to remove this method category and all its methods?']) ifFalse: [^ self]. self selectedClassOrMetaClass removeCategory: messageCategoryName. self messageCategoryListIndex: 0. self changed: #messageCategoryList.! Item was changed: ----- Method: FileContentsBrowser>>removePackage (in category 'removing') ----- removePackage + self hasSystemCategorySelected ifTrue: [^ self]. - systemCategoryListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. (self confirm: 'Are you sure you want to remove this package and all its classes?') ifFalse:[^self]. + (systemOrganizer listAtCategoryNamed: self selectedSystemCategory) do:[:el| - (systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) do:[:el| systemOrganizer removeElement: el]. self packages removeKey: self selectedPackage packageName. + systemOrganizer removeCategory: self selectedSystemCategory. + self selectSystemCategory: nil. - systemOrganizer removeCategory: self selectedSystemCategoryName. - self systemCategoryListIndex: 0. self changed: #systemCategoryList! Item was changed: ----- Method: FileContentsBrowser>>renameClass (in category 'class list') ----- renameClass | oldName newName | + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. oldName := self selectedClass name. newName := (self request: 'Please type new class name' initialAnswer: oldName) asSymbol. (newName isEmpty or:[newName = oldName]) ifTrue: [^ self]. (self selectedPackage classes includesKey: newName) ifTrue: [^ self error: newName , ' already exists in the package']. + systemOrganizer classify: newName under: self selectedSystemCategory. - systemOrganizer classify: newName under: self selectedSystemCategoryName. systemOrganizer removeElement: oldName. self selectedPackage renameClass: self selectedClass to: newName. self changed: #classList. + self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategory) indexOf: newName). - self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName). ! Item was changed: ----- Method: FileContentsBrowser>>selectedPackage (in category 'accessing') ----- selectedPackage | cat | + cat := self selectedSystemCategory. - cat := self selectedSystemCategoryName. cat isNil ifTrue:[^nil]. ^self packages at: cat asString ifAbsent:[nil]! Item was changed: ----- Method: FileContentsBrowser>>setClassOrganizer (in category 'metaclass') ----- setClassOrganizer "Install whatever organization is appropriate" | theClass | classOrganizer := nil. metaClassOrganizer := nil. + self hasClassSelected ifFalse: [^ self]. - classListIndex = 0 ifTrue: [^ self]. classOrganizer := (theClass := self selectedClass) organization. metaClassOrganizer := theClass metaClass organization. ! Item was changed: Browser subclass: #HierarchyBrowser + instanceVariableNames: 'classDisplayList centralClass' - instanceVariableNames: 'classList centralClass' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! + + !HierarchyBrowser commentStamp: 'fbs 3/9/2011 12:02' prior: 0! + I provide facilities to explore classes in the context of their subclass hierarchy. + + My classDisplayList instvar uses indentation to show the subclassing relationship between the displayed classes. + ! Item was changed: ----- Method: HierarchyBrowser>>assureSelectionsShow (in category 'class list') ----- assureSelectionsShow "This is a workaround for the fact that a hierarchy browser, when launched, often does not show the selected class" + | saveMsgName saveCatName | + saveCatName := self selectedMessageCategoryName. + saveMsgName := self selectedMessageName. + self selectClassNamed: selectedClassName. + self selectMessageCategoryNamed: saveCatName. + self selectMessageNamed: saveMsgName! - | saveCatIndex saveMsgIndex | - saveCatIndex := messageCategoryListIndex. - saveMsgIndex := messageListIndex. - self classListIndex: classListIndex. - self messageCategoryListIndex: saveCatIndex. - self messageListIndex: saveMsgIndex! Item was changed: ----- Method: HierarchyBrowser>>classList (in category 'class list') ----- classList + classDisplayList := classDisplayList select: [:each | Smalltalk includesKey: each withBlanksTrimmed asSymbol]. + ^ classDisplayList! - classList := classList select: [:each | Smalltalk includesKey: each withBlanksTrimmed asSymbol]. - ^ classList! Item was changed: ----- Method: HierarchyBrowser>>classListIndex: (in category 'initialization') ----- classListIndex: newIndex "Cause system organization to reflect appropriate category" | newClassName ind | newIndex ~= 0 ifTrue: + [newClassName := (classDisplayList at: newIndex) copyWithout: $ . + selectedSystemCategory := (systemOrganizer categories at: + (systemOrganizer numberOfCategoryOfElement: newClassName))]. - [newClassName := (classList at: newIndex) copyWithout: $ . - systemCategoryListIndex := - systemOrganizer numberOfCategoryOfElement: newClassName]. ind := super classListIndex: newIndex. + + "What I'd like to write:" + "self selectedClassName ifNotNil: + [ selectedSystemCategory := self selectedClass category ]." self changed: #systemCategorySingleton. ^ ind! Item was changed: ----- Method: HierarchyBrowser>>initAlphabeticListing (in category 'initialization') ----- initAlphabeticListing | tab stab index | self systemOrganizer: SystemOrganization. metaClassIndicated := false. + classDisplayList := Smalltalk classNames.! - classList := Smalltalk classNames.! Item was changed: ----- Method: HierarchyBrowser>>initHierarchyForClass: (in category 'initialization') ----- initHierarchyForClass: aClassOrMetaClass + | nonMetaClass | - | index nonMetaClass tab | centralClass := aClassOrMetaClass. nonMetaClass := aClassOrMetaClass theNonMetaClass. self systemOrganizer: SystemOrganization. metaClassIndicated := aClassOrMetaClass isMeta. + classDisplayList := OrderedCollection new. + self + flattenHierarchyTree: (self createHierarchyTreeOf: (nonMetaClass allSuperclasses, { nonMetaClass }, nonMetaClass allSubclasses)) + on: classDisplayList + indent: '' + by: ' '. + + self selectClass: nonMetaClass.! - classList := OrderedCollection new. - tab := ''. - nonMetaClass allSuperclasses reverseDo: - [:aClass | - classList add: tab , aClass name. - tab := tab , ' ']. - index := classList size + 1. - nonMetaClass allSubclassesWithLevelDo: - [:aClass :level | | stab | - stab := ''. 1 to: level do: [:i | stab := stab , ' ']. - classList add: tab , stab , aClass name] - startingLevel: 0. - self classListIndex: index! Item was removed: - ----- Method: HierarchyBrowser>>selectClass: (in category 'initialization') ----- - selectClass: classNotMeta - | name | - name := classNotMeta name. - self classListIndex: (self classList findFirst: - [:each | (each endsWith: name) - and: [each size = name size - or: [(each at: each size - name size) isSeparator]]])! Item was added: + ----- Method: HierarchyBrowser>>selectClassNamed: (in category 'initialization') ----- + selectClassNamed: aSymbolOrString + | newClassName | + newClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. + selectedSystemCategory := (systemOrganizer categories at: + (systemOrganizer numberOfCategoryOfElement: newClassName) ifAbsent: [ nil ]). + + super selectClassNamed: newClassName. + self changed: #systemCategorySingleton. + + ^ newClassName.! Item was changed: ----- Method: HierarchyBrowser>>selectedClassName (in category 'initialization') ----- selectedClassName "Answer the name of the class currently selected. di bug fix for the case where name cannot be found -- return nil rather than halt" | aName | + aName := super selectedClassName. + aName ifNil: [ ^ nil ]. - aName := self classList at: classListIndex ifAbsent: [^ nil]. ^ (aName copyWithout: Character space) asSymbol! Item was changed: ----- Method: MessageNames class>>openMessageNames (in category 'instance creation') ----- openMessageNames "Open a new instance of the receiver in the active world" + ^(ToolBuilder open: self new label: 'Message Names') model - ^ToolBuilder open: self new label: 'Message Names' "MessageNames openMessageNames" ! Item was changed: ----- Method: MessageNames>>selectedClassOrMetaClass (in category 'class list') ----- selectedClassOrMetaClass "Answer the currently selected class (or metaclass)." + self hasMessageSelected ifTrue: + [ ^ self setClassAndSelectorIn: [:c :s | ^c] ]. + - messageListIndex > 0 ifTrue: [ - ^ self setClassAndSelectorIn: [:c :s | ^c]]. (selectorListIndex isNil not and: [selectorListIndex > 0]) ifTrue: [^Smalltalk classNamed: (self selectorList at: selectorListIndex)]. ^ nil. ! Item was changed: ----- Method: MessageNames>>selectedMessageName (in category 'selection') ----- selectedMessageName + selectorList ifNil: [^ nil]. + ^selectorListIndex = 0 ifFalse: [selectorList at: selectorListIndex ifAbsent: [nil]]! - ^selectorListIndex = 0 ifFalse: [selectorList at: selectorListIndex]! Item was removed: - ----- Method: MessageNames>>selection (in category 'selection') ----- - selection - "Answer the item in the list that is currently selected, or nil if no selection is present" - - ^ messageListIndex = 0 - ifTrue: [self selectorList at: selectorListIndex ifAbsent: [nil]] - ifFalse: [self messageList at: messageListIndex ifAbsent: [nil]].! Item was changed: Browser subclass: #MessageSet + instanceVariableNames: 'growable messageList autoSelectString messageListIndex' - instanceVariableNames: 'messageList autoSelectString growable' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !MessageSet commentStamp: '<historical>' prior: 0! I represent a query path of the retrieval result of making a query about methods in the system. The result is a set of methods, denoted by a message selector and the class in which the method was found. As a StringHolder, the string I represent is the source code of the currently selected method. I am typically viewed in a Message Set Browser consisting of a MessageListView and a BrowserCodeView.! Item was added: + ----- Method: MessageSet>>compileMessage:notifying: (in category 'as yet unclassified') ----- + compileMessage: aText notifying: aController + "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." + "Copied from Browser's version of sd 11/20/2005 21:26 because later versions remove messageListIndex." + + | fallBackCategoryName fallBackMethodIndex originalSelectorName result | + + self selectedMessageCategoryName ifNil: + [ self selectOriginalCategoryForCurrentMethod + ifFalse:["Select the '--all--' category" + self messageCategoryListIndex: 1]]. + + + self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory + ifTrue: + [ "User tried to save a method while the ALL category was selected" + fallBackCategoryName := selectedMessageCategoryName. + fallBackMethodIndex := messageListIndex. + editSelection == #newMessage + ifTrue: + [ "Select the 'as yet unclassified' category" + selectedMessageCategoryName := nil. + (result := self defineMessageFrom: aText notifying: aController) + ifNil: + ["Compilation failure: reselect the original category & method" + selectedMessageCategoryName := fallBackCategoryName. + messageListIndex := fallBackMethodIndex] + ifNotNil: + [self setSelector: result]] + ifFalse: + [originalSelectorName := self selectedMessageName. + self setOriginalCategoryIndexForCurrentMethod. + messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName. + (result := self defineMessageFrom: aText notifying: aController) + ifNotNil: + [self setSelector: result] + ifNil: + [ "Compilation failure: reselect the original category & method" + selectedMessageCategoryName := fallBackCategoryName. + messageListIndex := fallBackMethodIndex. + ^ result notNil]]. + self changed: #messageCategoryList. + ^ result notNil] + ifFalse: + [ "User tried to save a method while the ALL category was NOT selected" + ^ (self defineMessageFrom: aText notifying: aController) notNil]! Item was changed: ----- Method: MessageSet>>contents (in category 'contents') ----- contents "Answer the contents of the receiver" ^ contents == nil ifTrue: [currentCompiledMethod := nil. ''] + ifFalse: [self hasMessageSelected + ifTrue: [self editContents] + ifFalse: [currentCompiledMethod := nil. contents]]! - ifFalse: [messageListIndex = 0 - ifTrue: [currentCompiledMethod := nil. contents] - ifFalse: [self editContents]]! Item was added: + ----- Method: MessageSet>>hasMessageSelected (in category 'message list') ----- + hasMessageSelected + ^ messageListIndex ~= 0.! Item was changed: ----- Method: MessageSet>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray "Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses." messageList := OrderedCollection new. anArray do: [ :each | MessageSet parse: each toClassAndSelector: [ :class :sel | | s | class ifNotNil: [class isUniClass ifTrue: [s := class typicalInstanceName, ' ', sel] ifFalse: [s := class name , ' ' , sel , ' {' , ((class organization categoryOfElement: sel) ifNil: ['']) , '}']. messageList add: ( MethodReference new setClass: class methodSymbol: sel stringVersion: s)]]]. messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1]. + selectedMessageName := messageList isEmpty ifTrue: [nil] ifFalse: [messageList first selector]. contents := ''! Item was added: + ----- Method: MessageSet>>lastMessageName (in category 'message list') ----- + lastMessageName + ^ self messageList last selector.! Item was added: + ----- Method: MessageSet>>messageListIndex (in category 'message list') ----- + messageListIndex + ^messageListIndex ifNil: [0]! Item was changed: ----- Method: MessageSet>>messageListIndex: (in category 'message list') ----- + messageListIndex: anInteger + "Set the selected message selector to be the one indexed by anInteger." - messageListIndex: anInteger - "Set the index of the selected item to be anInteger." - messageListIndex := anInteger. + + self editSelection: (anInteger > 0 + ifTrue: [#editMessage] + ifFalse: [self messageCategoryListIndex > 0 + ifTrue: [#newMessage] + ifFalse: [self hasClassSelected + ifTrue: [#editClass] + ifFalse: [#newClass]]]). + contents := ''. + self changed: #messageListIndex. "update my selection" - contents := - messageListIndex ~= 0 - ifTrue: [self selectedMessage] - ifFalse: ['']. - self changed: #messageListIndex. "update my selection" - self editSelection: #editMessage. self contentsChanged. + self decorateButtons.! - (messageListIndex ~= 0 and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. - self decorateButtons - ! Item was added: + ----- Method: MessageSet>>messageListIndexOf: (in category 'message list') ----- + messageListIndexOf: aString + ^ (self messageList collect: [:each | each selector]) indexOf: aString.! Item was changed: ----- Method: MessageSet>>removeMessage (in category 'message functions') ----- removeMessage "Remove the selected message from the system. 1/15/96 sw" | messageName confirmation | + self hasMessageSelected + ifFalse: [^ self]. - messageListIndex = 0 - ifTrue: [^ self]. self okToChange ifFalse: [^ self]. messageName := self selectedMessageName. confirmation := self systemNavigation confirmRemovalOf: messageName on: self selectedClassOrMetaClass. confirmation = 3 ifTrue: [^ self]. self selectedClassOrMetaClass removeSelector: messageName. self deleteFromMessageList: self selection. self reformulateList. confirmation = 2 ifTrue: [self systemNavigation browseAllCallsOn: messageName]! Item was changed: ----- Method: MessageSet>>removeMessageFromBrowser (in category 'message functions') ----- removeMessageFromBrowser "Remove the selected message from the browser." + self hasMessageSelected ifFalse: [^ self]. - messageListIndex = 0 ifTrue: [^ self]. self deleteFromMessageList: self selection. self reformulateList. self adjustWindowTitleAfterFiltering ! Item was added: + ----- Method: MessageSet>>selectMessageNamed: (in category 'message list') ----- + selectMessageNamed: aSymbolOrString + super selectMessageNamed: aSymbolOrString. + + contents := + selectedMessageName notNil + ifTrue: [self selectedMessage] + ifFalse: ['']. + self changed: #messageListIndex. "update my selection" + self editSelection: #editMessage. + self contentsChanged. + (selectedMessageName notNil and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. + self decorateButtons! Item was changed: ----- Method: MessageSet>>selectedClassOrMetaClass (in category 'class list') ----- selectedClassOrMetaClass "Answer the currently selected class (or metaclass)." + self hasMessageSelected ifFalse: [^nil]. - messageListIndex = 0 ifTrue: [^nil]. self setClassAndSelectorIn: [:c :s | ^c]! Item was changed: + ----- Method: MessageSet>>selectedMessage (in category 'message list') ----- - ----- Method: MessageSet>>selectedMessage (in category 'contents') ----- selectedMessage "Answer the source method for the currently selected message." self setClassAndSelectorIn: [:class :selector | | source | class ifNil: [^ 'Class vanished']. selector first isUppercase ifTrue: [selector == #Comment ifTrue: [currentCompiledMethod := class organization commentRemoteStr. ^ class comment]. selector == #Definition ifTrue: [^ class definition]. selector == #Hierarchy ifTrue: [^ class printHierarchy]]. source := class sourceMethodAt: selector ifAbsent: [currentCompiledMethod := nil. ^ 'Missing']. self showingDecompile ifTrue: [^ self decompiledSourceIntoContents]. currentCompiledMethod := class compiledMethodAt: selector ifAbsent: [nil]. self showingDocumentation ifTrue: [^ self commentContents]. source := self sourceStringPrettifiedAndDiffed. ^ source asText makeSelectorBoldIn: class]! Item was changed: ----- Method: MessageSet>>selectedMessageCategoryName (in category 'class list') ----- selectedMessageCategoryName "Answer the name of the selected message category or nil." + | cls | + self hasMessageSelected ifFalse: [^ nil]. + cls := self selectedClassOrMetaClass. + + cls ifNil: [^ nil]. + + ^ cls organization categoryOfElement: self selectedMessageName! - messageListIndex = 0 ifTrue: [^ nil]. - ^ self selectedClassOrMetaClass organization categoryOfElement: self selectedMessageName! Item was changed: ----- Method: MessageSet>>selectedMessageName (in category 'message list') ----- selectedMessageName "Answer the name of the currently selected message." "wod 6/16/1998: answer nil if none are selected." messageListIndex = 0 ifTrue: [^ nil]. ^ self setClassAndSelectorIn: [:class :selector | ^ selector]! Item was changed: ----- Method: MessageSet>>selection (in category 'private') ----- selection "Answer the item in the list that is currently selected, or nil if no selection is present" + ^ self messageList at: (self messageListIndex) ifAbsent: [nil]! - ^ messageList at: messageListIndex ifAbsent: [nil]! Item was added: + ----- Method: MessageSet>>systemOrganizer: (in category 'as yet unclassified') ----- + systemOrganizer: aSystemOrganizer + + messageListIndex := 0. + ^ super systemOrganizer: aSystemOrganizer.! Item was added: + ----- Method: MessageSet>>veryDeepInner: (in category 'as yet unclassified') ----- + veryDeepInner: deepCopier + "Copy all of my instance variables. Some need to be not copied at all, but shared. See DeepCopier class comment." + + super veryDeepInner: deepCopier. + messageListIndex := messageListIndex veryDeepCopyWith: deepCopier.! Item was changed: ----- Method: MessageTrace>>removeMessageFromBrowser (in category 'building') ----- removeMessageFromBrowser | indexToSelect | + self hasMessageSelected ifFalse: [^ self]. "Try to keep the same selection index." indexToSelect := (messageSelections indexOf: true) max: 1. self selectedMessages do: [ :eachMethodReference | self deleteFromMessageList: eachMethodReference ]. self deselectAll. messageSelections ifNotEmpty: [ messageSelections at: (indexToSelect min: messageSelections size) "safety" put: true ]. anchorIndex := indexToSelect min: messageSelections size. self messageListIndex: anchorIndex ; reformulateList! Item was changed: ----- Method: PackagePaneBrowser>>classList (in category 'class list') ----- classList "Answer an array of the class names of the selected category. Answer an empty array if no selection exists." ^ self hasSystemCategorySelected + ifFalse: [self packageClasses] + ifTrue: [systemOrganizer listAtCategoryNamed: self selectedSystemCategory]! - ifFalse: - [self packageClasses] - ifTrue: [systemOrganizer listAtCategoryNumber: - (systemOrganizer categories indexOf: self selectedSystemCategoryName asSymbol)]! Item was changed: ----- Method: PackagePaneBrowser>>dstCategoryDstListMorph:internal: (in category 'dragNDrop util') ----- dstCategoryDstListMorph: dstListMorph internal: internal | dropItem | ^ internal & (dstListMorph getListSelector == #systemCategoryList) ifTrue: [(dropItem := dstListMorph potentialDropItem) ifNotNil: [(self package , '-' , dropItem) asSymbol]] + ifFalse: [self selectedSystemCategory]! - ifFalse: [self selectedSystemCategoryName]! Item was removed: - ----- Method: PackagePaneBrowser>>hasSystemCategorySelected (in category 'system category list') ----- - hasSystemCategorySelected - ^ systemCategoryListIndex ~= 0! Item was changed: ----- Method: PackagePaneBrowser>>multiWindowName (in category 'multi-window support') ----- multiWindowName "Answer the string to display for the receiver in a multi-window." ^String streamContents: [:s| | str | self package ifNil: [s nextPut: $a; space; nextPutAll: self defaultBrowserTitle] ifNotNil: [:pkg| self selectedClass + ifNil: [self selectedSystemCategory - ifNil: [self selectedSystemCategoryName ifNil: [s nextPutAll: pkg] ifNotNil: [:cat| s nextPutAll: cat]] ifNotNil: [:class| s nextPutAll: pkg; space; print: class. self metaClassIndicated ifTrue: [s nextPutAll: ' class']]]. (str := self selectedMessageName) notNil ifTrue: [s nextPutAll: '>>'; nextPutAll: str] ifFalse: [(str := self selectedMessageCategoryName) notNil ifTrue: [s space; nextPut: ${; nextPutAll: str; nextPut: $}]]]! Item was changed: ----- Method: PackagePaneBrowser>>packageListIndex: (in category 'package list') ----- packageListIndex: anInteger "Set anInteger to be the index of the current package selection." packageListIndex := anInteger. anInteger = 0 ifFalse: [package := self packageList at: packageListIndex]. + selectedMessageCategoryName := nil. + self selectSystemCategory: nil. + selectedMessageName := nil. + selectedClassName := nil. - messageCategoryListIndex := 0. - systemCategoryListIndex := 0. - messageListIndex := 0. - classListIndex := 0. self setClassOrganizer. self changed: #packageSelectionChanged. self changed: #packageListIndex. "update my selection" self changed: #systemCategoryList. "update the category list" + self selectSystemCategory: nil. "update category list selection" - self systemCategoryListIndex: 0. "update category list selection" ! Item was changed: ----- Method: PackagePaneBrowser>>saveMultiWindowState (in category 'multi-window support') ----- saveMultiWindowState ^Message selector: #restoreToPackage:category:className:protocol:selector:mode:meta: arguments: { self package. + self selectedSystemCategory. - self systemCategoryList at: systemCategoryListIndex ifAbsent: []. self selectedClassName. self selectedMessageCategoryName. self selectedMessageName. self editSelection. self metaClassIndicated }! Item was changed: ----- Method: PackagePaneBrowser>>selectCategoryForClass: (in category 'system category list') ----- selectCategoryForClass: theClass "Set the package and category lists to display the given class." + | cat catName | - | cat | cat := theClass category. + self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)). + catName := (cat copyFrom: ((cat indexOf: $- ifAbsent: [0]) + 1) to: cat size). + self selectSystemCategory: catName.! - self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)). - self systemCategoryListIndex: (self systemCategoryList indexOf: - (cat copyFrom: ((cat indexOf: $- ifAbsent: [0]) + 1) to: cat size)).! Item was changed: ----- Method: PackagePaneBrowser>>selectedSystemCategoryName (in category 'system category list') ----- selectedSystemCategoryName "Answer the name of the selected system category or nil." + self hasSystemCategorySelected + ifFalse: [^nil]. - systemCategoryListIndex = 0 - ifTrue: [^nil]. packageListIndex = 0 + ifTrue: [^ self selectedSystemCategory ]. + ^ self package , '-' , self selectedSystemCategory! - ifTrue: [^ self systemCategoryList at: systemCategoryListIndex]. - ^ self package , '-' , (self systemCategoryList at: systemCategoryListIndex)! Item was changed: ----- Method: ParagraphEditor>>browseItHere (in category '*Tools') ----- browseItHere "Retarget the receiver's window to look at the selected class, if appropriate. 3/1/96 sw" | aSymbol b | (((b := model) isKindOf: Browser) and: [b couldBrowseAnyClass]) ifFalse: [^ view flash]. model okToChange ifFalse: [^ view flash]. self selectionInterval isEmpty ifTrue: [self selectWord]. (aSymbol := self selectedSymbol) ifNil: [^ view flash]. self terminateAndInitializeAround: [| foundClass | foundClass := (Smalltalk at: aSymbol ifAbsent: [nil]). foundClass ifNil: [^ view flash]. (foundClass isKindOf: Class) ifTrue: + [model selectSystemCategory: foundClass category. - [model systemCategoryListIndex: - (model systemCategoryList indexOf: foundClass category). model classListIndex: (model classList indexOf: foundClass name)]]! Item was changed: ----- Method: TimeProfileBrowser>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray messageList := anArray. messageListIndex := 0. + selectedMessageName := nil. contents := ''!
More information about the Squeak-dev mailing list |