'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5657] on 1 February 2004 at 6:05:33 pm'! "Change Set: KCP-190-MoveUIInteractionFromClassToCodeHolder Date: 1 February 2004 Author: stephane ducasse move the methods letUserReclassify: and categoryFromUserWithPrompt: aPrompt from ClassDescription to CodeHolder the only client of this method. This way we can have a better layered system...let us hope slowly. "! !ClassDescription methodsFor: 'deprecated' stamp: 'sd 2/1/2004 17:59'! categoryFromUserWithPrompt: aPrompt "SystemDictionary categoryFromUserWithPrompt: 'testing'" self deprecated: 'Use CodeHolder>>categoryFromUserWithPrompt: aPrompt for: aClass instead'. "this deprecation helps to remove UI dependency from the core of Squeak. Normally only CodeHolder was calling this method" CodeHolder new categoryFromUserWithPrompt: aPrompt for: self! ! !ClassDescription methodsFor: 'deprecated' stamp: 'sd 2/1/2004 18:01'! letUserReclassify: anElement "Put up a list of categories and solicit one from the user. Answer true if user indeed made a change, else false" self deprecated: 'Use CodeHolder>>letUserReclassify: anElement in: aClass'. CodeHolder new letUserReclassify: anElement in: self.! ! !CodeHolder methodsFor: 'categories' stamp: 'sd 2/1/2004 17:56'! categoryFromUserWithPrompt: aPrompt for: aClass "self new categoryFromUserWithPrompt: 'testing' for: SystemDictionary" | labels myCategories reject lines cats newName menuIndex | labels _ OrderedCollection with: 'new...'. labels addAll: (myCategories _ aClass 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). aClass 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]! ! !CodeHolder methodsFor: 'categories' stamp: 'sd 2/1/2004 17:55'! categoryOfCurrentMethod "Answer the category that owns the current method. If unable to determine a category, answer nil." | aClass aSelector | ^ (aClass _ self selectedClassOrMetaClass) ifNotNil: [(aSelector _ self selectedMessageName) ifNotNil: [aClass whichCategoryIncludesSelector: aSelector]]! ! !CodeHolder methodsFor: 'categories' stamp: 'sd 2/1/2004 17:55'! 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: [(self letUserReclassify: aSelector in: aClass) ifTrue: ["ChangeSet current reorganizeClass: aClass." "Decided on further review that the above, when present, could cause more unexpected harm than good" self methodCategoryChanged]]]! ! !CodeHolder methodsFor: 'categories' stamp: 'sd 2/1/2004 17:54'! letUserReclassify: anElement in: aClass "Put up a list of categories and solicit one from the user. Answer true if user indeed made a change, else false" | currentCat newCat | currentCat _ aClass organization categoryOfElement: anElement. newCat _ self categoryFromUserWithPrompt: 'choose category (currently "', currentCat, '")' for: aClass. (newCat ~~ nil and: [newCat ~= currentCat]) ifTrue: [aClass organization classify: anElement under: newCat suppressIfDefault: false. ^ true] ifFalse: [^ false]! !