ClassOrganizer.st
author Claus Gittinger <cg@exept.de>
Sat, 18 May 1996 17:37:38 +0200
changeset 258 bf9fd9ad4687
parent 249 ea8e2098fa29
child 556 05070d255d6a
permissions -rw-r--r--
showCr: -> showCR:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     1
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
     3
	      All Rights Reserved
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     4
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
dbeb4f20377e Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    11
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    12
27
claus
parents: 20
diff changeset
    13
Object subclass:#ClassOrganizer
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    14
	instanceVariableNames:'globalComment categoryArray categoryStops elementArray class'
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    15
	classVariableNames:''
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    16
	poolDictionaries:''
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    17
	category:'Kernel-Support'
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    18
!
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    19
27
claus
parents: 20
diff changeset
    20
!ClassOrganizer class methodsFor:'documentation'!
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    21
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    22
copyright
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    23
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    24
 COPYRIGHT (c) 1995 by Claus Gittinger
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    25
	      All Rights Reserved
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    26
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    27
 This software is furnished under a license and may be used
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    28
 only in accordance with the terms of that license and with the
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    30
 be provided or otherwise made available to, or used by, any
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    31
 other person.  No title to or ownership of the software is
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    32
 hereby transferred.
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    33
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    34
!
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    35
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    36
documentation
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    37
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    38
    in contrast to other smalltalks, ST/X does not keep the
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    39
    method <-> category associations in the class (as organization),
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    40
    but instead keeps the category as an instance variable of methods.
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    41
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    42
    For compatibility with (fileOut-) files which include a class organization
27
claus
parents: 20
diff changeset
    43
    message, 'aClass organization' returns an instance of this class, which
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    44
    implements the category change functionality.
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    45
    Also, some PD code seems to use & define methods for ClassOrganizers 
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    46
    - having this (somewhat dummy) class around helps to fileIn that code.
27
claus
parents: 20
diff changeset
    47
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    48
    Notice, that instances of ClassOrganizer are NOT used in the current ST/X
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    49
    system; all of this is pure compatibility mimicri.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    50
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    51
    [author:]
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    52
        Claus Gittinger
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    53
"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    54
! !
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    55
27
claus
parents: 20
diff changeset
    56
!ClassOrganizer class methodsFor:'instance creation'!
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    57
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    58
for:aClass
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    59
    "create & return a new instance of myself, to organize aClass"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    60
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    61
    ^ self new class:aClass
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    62
! !
dbeb4f20377e Initial revision
claus
parents:
diff changeset
    63
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    64
!ClassOrganizer methodsFor:'accessing'!
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    65
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    66
categories
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    67
    "return a collection of my classes method-categorySymbols"
27
claus
parents: 20
diff changeset
    68
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    69
    |set|
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    70
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    71
    set := IdentitySet new.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    72
    class methodArray do:[:m |
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    73
        set add:m category
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    74
    ].
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    75
    ^ set asArray
27
claus
parents: 20
diff changeset
    76
claus
parents: 20
diff changeset
    77
    "
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    78
     SmallInteger organization categories 
27
claus
parents: 20
diff changeset
    79
    "
claus
parents: 20
diff changeset
    80
!
claus
parents: 20
diff changeset
    81
claus
parents: 20
diff changeset
    82
categoryOfElement:aSelectorSymbol
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    83
    "return the category for the method specified by aSelectorSymbol.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    84
     Return nil, if there is no such method."
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    85
27
claus
parents: 20
diff changeset
    86
    |m|
claus
parents: 20
diff changeset
    87
claus
parents: 20
diff changeset
    88
    m := class compiledMethodAt:aSelectorSymbol.
claus
parents: 20
diff changeset
    89
    m isNil ifTrue:[^ nil].
claus
parents: 20
diff changeset
    90
    ^ m category
claus
parents: 20
diff changeset
    91
claus
parents: 20
diff changeset
    92
    "
claus
parents: 20
diff changeset
    93
     Number organization categoryOfElement:#foo. 
claus
parents: 20
diff changeset
    94
     Object organization categoryOfElement:#==   
claus
parents: 20
diff changeset
    95
    "
claus
parents: 20
diff changeset
    96
!
claus
parents: 20
diff changeset
    97
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    98
classComment
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    99
    "return the classes comment"
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   100
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   101
    ^ class comment
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   102
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   103
    "
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   104
     Number organization classComment  
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   105
    "
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   106
!
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   107
27
claus
parents: 20
diff changeset
   108
listAtCategoryNamed:aCategorySymbol
claus
parents: 20
diff changeset
   109
    "return a collection of selectors whose methods are categorized
claus
parents: 20
diff changeset
   110
     as aCategorySymbol"
claus
parents: 20
diff changeset
   111
claus
parents: 20
diff changeset
   112
    |list|
claus
parents: 20
diff changeset
   113
claus
parents: 20
diff changeset
   114
    list := OrderedCollection new.
