"
 COPYRIGHT (c) 1995 by Claus Gittinger
	       All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#ClassOrganizer
	 instanceVariableNames:'globalComment categoryArray categoryStops elementArray class'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Kernel-Support'
!

!ClassOrganizer class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.3 1995-07-03 02:39:18 claus Exp $
"
!

documentation
"
    in contrast to other smalltalks, ST/X does not keep the
    method <-> category associations in the class (as organization),
    but instead keeps the category as an instance variable of method.

    For compatibility with (fileOut-) files which include a class organization
    message, 'aClass organization' returns an instance of this class, which
    implements the category change functionality.
    Also, some PD code seems to use & define methods for ClassOrganizers - having this
    (somewhat dummy) around helps to fileIn that code.

    Notice, that instances of ClassOrganizer are not used in the current ST/X
    system; all is pure mimicri.
    This may change in future versions.
"
! !

!ClassOrganizer class methodsFor:'instance creation'!

for:aClass
    "create & return a new instance of myself, to organize aClass"

    ^ self new class:aClass
! !

!ClassOrganizer  methodsFor:'accessing'!

classComment
    ^ class comment

    "
     Number organization classComment  
    "
!

categoryOfElement:aSelectorSymbol
    |m|

    m := class compiledMethodAt:aSelectorSymbol.
    m isNil ifTrue:[^ nil].
    ^ m category

    "
     Number organization categoryOfElement:#foo. 
     Object organization categoryOfElement:#==   
    "
!

listAtCategoryNamed:aCategorySymbol
    "return a collection of selectors whose methods are categorized
     as aCategorySymbol"

    |list|

    list := OrderedCollection new.
    class methodArray with:class selectorArray do:[:m :s |
	m category == aCategorySymbol ifTrue:[list add:s]
    ].
    ^ list asArray

    "
     SmallInteger organization listAtCategoryNamed:#arithmetic 
    "
!

categories
    "return a collection of categorySymbols"

    |set|

    set := IdentitySet new.
    class methodArray do:[:m |
	set add:m category
    ].
    ^ set asArray

    "
     SmallInteger organization categories 
    "
! !

!ClassOrganizer methodsFor:'printing & storing'!

printOn:aStream
    |coll|

    coll := IdentityDictionary new.
    class methodArray with:class selectorArray do:[:m :s |
	|cat list|

	cat := m category.
	list := coll at:cat ifAbsent:[].
	list isNil ifTrue:[
	    coll at:cat put:(list := OrderedCollection new).
	].
	list add:s
    ].
    coll keysAndValuesDo:[:category :list |
	aStream nextPut:$(.
	aStream nextPutAll:category asString storeString.
	list do:[:selector |
	    aStream space.
	    selector storeOn:aStream
	].
	aStream nextPut:$).
	aStream cr
    ]

    "
     Number organization printString
    "
! !

!ClassOrganizer methodsFor:'private access'!

class:aClass
    "set the class"

    class := aClass
! !

!ClassOrganizer methodsFor:'changing'!

changeFromString:organizationString
    "take category<->selector associations from aString, and change
     the categories of those methods. Only required when filing in
     ST-80 code."

    |a category m|

    "
     (mis(use) parser for the scanning
    "
    a := Compiler evaluate:'#(' , organizationString , ')'.
    (a isMemberOf:Array) ifFalse:[^ self error:'malformed argument'].
    a do:[:row |
	category := row at:1.
	2 to:row size do:[:idx |
	    |selector|

	    selector := row at:idx.
	    m := class compiledMethodAt:selector.
	    m isNil ifTrue:[
		Transcript showCr:'no method for ' , selector , ' in ', class name
	    ] ifFalse:[
		m category:category.
	    ]
	]
    ].
    class changed:#organization

    "
     TestClass organization changeFromString:'( ''category1'' #foo1 #foo2 foo3)
					      ( ''category2'' #bar1 #bar2)'
    "
! !