'From Squeak3.2alpha of 3 October 2001 [latest update: #4461] on 29 October 2001 at 6:04:24 pm'! "Change Set: deeperChangeCategory-sw Date: 29 October 2001 Author: Scott Wallace When you ask to change a method's category (via 'change category...' from the shifted selector-list menu in most tools) the list of alternatives now includes all categories known in superclasses as well as the actual class, and the option to type in a new category name is also offered."! !ClassDescription methodsFor: 'organization' stamp: 'sw 10/29/2001 17:41'! categoryFromUserWithPrompt: aPrompt "SystemDictionary categoryFromUserWithPrompt: 'testing'" | labels myCategories reject lines cats newName menuIndex | labels _ OrderedCollection with: 'new...'. labels addAll: (myCategories _ self organization categories asSortedCollection: [:a :b | a asLowercase < b asLowercase]). reject _ myCategories asSet. reject add: ClassOrganizer nullCategory; add: ClassOrganizer default. lines _ OrderedCollection with: 1 with: (myCategories size + 1). self allSuperclasses do: [:cls | cats _ cls organization categories reject: [:cat | reject includes: cat]. cats isEmpty ifFalse: [lines add: labels size. labels addAll: (cats asSortedCollection: [:a :b | a asLowercase < b asLowercase]). reject addAll: cats]]. newName _ (labels size = 1 or: [menuIndex _ (PopUpMenu labelArray: labels lines: lines) startUpWithCaption: aPrompt. menuIndex = 0 ifTrue: [^ nil]. menuIndex = 1]) ifTrue: [FillInTheBlank request: 'Please type new category name' initialAnswer: 'category name'] ifFalse: [labels at: menuIndex]. ^ newName ifNotNil: [newName asSymbol]! ! !ClassDescription methodsFor: 'organization' stamp: 'sw 10/29/2001 06:58'! letUserReclassify: anElement "Put up a list of categories and solicit one from the user. Answer true if user indeed made a change, else false" "ClassOrganizer organization letUserReclassify: #letUserReclassify:" | currentCat newCat | currentCat _ self organization categoryOfElement: anElement. newCat _ self categoryFromUserWithPrompt: 'choose category (currently "', currentCat, '")'. (newCat ~~ nil and: [newCat ~= currentCat]) ifTrue: [self organization classify: anElement under: newCat suppressIfDefault: false. ^ true] ifFalse: [^ false]! ! !CodeHolder methodsFor: 'categories' stamp: 'sw 10/29/2001 06:58'! changeCategory "Present a menu of the categories of messages for the current class, and let the user choose a new category for the current message" | aClass aSelector | (aClass _ self selectedClassOrMetaClass) ifNotNil: [(aSelector _ self selectedMessageName) ifNotNil: [(aClass letUserReclassify: aSelector) ifTrue: ["Smalltalk changes reorganizeClass: aClass." "Decided on further review that the above, when present, could cause more unexpected harm than good" self methodCategoryChanged]]]! ! ClassOrganizer removeSelector: #categoryFromUserWithPrompt:! ClassOrganizer removeSelector: #letUserReclassify:!