--- a/ClassOrganizer.st Thu Jun 19 18:24:41 1997 +0200
+++ b/ClassOrganizer.st Fri Jun 20 18:56:00 1997 +0200
@@ -11,7 +11,8 @@
"
Object subclass:#ClassOrganizer
- instanceVariableNames:'globalComment categoryArray categoryStops elementArray class'
+ instanceVariableNames:'globalComment categoryArray categoryStops elementArray class
+ categories'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Support'
@@ -48,6 +49,21 @@
Notice, that instances of ClassOrganizer are NOT used in the current ST/X
system; all of this is pure compatibility mimicri.
+
+ This is an additional goody class; therefore:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+
[author:]
Claus Gittinger
"
@@ -161,6 +177,36 @@
changeFromString:'( ''category1'' #foo1 #foo2 foo3)
( ''category2'' #bar1 #bar2)'
"
+!
+
+classify:aSelector under:aCategory
+ "change the category of the method stored under aSelector
+ to aCategory."
+
+ |m list|
+
+ class isNil ifTrue:[
+ "/ sigh used without a class ...
+ categories isNil ifTrue:[
+ categories := Dictionary new.
+ ].
+ list := categories at:aCategory ifAbsent:nil.
+ list isNil ifTrue:[
+ list := OrderedCollection new.
+ categories at:aCategory put:list.
+ ].
+ list add:aSelector.
+ ^ self.
+ ].
+
+ m := class compiledMethodAt:aSelector.
+ m notNil ifTrue:[
+ m category:aCategory
+ ].
+ class changed:#organization
+
+ "Created: 20.6.1997 / 18:01:18 / cg"
+ "Modified: 20.6.1997 / 18:09:37 / cg"
! !
!ClassOrganizer methodsFor:'printing & storing'!
@@ -168,16 +214,20 @@
printOn:aStream
|coll|
- coll := IdentityDictionary new.
- class methodDictionary keysAndValuesDo:[:sel :mthd |
- |cat list|
+ class notNil ifTrue:[
+ coll := IdentityDictionary new.
+ class methodDictionary keysAndValuesDo:[:sel :mthd |
+ |cat list|
- cat := mthd category.
- list := coll at:cat ifAbsent:[].
- list isNil ifTrue:[
- coll at:cat put:(list := OrderedCollection new).
+ cat := mthd category.
+ list := coll at:cat ifAbsent:[].
+ list isNil ifTrue:[
+ coll at:cat put:(list := OrderedCollection new).
+ ].
+ list add:sel
].
- list add:sel
+ ] ifFalse:[
+ coll := categories
].
coll keysAndValuesDo:[:category :list |
aStream nextPut:$(.
@@ -193,6 +243,8 @@
"
Number organization printString
"
+
+ "Modified: 20.6.1997 / 18:08:15 / cg"
! !
!ClassOrganizer methodsFor:'private access'!
@@ -206,5 +258,5 @@
!ClassOrganizer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.10 1997-06-19 16:24:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.11 1997-06-20 16:56:00 cg Exp $'
! !