After a recent request ...

Makes 'add item' in the method category pane offer a list of choices from
the categories defined in it's superclasses (except for Object itself).

Enjoy :-)

/bert

-- 
 Bert Freudenberg                                            Department of
                                                            Simulation and
 mailto:bert at isg.cs.uni-magdeburg.de                     Computer Graphics
 http://isgwww.cs.uni-magdeburg.de/isg/bert.html        Univ. of Magdeburg

Content-Type: TEXT/PLAIN; charset=US-ASCII; name="addCategory-bf.cs"
Content-ID: <Pine.LNX.3.96.990311143007.25868B at balloon.cs.uni-magdeburg.de>
Content-Description: 

'From Squeak 2.3 of January 14, 1999 on 11 March 1999 at 2:26:47 pm'!
"Change Set:		addCategory-bf
Date:			11 March 1999
Author:			Bert Freudenberg

Makes 'add item' in the method category pane offer a list of choices from the categories defined in it's superclasses (except for Object itself)"!


!Browser methodsFor: 'message category functions' stamp: 'bf 3/11/1999 14:25'!
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 cats menuIndex oldIndex newName |
	self okToChange 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 |
		cls = Object ifFalse: [
			cats _ cls organization categories reject:
				 [:cat | reject includes: cat].
			cats isEmpty ifFalse: [
				lines add: labels size.
				labels addAll: cats.
				reject addAll: cats]]].
	newName _ (labels size = 1 or: [
		menuIndex _ (PopUpMenu labelArray: labels lines: lines)
		startUpWithCaption: 'Add Category'.
		menuIndex = 0 ifTrue: [^ self].
		menuIndex = 1])
			ifTrue: [
				self request: 'Please type new category name'
					initialAnswer: 'category name']
			ifFalse: [
				labels at: menuIndex].
	oldIndex _ messageCategoryListIndex.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName _ newName asSymbol].
	self classOrMetaClassOrganizer
		addCategory: newName
		before: (messageCategoryListIndex = 0
				ifTrue: [nil]
				ifFalse: [self selectedMessageCategoryName]).
	self changed: #messageCategoryList.
	self messageCategoryListIndex:
		(oldIndex = 0
			ifTrue: [self classOrMetaClassOrganizer categories size]
			ifFalse: [oldIndex]).
	self changed: #messageCategoryList.
! !