claus
parents: 20
diff changeset
   115
    class methodArray with:class selectorArray do:[:m :s |
claus
parents: 20
diff changeset
   116
	m category == aCategorySymbol ifTrue:[list add:s]
claus
parents: 20
diff changeset
   117
    ].
claus
parents: 20
diff changeset
   118
    ^ list asArray
claus
parents: 20
diff changeset
   119
claus
parents: 20
diff changeset
   120
    "
claus
parents: 20
diff changeset
   121
     SmallInteger organization listAtCategoryNamed:#arithmetic 
claus
parents: 20
diff changeset
   122
    "
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   123
! !
27
claus
parents: 20
diff changeset
   124
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   125
!ClassOrganizer methodsFor:'changing'!
27
claus
parents: 20
diff changeset
   126
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   127
changeFromString:organizationString
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   128
    "take category<->selector associations from aString, and change
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   129
     the categories of those methods. 
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   130
     Only required when filing in ST-80 code, which changes the categorization
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   131
     this way."
27
claus
parents: 20
diff changeset
   132
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   133
    |a category m|
27
claus
parents: 20
diff changeset
   134
claus
parents: 20
diff changeset
   135
    "
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   136
     (mis(use) parser for the scanning
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   137
    "
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   138
    a := Compiler evaluate:'#(' , organizationString , ')'.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   139
    (a isMemberOf:Array) ifFalse:[^ self error:'malformed argument'].
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   140
    a do:[:row |
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   141
        category := row at:1.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   142
        2 to:row size do:[:idx |
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   143
            |selector|
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   144
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   145
            selector := row at:idx.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   146
            m := class compiledMethodAt:selector.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   147
            m isNil ifTrue:[
258
bf9fd9ad4687 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 249
diff changeset
   148
                Transcript showCR:'no method for ' , selector , ' in ', class name
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   149
            ] ifFalse:[
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   150
                m category:category.
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   151
            ]
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   152
        ]
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   153
    ].
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   154
    class changed:#organization
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   155
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   156
    "
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   157
     TestClass 
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   158
        organization
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   159
            changeFromString:'( ''category1'' #foo1 #foo2 foo3)
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   160
                              ( ''category2'' #bar1 #bar2)'
27
claus
parents: 20
diff changeset
   161
    "
claus
parents: 20
diff changeset
   162
! !
claus
parents: 20
diff changeset
   163
claus
parents: 20
diff changeset
   164
!ClassOrganizer methodsFor:'printing & storing'!
claus
parents: 20
diff changeset
   165
claus
parents: 20
diff changeset
   166
printOn:aStream
claus
parents: 20
diff changeset
   167
    |coll|
claus
parents: 20
diff changeset
   168
claus
parents: 20
diff changeset
   169
    coll := IdentityDictionary new.
claus
parents: 20
diff changeset
   170
    class methodArray with:class selectorArray do:[:m :s |
claus
parents: 20
diff changeset
   171
	|cat list|
claus
parents: 20
diff changeset
   172
claus
parents: 20
diff changeset
   173
	cat := m category.
claus
parents: 20
diff changeset
   174
	list := coll at:cat ifAbsent:[].
claus
parents: 20
diff changeset
   175
	list isNil ifTrue:[
claus
parents: 20
diff changeset
   176
	    coll at:cat put:(list := OrderedCollection new).
claus
parents: 20
diff changeset
   177
	].
claus
parents: 20
diff changeset
   178
	list add:s
claus
parents: 20
diff changeset
   179
    ].
claus
parents: 20
diff changeset
   180
    coll keysAndValuesDo:[:category :list |
claus
parents: 20
diff changeset
   181
	aStream nextPut:$(.
claus
parents: 20
diff changeset
   182
	aStream nextPutAll:category asString storeString.
claus
parents: 20
diff changeset
   183
	list do:[:selector |
claus
parents: 20
diff changeset
   184
	    aStream space.
claus
parents: 20
diff changeset
   185
	    selector storeOn:aStream
claus
parents: 20
diff changeset
   186
	].
claus
parents: 20
diff changeset
   187
	aStream nextPut:$).
claus
parents: 20
diff changeset
   188
	aStream cr
claus
parents: 20
diff changeset
   189
    ]
claus
parents: 20
diff changeset
   190
claus
parents: 20
diff changeset
   191
    "
claus
parents: 20
diff changeset
   192
     Number organization printString
claus
parents: 20
diff changeset
   193
    "
claus
parents: 20
diff changeset
   194
! !
claus
parents: 20
diff changeset
   195
claus
parents: 20
diff changeset
   196
!ClassOrganizer methodsFor:'private access'!
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   197
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   198
class:aClass
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   199
    "set the class"
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   200
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   201
    class := aClass
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   202
! !
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   203
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   204
!ClassOrganizer class methodsFor:'documentation'!
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   205
249
ea8e2098fa29 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   206
version
258
bf9fd9ad4687 showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 249
diff changeset
   207
    ^ '$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.8 1996-05-18 15:37:24 cg Exp $'
20
dbeb4f20377e Initial revision
claus
parents:
diff changeset
   208
! !