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.
"
ClassDescription subclass:#Class
instanceVariableNames:'classvars comment subclasses classFilename package revision
history'
classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal
CatchMethodRedefinitions MethodRedefinitionSignal
UpdateChangeFileQuerySignal'
poolDictionaries:''
category:'Kernel-Classes'
!
!Class class methodsFor:'documentation'!
aus 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.
"
!
ion; this adds naming, categories etc.
Also change management and recompilation is defined here (since the superclasses
do not have enough symbolic information to support compilation).
For production code, the stc compiler is planned to (optionally) generate classes
as subclasses of Behavior - to excludes all name, source info etc.,
however, normally all classes are subclasses of Class.
Instance variables:
classvars <String> the names of the class variables
comment <String> the classes comment; either a string,
a number specifying the offset in classFilename, or nil
subclasses <Collection> cached collection of subclasses
(currently unused - but will be soon)
classFilename <String> the file (or nil) where the classes
sources are found
package <Symbol> the package, in which the class was defined
(inserted by compilers)
revision <String> revision string - inserted by stc
history <any> a place for a history string (not currently used)
Class variables:
UpdatingChanges <Boolean> true if the changes-file shall be updated
(except during startup and when filing in, this flag
is usually true)
LockChangesFile <Boolean> if true, the change file is locked for updates.
Required when multiple users operate on a common
change file.
This is an experimental new feature, being evaluated.
UpdateChangeFileQuerySignal used as an upQuery from the change management.
Whenever a changeRecord is to be written,
this signal is raised and a handler (if present)
is supposed to return true or false.
If unhandled, the value of the global
UpdatingChanges is returned for backward
compatibility (which means that the old
mechanism is used if no query-handler
is present).
FileOutErrorSignal raised when an error occurs during fileOut
CatchMethodRedefinitions if true, classes protect themself
MethodRedefinitionSignal (by raising MethodRedefinitionSignal)
from redefining any existing methods,
which are defined in another package.
(i.e. a signal will be raised, if you
fileIn something which redefines an
existing method and the packages do not
match).
The default is (currently) true.
WARNING: layout known by compiler and runtime system
"
!
version
^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.72 1995-11-15 12:07:17 cg Exp $'! !
!Class class methodsFor:'initialization'!
gChanges' controls if changes are put
into the changes-file; normally this variable is set to true, but
(for example) during fileIn or when changes are applied, it is set to false
to avoid putting too much junk into the changes-file."
UpdatingChanges := true.
LockChangesFile := false.
CatchMethodRedefinitions := true.
FileOutErrorSignal isNil ifTrue:[
FileOutErrorSignal := ErrorSignal newSignalMayProceed:false.
FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.
FileOutErrorSignal notifierString:'error during fileOut'.
MethodRedefinitionSignal := ErrorSignal newSignalMayProceed:true.
MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal.
MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'.
UpdateChangeFileQuerySignal := QuerySignal new mayProceed:true.
UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal.
UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'.
UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
]
! !
!Class class methodsFor:'Signal constants'!
he signal raised when a method is about to be installed
which redefines an existing method and the methods packages are not
equal. This helps when filing in alien code, to prevent existing
methods to be overwritten or redefined by incompatible methods"
^ MethodRedefinitionSignal
!
ncompatible methods"
^ MethodRedefinitionSignal
!
raised when an error occurs while fileing out.
This is signalled to allow browsers some user feed back in case
a fileout fails (for example due to disk-full errors)"
^ FileOutErrorSignal
! !
!Class class methodsFor:'accessing - flags'!
return true if changes are recorded"
^ UpdatingChanges
!
ile
!
prev|
prev := UpdatingChanges.
UpdatingChanges := aBoolean.
^ prev
!
prev := CatchMethodRedefinitions.
CatchMethodRedefinitions := aBoolean.
^ prev
!
edefinition catching flag."
^ CatchMethodRedefinitions
!
ean
"turn on/off changes management. Return the prior value of the flag."
|prev|
prev := UpdatingChanges.
UpdatingChanges := aBoolean.
^ prev
! !
!Class class methodsFor:'enumeration '!
"evaluate aBlock for all classes in aCategory;
no specific order is defined."
Smalltalk allBehaviorsDo:[:aClass |
aClass isMeta ifFalse:[
(aClass category = aCategory) ifTrue:[
aBlock value:aClass
]
].
]
"
Class allClassesInCategory:'Kernel-Classes'
do:[:class |Transcript showCr:class name]
"
!
Block
"evaluate aBlock for all classes in aCategory;
superclasses come first - then subclasses."
|classes|
classes := OrderedCollection new.
Smalltalk allBehaviorsDo:[:aClass |
aClass isMeta ifFalse:[
(aClass category = aCategory) ifTrue:[
classes add:aClass
]
]
].
classes topologicalSort:[:a :b | b isSubclassOf:a].
classes do:aBlock
! !
!Class methodsFor:'ST/V subclass creation'!
riableNames:d poolDictionaries:s
"this method allows fileIn of ST/V classes
(which seem to have no category)"
^ self subclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:'ST/V classes'
!
d poolDictionaries:s
"this method allows fileIn of ST/V variable byte classes
(which seem to have no category and no instvars)"
^ self variableByteSubclass:t
instanceVariableNames:''
classVariableNames:d
poolDictionaries:s
category:'ST/V classes'
!
classVariableNames:d poolDictionaries:s
"this method allows fileIn of ST/V variable pointer classes
(which seem to have no category)"
^ self variableSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:'ST/V classes'
! !
!Class methodsFor:'accessing'!
h:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
ariable if not already there and initialize it with nil.
Also writes a change record and notifies dependents.
BUG: Currently, no recompilation is done - this will change."
(self classVarNames includes:aString) ifFalse:[
self classVariableString:(self classVariableString , ' ' , aString).
self addChangeRecordForClass:self.
self updateRevisionString.
self changed:#definition.
]
"Created: 29.10.1995 / 19:40:51 / cg"
!
ines the name of the class library.
If left blank, the module info defaults to 'stx',
the directory info defaults to library name.
The library name may not be left blank.
(this is done for backward compatibility,)
For example:
'....(libbasic)' -> module: stx directory: libbasic library: libbasic
'....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
'....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
ct comment
"
!
n an expression-string to define myself"
|s|
s := WriteStream on:(String new).
self fileOutDefinitionOn:s.
^ s contents
"
Object definition
Point definition
"
!
self classVariableString:(self classVariableString , ' ' , aString).
self addChangeRecordForClass:self.
self updateRevisionString.
self changed:#definition.
]
"Created: 29.10.1995 / 19:40:51 / cg"
!
arAt:aName put:nil.
any := true.
] ifTrue:[
prevVarNames remove:aName
]
].
"left overs are gone"
prevVarNames do:[:aName |
self classVarAt:aName put:nil.
Smalltalk removeKey:(self name , ':' , aName) asSymbol.
].
any ifTrue:[
Smalltalk changed:#classVariables with:self
].
]
!
ection new)
"
Float allClassVarNames
"
!
th:self
].
]
!
iveDefinition string"
self setPrimitiveSpecsAt:1 to:aString.
self addChangeRecordForPrimitiveDefinitions:self.
self updateRevisionString.
"Created: 29.10.1995 / 19:41:39 / cg"
!
bbasic
'....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
."
history := aString
!
'.
] do:[
self fileOutOn:aStream.
].
aStream close.
aStream := FileStream oldFileNamed:'__temp'.
aStream isNil ifTrue:[
self notify:'oops - cannot reopen temp file'.
^ nil
].
code := aStream contents.
aStream close.
OperatingSystem removeFile:'__temp'.
^ code
!
"
!
ecsAt:3 to:aString.
self addChangeRecordForPrimitiveFunctions:self.
self updateRevisionString.
"Created: 29.10.1995 / 19:41:48 / cg"
!
le:'__temp'.
^ code
!
^ #()
!
renthesis.
The info consists of 1 to 3 subcomponents, separated by colons.
The first defines the classes module (i.e. some application identifier),
the second defines the subdirectory within that module, the third
defines the name of the class library.
If left blank, the module info defaults to 'stx',
the directory info defaults to library name.
The library name may not be left blank.
(this is done for backward compatibility,)
For example:
'....(libbasic)' -> module: stx directory: libbasic library: libbasic
'....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
'....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
e temporary file.'.
^ nil
].
FileOutErrorSignal handle:[:ex |
aStream nextPutAll:'"no source available"'.
] do:[
self fileOutOn:aStream.
].
aStream close.
aStream := FileStream oldFileNamed:'__temp'.
aStream isNil ifTrue:[
self notify:'oops - cannot reopen temp file'.
^ nil
].
code := aStream contents.
aStream close.
OperatingSystem removeFile:'__temp'.
^ code
!
FileStream oldFileNamed:'__temp'.
aStream isNil ifTrue:[
self notify:'oops - cannot reopen temp file'.
^ nil
].
code := aStream contents.
aStream close.
OperatingSystem removeFile:'__temp'.
^ code
!
ps - cannot reopen temp file'.
^ nil
].
code := aStream contents.
aStream close.
OperatingSystem removeFile:'__temp'.
^ code
!
es at: #module, #directory and #library.
If no such info is present in the class, nil is returned.
By convention, this info is encoded in the classes package
string (which is given as argument to stc) as the last word in parenthesis.
The info consists of 1 to 3 subcomponents, separated by colons.
The first defines the classes module (i.e. some application identifier),
the second defines the subdirectory within that module, the third
defines the name of the class library.
If left blank, the module info defaults to 'stx',
the directory info defaults to library name.
The library name may not be left blank.
(this is done for backward compatibility,)
For example:
'....(libbasic)' -> module: stx directory: libbasic library: libbasic
'....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
'....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
:aStream
"
aStream := FileStream newFileNamed:'__temp'.
aStream isNil ifTrue:[
self notify:'cannot create temporary file.'.
^ nil
].
FileOutErrorSignal handle:[:ex |
aStream nextPutAll:'"no source available"'.
] do:[
self fileOutOn:aStream.
].
aStream close.
aStream := FileStream oldFileNamed:'__temp'.
aStream isNil ifTrue:[
self notify:'oops - cannot reopen temp file'.
^ nil
].
code := aStream contents.
aStream close.
OperatingSystem removeFile:'__temp'.
^ code
!
aStream isNil ifTrue:[
"/
"/ hard case - there is no source file for this class
"/ (neither in the source-dir-path, nor in the current directory).
"/
"/
"/ look if my binary is from a dynamically loaded module,
"/ and, if so, look in the modules directory for the
"/ source file.
"/
ObjectFileLoader notNil ifTrue:[
ObjectFileLoader loadedObjectHandlesDo:[:h |
|f|
aStream isNil ifTrue:[
(h classes includes:self) ifTrue:[
f := h pathName.
f := f asFilename directory.
f := f construct:source.
f exists ifTrue:[
aStream := f readStream.
].
].
]
].
].
].
aStream isNil ifTrue:[
"/ mhmh - still no source file.
"/ If there is a SourceCodeManager, ask it to aquire the
"/ the source for my class, and return an open stream on it.
SourceCodeManager notNil ifTrue:[
aStream := SourceCodeManager sourceStreamFor:self.
]
].
^ aStream
"
Object sourceStream
Clock sourceStream
"
"Created: 10.11.1995 / 21:05:13 / cg"
!
aStream := f readStream.
].
].
]
].
].
].
aStream isNil ifTrue:[
"/ mhmh - still no source file.
"/ If there is a SourceCodeManager, ask it to aquire the
"/ the source for my class, and return an open stream on it.
SourceCodeManager notNil ifTrue:[
aStream := SourceCodeManager sourceStreamFor:self.
]
].
^ aStream
"
Object sourceStream
Clock sourceStream
"
"Created: 10.11.1995 / 21:05:13 / cg"
!
to get all known names."
classvars isNil ifTrue:[
^ OrderedCollection new
].
^ classvars asCollectionOfWords
"
Object classVarNames
Float classVarNames
"
!
mitiveFunctions string or nil"
^ self getPrimitiveSpecsAt:3
!
.
The library name may not be left blank.
(this is done for backward compatibility,)
For example:
'....(libbasic)' -> module: stx directory: libbasic library: libbasic
'....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
'....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
eInstance
] ifFalse:[
cls := self
].
source := (Smalltalk fileNameForClass:cls) , '.st'
].
fileName := Smalltalk getSourceFileName:source.
fileName isNil ifTrue:[
fileName := source
].
aStream := fileName asFilename readStream.
aStream isNil ifTrue:[
"/
"/ hard case - there is no source file for this class
"/ (neither in the source-dir-path, nor in the current directory).
"/
"/
"/ look if my binary is from a dynamically loaded module,
"/ and, if so, look in the modules directory for the
"/ source file.
"/
ObjectFileLoader notNil ifTrue:[
ObjectFileLoader loadedObjectHandlesDo:[:h |
|f|
aStream isNil ifTrue:[
(h classes includes:self) ifTrue:[
f := h pathName.
f := f asFilename directory.
f := f construct:source.
f exists ifTrue:[
aStream := f readStream.
].
].
]
].
].
].
aStream isNil ifTrue:[
"/ mhmh - still no source file.
"/ If there is a SourceCodeManager, ask it to aquire the
"/ the source for my class, and return an open stream on it.
SourceCodeManager notNil ifTrue:[
aStream := SourceCodeManager sourceStreamFor:self.
]
].
^ aStream
"
Object sourceStream
Clock sourceStream
"
"Created: 10.11.1995 / 21:05:13 / cg"
!
package:aStringOrSymbol
"set the package of the class."
package := aStringOrSymbol
!
no classPools yet.
"
Smalltalk at:(self name , ':' , aSymbol) asSymbol put:something.
!
age := aStringOrSymbol
!
String.
"Created: 29.10.1995 / 19:41:48 / cg"
!
classFilename
] ifFalse:[
self isMeta ifTrue:[
cls := self soleInstance
] ifFalse:[
cls := self
].
source := (Smalltalk fileNameForClass:cls) , '.st'
].
fileName := Smalltalk getSourceFileName:source.
fileName isNil ifTrue:[
fileName := source
].
aStream := fileName asFilename readStream.
aStream isNil ifTrue:[
"/
"/ hard case - there is no source file for this class
"/ (neither in the source-dir-path, nor in the current directory).
"/
"/
"/ look if my binary is from a dynamically loaded module,
"/ and, if so, look in the modules directory for the
"/ source file.
"/
ObjectFileLoader notNil ifTrue:[
ObjectFileLoader loadedObjectHandlesDo:[:h |
|f|
aStream isNil ifTrue:[
(h classes includes:self) ifTrue:[
f := h pathName.
f := f asFilename directory.
f := f construct:source.
f exists ifTrue:[
aStream := f readStream.
].
].
]
].
].
].
aStream isNil ifTrue:[
"/ mhmh - still no source file.
"/ If there is a SourceCodeManager, ask it to aquire the
"/ the source for my class, and return an open stream on it.
SourceCodeManager notNil ifTrue:[
aStream := SourceCodeManager sourceStreamFor:self.
]
].
^ aStream
"
Object sourceStream
Clock sourceStream
"
"Created: 10.11.1995 / 21:05:13 / cg"
!
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
while the directory is prepended to the file name.
Other schemes may do things differently - these are not yet specified.
Caveat:
Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
moduleString directoryString libraryString components|
package isNil ifTrue:[^ nil].
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
idx2 := packageString indexOf:$) startingAt:idx1+1.
idx2 ~~ 0 ifTrue:[
sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
!
imitiveVariable string"
self setPrimitiveSpecsAt:2 to:aString.
self addChangeRecordForPrimitiveVariables:self.
self updateRevisionString.
"Created: 29.10.1995 / 19:41:58 / cg"
!
om:idx1 + 1 to:idx2 - 1
]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
moduleString := 'stx'.
directoryString := libraryString := ''.
^ nil
] ifFalse:[
components size == 1 ifTrue:[
"/ a single name given - the module becomes 'stx',
"/ if the component includes slashes, its the directory
"/ otherwise the library
"/
moduleString := 'stx'.
directoryString := libraryString := components at:1.
(libraryString includes:$/) ifTrue:[
libraryString := libraryString asFilename baseName
]
] ifFalse:[
components size == 2 ifTrue:[
"/ two components - assume its the directory and the library
moduleString := 'stx'.
directoryString := components at:1.
libraryString := components at:2.
] ifFalse:[
"/ all components given
moduleString := components at:1.
directoryString := components at:2.
libraryString := components at:3.
]
]
].
libraryString isEmpty ifTrue:[
directoryString notEmpty ifTrue:[
libraryString := directoryString asFilename baseName
].
libraryString isEmpty ifTrue:[
"/ lets extract the library from the liblist file ...
libraryString := Smalltalk libraryFileNameOfClass:self.
libraryString isNil ifTrue:[^ nil].
]
].
moduleString isEmpty ifTrue:[
moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
directoryString := libraryString.
].
^ IdentityDictionary
with:(#module->moduleString)
with:(#directory->directoryString)
with:(#library->libraryString)
"
Object sourceCodeInfo
View sourceCodeInfo
Model sourceCodeInfo
BinaryObjectStorage sourceCodeInfo
MemoryMonitor sourceCodeInfo
ClockView sourceCodeInfo
"
"Created: 4.11.1995 / 20:36:53 / cg"
! !
!Class methodsFor:'adding/removing'!
od
"add the method given by 2nd argument under the selector given by
1st argument to the methodDictionary.
Append a change record to the changes file and tell dependents."
|oldMethod|
CatchMethodRedefinitions ifTrue:[
"check for attempts to redefine a method
in a different package. Signal a resumable error if so.
This allows tracing redefinitions of existing system methods
when filing in alien code ....
(which we may want to forbit sometimes)
"
oldMethod := self compiledMethodAt:newSelector.
oldMethod notNil ifTrue:[
oldMethod package ~= newMethod package ifTrue:[
"
attempt to redefine an existing method, which was
defined in another package.
If you continue in the debugger, the new method gets installed.
Otherwise, the existing (old) method remains valid.
You can turn of the catching of redefinitions by setting
CatchMethodRedefinitions to false
(also found in the NewLaunchers 'settings-misc' menu)
"
MethodRedefinitionSignal
raiseErrorString:(' ' , name , '>>' , newSelector)
]
]
].
(super addSelector:newSelector withMethod:newMethod) ifTrue:[
self updateRevisionString.
self addChangeRecordForMethod:newMethod.
]
"Created: 29.10.1995 / 19:42:42 / cg"
!
elector, aSelector and its associated method
from the methodDictionary.
Append a change record to the changes file and tell dependents."
(super removeSelector:aSelector) ifTrue:[
self addChangeRecordForRemoveSelector:aSelector.
self updateRevisionString.
self changed:#methodDictionary with:aSelector.
]
"Created: 29.10.1995 / 19:42:47 / cg"
!
, unload and reinstall it as
autoloaded. Can be used to get rid of no longer needed autoloaded
classes.
(maybe, autoloaded classes should unload themselfes when no
longer needed - for example, after some delay when the last instance
is gone ...)"
|nm|
self wasAutoloaded ifFalse:[
"
can it be done ?
"
self methodArray do:[:aMethod |
aMethod source isNil ifTrue:[^false].
aMethod hasPrimitiveCode ifTrue:[^ false].
].
].
self allSubclassesDo:[:aClass |
aClass unload
].
Transcript showCr:'unloading ' , name.
Autoload removeClass:self.
nm := name.
Smalltalk at:nm put:nil.
name := nm , ' (leftover)'.
ObjectMemory flushInlineCaches.
ObjectMemory flushMethodCache.
Autoload addClass:nm inCategory:category.
^ true
"
Clock open.
Clock unload.
ClockView unload.
Clock open
"
! !
!Class methodsFor:'binary storage'!
nager
"
classPool == nil ifFalse: [
classPool associationsDo: [:assoc|
globalDictionary at: assoc put: self
]
]
"
!
].
"
output my name
"
stream nextNumber:2 put:name size.
name do:[:c|
stream nextPut:c asciiValue
]
"
|s|
s := WriteStream on:ByteArray new.
Rectangle storeBinaryOn:s.
Object readBinaryFrom:(ReadStream on:s contents)
"
!
stream manager: manager
"not usable at the moment - there are no classpools currently"
| string |
string := self name, ' classPool at: ', anAssociation key storeString.
stream nextNumber: 2 put: string size.
string do: [:char| stream nextPut: char asciiValue]
! !
!Class methodsFor:'c function interfacing'!
ionNameString args:argTypeArray returning:returnType
"create an interface to an existing (i.e. already linked in) c function.
The function can be called by sending selector to the receiver class.
The c-function has the name cFunctionNameString, and expects parameters as specified in
argTypeArray. The functions return value has a type as specified by returnType.
WARNING:
this interface is EXPERIMENTAL - it may change or even be removed."
StubGenerator isNil ifTrue:[
^ self error:'this system does not support dynamic C Interface functions'.
].
StubGenerator
createStubFor:selector
calling:cFunctionNameString
args:argTypeArray
returning:returnType
in:self
"
Object subclass:#CInterface
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Examples'.
CInterface cInterfaceFunction:#printfOn:format:withFloat:
calling:'fprintf'
args:#(ExternalStream String Float)
returning:#SmallInteger.
CInterface printfOn:Stdout format:'this is a float: %g' withFloat:(Float pi). Stdout cr
"
! !
!Class methodsFor:'changes management'!
urn
] do:[
aBlock value:aStream.
aStream cr.
].
aStream close
]
!
' removeSelector:#' , aSelector).
aStream nextPutChunkSeparator.
!
geRecordForRenameCategory:oldCategory to:newCategory to:aStream.
]
!
.
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
Project addMethodPrivacyChange:aMethod in:self
]
]
"Modified: 27.8.1995 / 22:47:32 / claus"
!
aStream isNil ifTrue:[
self warn:'cannot create/update the changes file'.
^ nil
]
].
aStream setToEnd
].
^ aStream
"Created: 28.10.1995 / 16:53:43 / cg"
"Modified: 28.10.1995 / 16:55:03 / cg"
!
am nextPutAll:'('.
self printClassNameOn:aStream.
aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
aStream nextPutAll:(') privacy:' , aMethod privacy storeString).
aStream nextPutChunkSeparator.
]
"Modified: 27.8.1995 / 22:59:56 / claus"
!
am notNil ifTrue:[
FileStream writeErrorSignal handle:[:ex |
self warn:('could not update the changes-file\\' , ex errorString) withCRs.
ex return
] do:[
aBlock value:aStream.
aStream cr.
].
aStream close
]
!
Stream.
] ifFalse:[
streamType := FileStream.
].
aStream := streamType oldFileNamed:fileName.
aStream isNil ifTrue:[
aStream := streamType newFileNamed:fileName.
aStream isNil ifTrue:[
self warn:'cannot create/update the changes file'.
^ nil
]
].
aStream setToEnd
].
^ aStream
"Created: 28.10.1995 / 16:53:43 / cg"
"Modified: 28.10.1995 / 16:55:03 / cg"
!
ChangeRecordForMethodPrivacy:aMethod to:aStream
"append a method-privacy-change-record to aStream"
|selector|
selector := aMethod selector.
selector notNil ifTrue:[
aStream nextPutAll:'('.
self printClassNameOn:aStream.
aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
aStream nextPutAll:(') privacy:' , aMethod privacy storeString).
aStream nextPutChunkSeparator.
]
"Modified: 27.8.1995 / 22:59:56 / claus"
!
in case of an abort or other error."
UpdateChangeFileQuerySignal handle:[:ex |
ex proceedWith:false
] do:[
aBlock value
].
!
eRecordForPrimitiveVariables:aClass
"add a primitiveVariables-record to the changes file"
self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
!
m
"Created: 28.10.1995 / 16:53:17 / cg"
!
s:aClass to:aStream
"append a primitiveFunctions-record to aStream"
aStream nextPutAll:aClass name
, ' primitiveFunctions:'
, aClass primitiveFunctionsString storeString.
aStream nextPutChunkSeparator.
!
me to:newName
"add a class-rename-record to the changes file"
self writingChangeDo:[:aStream |
self addChangeRecordForClassRename:oldName to:newName to:aStream
]
!
a category change record to the changes file"
self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
!
foRecord:('snapshot ' , aFileName)
!
Category:aMethod category:aString to:aStream.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
Project addMethodCategoryChange:aMethod category:aString in:self
]
]
!
nextPutAll:('''---- ' , aMessage , ' ',
Date today printString , ' ' ,
Time now printString ,
' ----''').
aStream nextPutChunkSeparator.
!
extPutAll:'('.
self printClassNameOn:aStream.
aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
aStream nextPutAll:(') category:' , newCategory storeString).
aStream nextPutChunkSeparator.
]
!
typically each classes source is kept
in a separate file."
|aStream fileName|
fileName := ObjectMemory nameForSources.
aStream := FileStream oldFileNamed:fileName.
aStream isNil ifTrue:[
aStream := FileStream newFileNamed:fileName.
aStream isNil ifTrue:[
Transcript showCr:'cannot update sources file'.
^ nil
]
].
aStream setToEnd.
^ aStream
"Created: 28.10.1995 / 16:53:17 / cg"
!
iveDefinitions:to: with:aClass.
!
Nil ifTrue:[
aStream := FileStream newFileNamed:fileName.
aStream isNil ifTrue:[
Transcript showCr:'cannot update sources file'.
^ nil
]
].
aStream setToEnd.
^ aStream
"Created: 28.10.1995 / 16:53:17 / cg"
!
aStream nextPutChunkSeparator.
!
3 / cg"
"Modified: 28.10.1995 / 16:55:03 / cg"
!
oreString).
aStream nextPutChunkSeparator.
]
"Modified: 27.8.1995 / 22:59:56 / claus"
!
extPutAll:(' to:' , newCategory storeString).
aStream nextPutChunkSeparator.
!
odCategory:aMethod category:aString
"add a methodCategory-change-record to the changes file"
(UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
self writingChangeDo:[:aStream |
self addChangeRecordForMethodCategory:aMethod category:aString to:aStream.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
Project addMethodCategoryChange:aMethod category:aString in:self
]
]
!
ing.
The changefile is not kept open, to force the change to go to disk
as soon as possible - thus, in case of a crash, no changes should
be lost due to buffering."
|aStream|
aStream := self changesStream.
aStream notNil ifTrue:[
FileStream writeErrorSignal handle:[:ex |
self warn:('could not update the changes-file\\' , ex errorString) withCRs.
ex return
] do:[
aBlock value:aStream.
aStream cr.
].
aStream close
]
!
ordForPrimitiveVariables:aClass to:aStream
"append a primitiveVariables-record to aStream"
aStream nextPutAll:aClass name
, ' primitiveVariables:'
, aClass primitiveVariablesString storeString.
aStream nextPutChunkSeparator.
!
rform:aSelector with:anArgument with:stream.
]
"Created: 28.10.1995 / 16:50:48 / cg"
!
gory-rename record to aStream"
self printClassNameOn:aStream.
aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
aStream nextPutAll:(' to:' , newCategory storeString).
aStream nextPutChunkSeparator.
!
mmon helper to write a change record.
Opens the changefile and executes aBlock passing the stream
as argument. WriteErrors are cought and will lead to a warning.
The changefile is not kept open, to force the change to go to disk
as soon as possible - thus, in case of a crash, no changes should
be lost due to buffering."
|aStream|
aStream := self changesStream.
aStream notNil ifTrue:[
FileStream writeErrorSignal handle:[:ex |
self warn:('could not update the changes-file\\' , ex errorString) withCRs.
ex return
] do:[
aBlock value:aStream.
aStream cr.
].
aStream close
]
!
to the changes file"
self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
!
angeRecordForChangeCategory:category to:aStream
"append a category change record to aStream"
self printClassNameOn:aStream.
aStream nextPutAll:(' category:' , category storeString).
aStream nextPutChunkSeparator.
!
'''').
aStream nextPutChunkSeparator.
!
self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
!
elf writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
!
m"
aClass fileOutClassInstVarDefinitionOn:aStream.
aStream nextPutChunkSeparator.
! !
!Class methodsFor:'compiling'!
r this class;
if sucessful update the method dictionary."
self compilerClass
compile:code
forClass:self
!
ile code, aString for this class;
if sucessful update the method dictionary.
The method is classified under category."
self compilerClass
compile:code
forClass:self
inCategory:category
!
ile code, aString for this class; on any error, notify
requestor, anObject with the error reason."
self compilerClass
compile:code
forClass:self
notifying:requestor
!
]) ifTrue:[
self recompile:aSelector
]
]
!
leAll
"recompile this class and all subclasses"
|classes|
classes := self subclasses.
self recompile.
classes do:[:aClass |
aClass recompileAll
]
!
Names orSuper:false
!
true)"
|p|
selectorArray do:[:aSelector |
|m|
m := self compiledMethodAt:aSelector.
p := Parser parseMethod:(m source) in:self.
(p isNil
or:[(p usedVars notNil and:[p usedVars includesAny:setOfNames])
or:[superBoolean and:[p usesSuper]]]) ifTrue:[
self recompile:aSelector
]
]
!
used when a class changes instances and therefore all methods
have to be recompiled"
selectorArray do:[:aSelector |
self recompile:aSelector
]
!
elector
"recompile the method associated with the argument, aSelector;
used when a superclass changes instances and we have to recompile
subclasses"
|cat code|
Class withoutUpdatingChangesDo:[
Class methodRedefinitionSignal handle:[:ex |
ex proceed
] do:[
cat := (self compiledMethodAt:aSelector) category.
code := self sourceCodeAt:aSelector.
self compilerClass compile:code forClass:self inCategory:cat
]
]
! !
!Class methodsFor:'fileIn interface'!
s the next chunks"
^ ClassCategoryReader class:self primitiveSpec:#primitiveFunctions:
!
primitiveSpec:#primitiveVariables:
!
speciality of ST/X - it allows quick commenting of methods
from a source-file by replacing the 'methodsFor:' by 'ignoredMethodsFor'.
Returns a ClassCategoryReader to read in and skip methods."
^ ClassCategoryReader skippingChunks
!
assCategoryReader class:self primitiveSpec:#primitiveDefinitions:
!
Returns a ClassCategoryReader to read in and compile methods for me."
^ (self methodsFor:aCategory) privateProtocol
!
ENVY methods
(although ST/X currently does NOT support method visibility).
Returns a ClassCategoryReader to read in and compile methods for me."
^ self methodsFor:aCategory
!
NOT really enforce method visibility yet).
Returns a ClassCategoryReader to read in and compile methods for me."
^ (self methodsFor:aCategory) protectedProtocol
!
a ClassCategoryReader to read in and compile methods for me.
This one actually creates the ClassReader when code is filed-in."
^ ClassCategoryReader class:self category:aCategory
!
does - it was encountered by some tester.
For now, simply forward it."
^ self methodsFor:categoryString
!
eader skippingChunks
! !
!Class methodsFor:'fileOut'!
"/ previous versions of stc were not able to compile nil-subclasses;
"/ after 2.10, it can ...
"/ line := 'Object "nil"'.
line := 'nil'
] ifFalse:[
line := (superclass name)
].
superclass isNil ifTrue:[
isVar := self isVariable
] ifFalse:[
"I cant remember what this is for ?"
isVar := (self isVariable and:[superclass isVariable not])
].
isVar ifTrue:[
self isBytes ifTrue:[
s := ' variableByteSubclass:#'
] ifFalse:[
self isWords ifTrue:[
s := ' variableWordSubclass:#'
] ifFalse:[
self isLongs ifTrue:[
s := ' variableLongSubclass:#'
] ifFalse:[
self isFloats ifTrue:[
s := ' variableFloatSubclass:#'
] ifFalse:[
self isDoubles ifTrue:[
s := ' variableDoubleSubclass:#'
] ifFalse:[
s := ' variableSubclass:#'
]
]
]
]
]
] ifFalse:[
s := ' subclass:#'
].
line := line , s , name.
aStream nextPutAll:line.
aStream crtab.
aStream nextPutAll:' instanceVariableNames:'''.
self printInstVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:' classVariableNames:'''.
self printClassVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:' poolDictionaries:'''''.
aStream crtab.
aStream nextPutAll:' category:'.
category isNil ifTrue:[
s := ''''''
] ifFalse:[
s := category asString storeString
].
aStream nextPutAll:s.
aStream cr
!
method, aMethod.
If the current project is not nil, create the file in the projects
directory."
|aStream fileName selector|
selector := self selectorAtMethod:aMethod.
selector notNil ifTrue:[
fileName := name , '-' , selector, '.st'.
fileName replaceAll:$: by:$_.
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
fileName := Project currentProjectDirectory , fileName.
].
"
if file exists, save original in a .sav file
"
fileName asFilename exists ifTrue:[
fileName asFilename copyTo:(fileName , '.sav')
].
aStream := FileStream newFileNamed:fileName.
aStream isNil ifTrue:[
^ FileOutErrorSignal
raiseRequestWith:fileName
errorString:('cannot create file:', fileName)
].
self fileOutMethod:aMethod on:aStream.
aStream close
]
!
e. aStream cr.].
].
stampIt ifTrue:[
"
first, a timestamp
"
aStream nextPutAll:(Smalltalk timeStamp).
aStream nextPutChunkSeparator.
aStream cr; cr.
].
"
then the definition
"
self fileOutDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr.
"
optional classInstanceVariables
"
self class instanceVariableString isBlank ifFalse:[
self fileOutClassInstVarDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
a comment - if any
"
(comment := self comment) notNil ifTrue:[
aStream nextPutAll:name; nextPutAll:' comment:'.
aStream nextPutAll:(comment storeString).
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
primitive definitions - if any
"
self fileOutPrimitiveSpecsOn:aStream.
"
methods from all categories in metaclass
"
collectionOfCategories := self class categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
"
documentation first (if any)
"
(collectionOfCategories includes:'documentation') ifTrue:[
self class fileOutCategory:'documentation' on:aStream.
aStream cr.
].
"
initialization next (if any)
"
(collectionOfCategories includes:'initialization') ifTrue:[
self class fileOutCategory:'initialization' on:aStream.
aStream cr.
].
"
instance creation next (if any)
"
(collectionOfCategories includes:'instance creation') ifTrue:[
self class fileOutCategory:'instance creation' on:aStream.
aStream cr.
].
collectionOfCategories do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self class fileOutCategory:aCategory on:aStream.
aStream cr
]
]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory on:aStream.
aStream cr
]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
fileOutCategory:aCategory on:aStream
"file out all methods belonging to aCategory, aString onto aStream"
|source sortedSelectors first privacy interrestingMethods|
methodArray notNil ifTrue:[
interrestingMethods := OrderedCollection new.
methodArray do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
interrestingMethods add:aMethod.
]
].
interrestingMethods notEmpty ifTrue:[
first := true.
privacy := nil.
"/
"/ sort by selector
"/
sortedSelectors := interrestingMethods collect:[:m | self selectorAtMethod:m].
sortedSelectors sortWith:interrestingMethods.
interrestingMethods do:[:aMethod |
first ifFalse:[
privacy ~~ aMethod privacy ifTrue:[
first := true.
aStream space.
aStream nextPutChunkSeparator.
].
aStream cr; cr
].
privacy := aMethod privacy.
first ifTrue:[
aStream nextPutChunkSeparator.
self printClassNameOn:aStream.
privacy ~~ #public ifTrue:[
aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
] ifFalse:[
aStream nextPutAll:' methodsFor:'''.
].
aCategory notNil ifTrue:[
aStream nextPutAll:aCategory
].
aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
first := false.
].
source := aMethod source.
source isNil ifTrue:[
FileOutErrorSignal raiseRequestWith:'no source for method'
] ifFalse:[
aStream nextChunkPut:source.
].
].
aStream space.
aStream nextPutChunkSeparator.
aStream cr
]
]
"Modified: 28.8.1995 / 14:30:41 / claus"
"Modified: 15.11.1995 / 12:45:54 / cg"
!
d in the browser and filedOut.
"
((cls := self class) selectorArray includes:#copyright) ifTrue:[
"
get the copyright methods source,
and insert at beginning.
"
copyrightText := (cls compiledMethodAt:#copyright) source.
copyrightText isNil ifTrue:[
"
no source available - trigger an error
"
FileOutErrorSignal
raiseRequestWith:'no source for class ' , name , ' available. Cannot fileOut'.
^ self
].
copyrightText := copyrightText asCollectionOfLines.
copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
].
stampIt ifTrue:[
"
first, a timestamp
"
aStream nextPutAll:(Smalltalk timeStamp).
aStream nextPutChunkSeparator.
aStream cr; cr.
].
"
then the definition
"
self fileOutDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr.
"
optional classInstanceVariables
"
self class instanceVariableString isBlank ifFalse:[
self fileOutClassInstVarDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
a comment - if any
"
(comment := self comment) notNil ifTrue:[
aStream nextPutAll:name; nextPutAll:' comment:'.
aStream nextPutAll:(comment storeString).
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
primitive definitions - if any
"
self fileOutPrimitiveSpecsOn:aStream.
"
methods from all categories in metaclass
"
collectionOfCategories := self class categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
"
documentation first (if any)
"
(collectionOfCategories includes:'documentation') ifTrue:[
self class fileOutCategory:'documentation' on:aStream.
aStream cr.
].
"
initialization next (if any)
"
(collectionOfCategories includes:'initialization') ifTrue:[
self class fileOutCategory:'initialization' on:aStream.
aStream cr.
].
"
instance creation next (if any)
"
(collectionOfCategories includes:'instance creation') ifTrue:[
self class fileOutCategory:'instance creation' on:aStream.
aStream cr.
].
collectionOfCategories do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self class fileOutCategory:aCategory on:aStream.
aStream cr
]
]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory on:aStream.
aStream cr
]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
ue:[
fileName asFilename copyTo:(fileName , '.sav')
].
aStream := FileStream newFileNamed:fileName.
aStream isNil ifTrue:[
^ FileOutErrorSignal
raiseRequestWith:fileName
errorString:('cannot create file:', fileName)
].
self fileOutCategory:aCategory on:aStream.
aStream close
!
nd an expression on aStream, which defines myself."
|isVar line s|
"take care of nil-superclass"
superclass isNil ifTrue:[
"/ previous versions of stc were not able to compile nil-subclasses;
"/ after 2.10, it can ...
"/ line := 'Object "nil"'.
line := 'nil'
] ifFalse:[
line := (superclass name)
].
superclass isNil ifTrue:[
isVar := self isVariable
] ifFalse:[
"I cant remember what this is for ?"
isVar := (self isVariable and:[superclass isVariable not])
].
isVar ifTrue:[
self isBytes ifTrue:[
s := ' variableByteSubclass:#'
] ifFalse:[
self isWords ifTrue:[
s := ' variableWordSubclass:#'
] ifFalse:[
self isLongs ifTrue:[
s := ' variableLongSubclass:#'
] ifFalse:[
self isFloats ifTrue:[
s := ' variableFloatSubclass:#'
] ifFalse:[
self isDoubles ifTrue:[
s := ' variableDoubleSubclass:#'
] ifFalse:[
s := ' variableSubclass:#'
]
]
]
]
]
] ifFalse:[
s := ' subclass:#'
].
line := line , s , name.
aStream nextPutAll:line.
aStream crtab.
aStream nextPutAll:' instanceVariableNames:'''.
self printInstVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:' classVariableNames:'''.
self printClassVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:' poolDictionaries:'''''.
aStream crtab.
aStream nextPutAll:' category:'.
category isNil ifTrue:[
s := ''''''
] ifFalse:[
s := category asString storeString
].
aStream nextPutAll:s.
aStream cr
!
do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self class fileOutCategory:aCategory on:aStream.
aStream cr
]
]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory on:aStream.
aStream cr
]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
mitiveSpecsOn:aStream.
"
methods from all categories in metaclass
"
collectionOfCategories := self class categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
"
documentation first (if any)
"
(collectionOfCategories includes:'documentation') ifTrue:[
self class fileOutCategory:'documentation' on:aStream.
aStream cr.
].
"
initialization next (if any)
"
(collectionOfCategories includes:'initialization') ifTrue:[
self class fileOutCategory:'initialization' on:aStream.
aStream cr.
].
"
instance creation next (if any)
"
(collectionOfCategories includes:'instance creation') ifTrue:[
self class fileOutCategory:'instance creation' on:aStream.
aStream cr.
].
collectionOfCategories do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self class fileOutCategory:aCategory on:aStream.
aStream cr
]
]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory on:aStream.
aStream cr
]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
4:59 / cg"
!
fileOutOn:aStream
"file out my definition and all methods onto aStream"
^ self fileOutOn:aStream withTimeStamp:true
"Created: 15.11.1995 / 12:53:32 / cg"
!
fileOutOn:aStream withTimeStamp:stampIt
"file out my definition and all methods onto aStream"
|collectionOfCategories copyrightText comment cls|
self isLoaded ifFalse:[
^ FileOutErrorSignal
raiseRequestWith:self
errorString:'will not fileOut unloaded classes'
].
"
if there is a copyright method, add a copyright comment
at the beginning, taking the string from the copyright method.
We cannot do this unconditionally - that would lead to my copyrights
being put on your code ;-).
On the other hand: I want every file created by myself to have the
copyright string at the beginning be preserved .... even if the
code was edited in the browser and filedOut.
"
((cls := self class) selectorArray includes:#copyright) ifTrue:[
"
get the copyright methods source,
and insert at beginning.
"
copyrightText := (cls compiledMethodAt:#copyright) source.
copyrightText isNil ifTrue:[
"
no source available - trigger an error
"
FileOutErrorSignal
raiseRequestWith:'no source for class ' , name , ' available. Cannot fileOut'.
^ self
].
copyrightText := copyrightText asCollectionOfLines.
copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
].
stampIt ifTrue:[
"
first, a timestamp
"
aStream nextPutAll:(Smalltalk timeStamp).
aStream nextPutChunkSeparator.
aStream cr; cr.
].
"
then the definition
"
self fileOutDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr.
"
optional classInstanceVariables
"
self class instanceVariableString isBlank ifFalse:[
self fileOutClassInstVarDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
a comment - if any
"
(comment := self comment) notNil ifTrue:[
aStream nextPutAll:name; nextPutAll:' comment:'.
aStream nextPutAll:(comment storeString).
aStream nextPutChunkSeparator.
aStream cr; cr
].
"
primitive definitions - if any
"
self fileOutPrimitiveSpecsOn:aStream.
"
methods from all categories in metaclass
"
collectionOfCategories := self class categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
"
documentation first (if any)
"
(collectionOfCategories includes:'documentation') ifTrue:[
self class fileOutCategory:'documentation' on:aStream.
aStream cr.
].
"
initialization next (if any)
"
(collectionOfCategories includes:'initialization') ifTrue:[
self class fileOutCategory:'initialization' on:aStream.
aStream cr.
].
"
instance creation next (if any)
"
(collectionOfCategories includes:'instance creation') ifTrue:[
self class fileOutCategory:'instance creation' on:aStream.
aStream cr.
].
collectionOfCategories do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self class fileOutCategory:aCategory on:aStream.
aStream cr
]
]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory on:aStream.
aStream cr
]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
a sourceFile and which must be
applied again
"
self addChangeRecordForClassFileOut:self
!
ileOutCategory:aCategory on:aStream
"file out all methods belonging to aCategory, aString onto aStream"
|source sortedSelectors first privacy interrestingMethods|
methodArray notNil ifTrue:[
interrestingMethods := OrderedCollection new.
methodArray do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
interrestingMethods add:aMethod.
]
].
interrestingMethods notEmpty ifTrue:[
first := true.
privacy := nil.
"/
"/ sort by selector
"/
sortedSelectors := interrestingMethods collect:[:m | self selectorAtMethod:m].
sortedSelectors sortWith:interrestingMethods.
interrestingMethods do:[:aMethod |
first ifFalse:[
privacy ~~ aMethod privacy ifTrue:[
first := true.
aStream space.
aStream nextPutChunkSeparator.
].
aStream cr; cr
].
privacy := aMethod privacy.
first ifTrue:[
aStream nextPutChunkSeparator.
self printClassNameOn:aStream.
privacy ~~ #public ifTrue:[
aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
] ifFalse:[
aStream nextPutAll:' methodsFor:'''.
].
aCategory notNil ifTrue:[
aStream nextPutAll:aCategory
].
aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
first := false.
].
source := aMethod source.
source isNil ifTrue:[
FileOutErrorSignal raiseRequestWith:'no source for method'
] ifFalse:[
aStream nextChunkPut:source.
].
].
aStream space.
aStream nextPutChunkSeparator.
aStream cr
]
]
"Modified: 28.8.1995 / 14:30:41 / claus"
"Modified: 15.11.1995 / 12:45:54 / cg"
! !
!Class methodsFor:'printOut'!
ally an initialize message
"
(self class implements:#initialize) ifTrue:[
aStream nextPutAll:(name , ' initialize').
aStream nextPutChunkSeparator.
aStream cr
]
"Created: 15.11.1995 / 12:53:06 / cg"
!
tAll:s.
aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
].
!
[:aSubclass |
aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
]
"|printStream|
printStream := Printer new.
Object printFullHierarchyOn:printStream indent:0.
printStream close"
!
s indented and breaking at line end"
self printNameArray:(self classVarNames) on:aStream indent:indent
!
fFalse:[
name printOn:aStream
]
!
I am not a Metaclass;
otherwise my name without -class followed by space-class"
self isMeta ifTrue:[
aStream nextPutAll:(name copyTo:(name size - 5)); nextPutAll:' class'
] ifFalse:[
name printOn:aStream
]
!
itive defs (if any) to aStream."
|s|
"
primitive definitions - if any
"
(s := self primitiveDefinitionsString) notNil ifTrue:[
aStream nextPutChunkSeparator;
nextPutAll:name; nextPutAll:' primitiveDefinitions';
nextPutChunkSeparator;
cr.
aStream nextPutAll:s.
aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
].
(s := self primitiveVariablesString) notNil ifTrue:[
aStream nextPutChunkSeparator;
nextPutAll:name; nextPutAll:' primitiveVariables';
nextPutChunkSeparator;
cr.
aStream nextPutAll:s.
aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
].
!
ition"
|comment s|
aPrintStream nextPutAll:'class '; bold; nextPutAll:name; normal; cr.
aPrintStream nextPutAll:'superclass '.
superclass isNil ifTrue:[
s := 'Object'
] ifFalse:[
s := superclass name
].
aPrintStream nextPutAll:s.
aPrintStream cr.
aPrintStream nextPutAll:'instance Variables '.
self printInstVarNamesOn:aPrintStream indent:21.
aPrintStream cr.
aPrintStream nextPutAll:'class Variables '.
self printClassVarNamesOn:aPrintStream indent:21.
aPrintStream cr.
category notNil ifTrue:[
aPrintStream nextPutAll:'category '; nextPutAll:(category printString).
aPrintStream cr
].
(comment := self comment) notNil ifTrue:[
aPrintStream cr; nextPutAll:'comment:'; cr; italic; nextPutAll:comment; normal; cr
]
!
collectionOfCategories notNil ifTrue:[
aPrintStream nextPutAll:'instance protocol'.
aPrintStream cr; cr.
collectionOfCategories do:[:aCategory |
self printOutCategory:aCategory on:aPrintStream
]
]
!
arNamesOn:aStream indent:(indent + name size + 2).
aStream nextPutAll:')'.
aStream cr.
^ indent
!
ory '; nextPutAll:(category printString).
aPrintStream cr
].
(comment := self comment) notNil ifTrue:[
aPrintStream cr; nextPutAll:'comment:'; cr; italic; nextPutAll:comment; normal; cr
]
!
lf class printOutCategoryProtocol:aCategory on:aPrintStream
]
].
collectionOfCategories := self categories.
collectionOfCategories notNil ifTrue:[
aPrintStream nextPutAll:'instance protocol'.
aPrintStream cr; cr.
collectionOfCategories do:[:aCategory |
self printOutCategoryProtocol:aCategory on:aPrintStream
]
]
!
ory on aPrintStream should be a PrintStream"
|any|
methodArray notNil ifTrue:[
any := false.
methodArray do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
any := true
]
].
any ifTrue:[
aPrintStream italic.
aPrintStream nextPutAll:aCategory.
aPrintStream normal.
aPrintStream cr; cr.
methodArray do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
self printOutSource:(aMethod source) on:aPrintStream.
aPrintStream cr; cr
]
].
aPrintStream cr
]
]
!
line := line , thisName.
pos := pos + thisName size.
(index == arraySize) ifFalse:[
nextName := anArray at:(index + 1).
mustBreak := false.
(lenMax > 0) ifTrue:[
((pos + nextName size) > lenMax) ifTrue:[
mustBreak := true
]
].
mustBreak ifTrue:[
aStream nextPutAll:line.
aStream cr.
spaces isNil ifTrue:[
spaces := String new:indent
].
line := spaces.
pos := indent
] ifFalse:[
line := line , ' '.
pos := pos + 1
].
thisName := nextName
]
].
aStream nextPutAll:line
]
! !
!Class methodsFor:'private'!
ue:[^ nil].
^ lines at:idx.
"
Smalltalk allClassesDo:[:cls |
Transcript showCr:cls revisionString
].
Number revisionString
FileDirectory revisionString
"
"Created: 29.10.1995 / 19:28:03 / cg"
"Modified: 11.11.1995 / 14:11:41 / cg"
!
:[
info at:#fileName put:(words at:2).
info at:#revision put:(words at:3).
info at:#date put:(words at:4).
info at:#time put:(words at:5).
info at:#user put:(words at:6).
info at:#state put:(words at:7).
^ info
].
].
^ nil
"
Object revisionString
Object revisionInfo
"
"Created: 11.11.1995 / 14:27:20 / cg"
"Modified: 14.11.1995 / 16:00:51 / cg"
!
version.
val isString ifTrue:[^ val].
src := m source.
src isNil ifTrue:[^ nil].
lines := src asCollectionOfLines.
idx := lines findFirst:[:l |
l withoutSpaces startsWith:'$Header'
].
idx == 0 ifTrue:[^ nil].
^ lines at:idx.
"
Smalltalk allClassesDo:[:cls |
Transcript showCr:cls revisionString
].
Number revisionString
FileDirectory revisionString
"
"Created: 29.10.1995 / 19:28:03 / cg"
"Modified: 11.11.1995 / 14:11:41 / cg"
!
ied: 14.11.1995 / 16:00:51 / cg"
!
[^ nil].
"the primitiveSpec is either a string, or an integer specifying the
position within the classes sourcefile ...
"
pos isNumber ifTrue:[
classFilename notNil ifTrue:[
stream := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.
stream notNil ifTrue:[
stream position:pos+1.
string := stream nextChunk.
stream close.
^ string
]
].
^ nil
].
^ pos
!
!
11.11.1995 / 14:11:41 / cg"
!
am cr.
inComment := false.
textSize := text size.
textIndex := 2.
[textIndex <= textSize] whileTrue:[
line := text at:textIndex.
((line occurrencesOf:Character doubleQuote) == 0) ifTrue:[
aPrintStream nextPutAll:line
] ifFalse:[
lineSize := line size.
lineIndex := 1.
[lineIndex <= lineSize] whileTrue:[
aCharacter := line at:lineIndex.
(aCharacter == Character doubleQuote) ifTrue:[
inComment ifTrue:[
aPrintStream normal.
aPrintStream nextPut:aCharacter.
inComment := false
] ifFalse:[
aPrintStream nextPut:aCharacter.
aPrintStream italic.
inComment := true
]
] ifFalse:[
aPrintStream nextPut:aCharacter
].
lineIndex := lineIndex + 1
]
].
aPrintStream cr.
textIndex := textIndex + 1
]
! !
!Class methodsFor:'queries'!
The returned collection is not sorted by any order."
|coll|
coll := OrderedCollection new.
self addAllCategoriesTo:coll.
^ coll
"
Point categories
Point allCategories
"
!
ightPart vsnString|
cls := self.
self isMeta ifFalse:[
cls := self class
].
m := cls compiledMethodAt:#version.
m isNil ifTrue:[^ self].
vs := self revisionString.
vs isNil ifTrue:[^ self].
"/ search for ,v
idx := vs indexOfSubCollection:'.st,v'.
idx == 0 ifTrue:[^ self].
leftPart := vs copyTo:(idx - 1 + 5).
rightPart := (vs copyFrom:(idx + 5)) withoutSpaces.
idx := rightPart indexOfSeparator.
idx == 0 ifTrue:[^ self].
vsnString := rightPart copyTo:idx - 1.
rightPart := rightPart copyFrom:idx + 1.
vsnString ~= self revision ifTrue:[
"/ alread a modified class
"/ ('already modified: ' , vsnString) printNL.
^ self
].
m source:'version
^ ''' , leftPart , ' ' , vsnString , 'mod' , ' ' , rightPart , ''''.
"/ ('updated to :' , vsnString , 'mod') printNL.
"
Class updateRevisionString
Number updateRevisionString
ProcessMonitor updateRevisionString
"
"Created: 29.10.1995 / 19:25:15 / cg"
"Modified: 29.10.1995 / 19:39:38 / cg"
!
pdateRevisionString
"update my revision string, to reflect a change w.r.t.
the original source.
The original revision string is kept as a reference i.e.
Header: /files/CVS/stx/libbasic/Class.st,v 1.63 1995/10/28 16:44:51 cg Exp $
is changed into:
Header: /files/CVS/stx/libbasic/Class.st,v 1.63mod 1995/10/28 16:44:51 cg Exp $
"
|cls vs m idx leftPart rightPart vsnString|
cls := self.
self isMeta ifFalse:[
cls := self class
].
m := cls compiledMethodAt:#version.
m isNil ifTrue:[^ self].
vs := self revisionString.
vs isNil ifTrue:[^ self].
"/ search for ,v
idx := vs indexOfSubCollection:'.st,v'.
idx == 0 ifTrue:[^ self].
leftPart := vs copyTo:(idx - 1 + 5).
rightPart := (vs copyFrom:(idx + 5)) withoutSpaces.
idx := rightPart indexOfSeparator.
idx == 0 ifTrue:[^ self].
vsnString := rightPart copyTo:idx - 1.
rightPart := rightPart copyFrom:idx + 1.
vsnString ~= self revision ifTrue:[
"/ alread a modified class
"/ ('already modified: ' , vsnString) printNL.
^ self
].
m source:'version
^ ''' , leftPart , ' ' , vsnString , 'mod' , ' ' , rightPart , ''''.
"/ ('updated to :' , vsnString , 'mod') printNL.
"
Class updateRevisionString
Number updateRevisionString
ProcessMonitor updateRevisionString
"
"Created: 29.10.1995 / 19:25:15 / cg"
"Modified: 29.10.1995 / 19:39:38 / cg"
!
sMonitor updateRevisionString
"
"Created: 29.10.1995 / 19:25:15 / cg"
"Modified: 29.10.1995 / 19:39:38 / cg"
!
tPart := (vs copyFrom:(idx + 5)) withoutSpaces.
idx := rightPart indexOfSeparator.
idx == 0 ifTrue:[^ self].
vsnString := rightPart copyTo:idx - 1.
rightPart := rightPart copyFrom:idx + 1.
vsnString ~= self revision ifTrue:[
"/ alread a modified class
"/ ('already modified: ' , vsnString) printNL.
^ self
].
m source:'version
^ ''' , leftPart , ' ' , vsnString , 'mod' , ' ' , rightPart , ''''.
"/ ('updated to :' , vsnString , 'mod') printNL.
"
Class updateRevisionString
Number updateRevisionString
ProcessMonitor updateRevisionString
"
"Created: 29.10.1995 / 19:25:15 / cg"
"Modified: 29.10.1995 / 19:39:38 / cg"
!
is not sorted by any order."
|newList cat|
newList := OrderedCollection new.
methodArray do:[:aMethod |
cat := aMethod category.
newList indexOf:cat ifAbsent:[newList add:cat]
].
^ newList
"
Point categories
"
! !
!Class methodsFor:'subclass creation'!
"return true, if this class came into the system via an
autoload; false otherwise.
This is not an attribute of the class, but instead remembered in
Autoload. The interface here is for covenience."
^ Autoload wasAutoloaded:self
!
ames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isLongs ifTrue:[
^ self
variableLongSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isFloats ifTrue:[
^ self
variableFloatSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isDoubles ifTrue:[
^ self
variableDoubleSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isWords ifTrue:[
^ self
variableWordSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
^ self
variableSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
!
on-float class'
].
].
^ self class
name:t
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
variable:#float
words:false
pointers:false
classVariableNames:d
poolDictionaries:s
category:cat
comment:nil
changed:false
!
-double class'
].
].
^ self class
name:t
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
variable:#double
words:false
pointers:false
classVariableNames:d
poolDictionaries:s
category:cat
comment:nil
changed:false
!
lass'
].
].
^ self class
name:t
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
variable:true
words:false
pointers:false
classVariableNames:d
poolDictionaries:s
category:cat
comment:nil
changed:false
!
:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
"create a new class as a subclass of an existing class (the receiver).
The subclass will have indexed variables if the receiving-class has."
self isVariable ifFalse:[
^ self class
name:t
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
variable:false
words:true
pointers:true
classVariableNames:d
poolDictionaries:s
category:cat
comment:nil
changed:false
].
self isBytes ifTrue:[
^ self
variableByteSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isLongs ifTrue:[
^ self
variableLongSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isFloats ifTrue:[
^ self
variableFloatSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isDoubles ifTrue:[
^ self
variableDoubleSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
self isWords ifTrue:[
^ self
variableWordSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
^ self
variableSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
!
riableWordSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
].
^ self
variableSubclass:t
instanceVariableNames:f
classVariableNames:d
poolDictionaries:s
category:cat
! !
Class initialize!