--- a/Class.st Wed Aug 24 23:51:39 1994 +0200
+++ b/Class.st Thu Sep 29 21:38:11 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -12,16 +12,16 @@
ClassDescription subclass:#Class
instanceVariableNames:'classvars comment subclasses classFileName package'
- classVariableNames:'UpdatingChanges'
+ classVariableNames:'UpdatingChanges FileOutErrorSignal'
poolDictionaries:''
category:'Kernel-Classes'
!
Class comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.18 1994-08-23 23:07:34 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.19 1994-09-29 20:38:11 claus Exp $
'!
!Class class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.18 1994-08-23 23:07:34 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.19 1994-09-29 20:38:11 claus Exp $
"
!
@@ -60,19 +60,19 @@
Instance variables:
- classvars <String> the names of the class variables
- comment <String> the classes comment
- subclasses <Collection> cached collection of subclasses
- (currently unused - but will be soon)
- classFileName <String> the file (or nil) where the classes
- sources are found (currently not used)
- package <Symbol> the package, in which the class was defined
+ classvars <String> the names of the class variables
+ comment <String> the classes comment
+ subclasses <Collection> cached collection of subclasses
+ (currently unused - but will be soon)
+ classFileName <String> the file (or nil) where the classes
+ sources are found (currently not used)
+ package <Symbol> the package, in which the class was defined
Class variables:
- UpdatingChanges <Boolean> true if the changes-file shall be updated
- (except during startup and when filing in, this flag
- is usually true)
+ UpdatingChanges <Boolean> true if the changes-file shall be updated
+ (except during startup and when filing in, this flag
+ is usually true)
WARNING: layout known by compiler and runtime system
"
@@ -86,7 +86,20 @@
(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
+ UpdatingChanges := true.
+ FileOutErrorSignal isNil ifTrue:[
+ Object initialize.
+
+ FileOutErrorSignal := Object errorSignal newSignalMayProceed:false.
+ FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.
+ FileOutErrorSignal notifierString:'error during fileOut'.
+ ]
+! !
+
+!Class class methodsFor:'signal access'!
+
+fileOutErrorSignal
+ ^ FileOutErrorSignal
! !
!Class class methodsFor:'creating new classes'!
@@ -98,7 +111,7 @@
newClass := super new.
newClass setComment:(self comment)
- category:(self category).
+ category:(self category).
^ newClass
! !
@@ -109,66 +122,66 @@
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 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
+ 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
+ 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
+ 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
+ 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
+ variableWordSubclass:t
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
].
^ self
- variableSubclass:t
- instanceVariableNames:f
- classVariableNames:d
- poolDictionaries:s
- category:cat
+ variableSubclass:t
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
!
variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -176,25 +189,25 @@
in which the subclass has indexable pointer variables"
self isVariable ifTrue:[
- self isPointers ifFalse:[
- ^ self error:
- 'cannot make a variable pointer subclass of a variable non-pointer class'
- ]
+ self isPointers ifFalse:[
+ ^ self error:
+ 'cannot make a variable pointer subclass of a variable non-pointer class'
+ ]
].
^ self class
- name:t
- inEnvironment:Smalltalk
- subclassOf:self
- instanceVariableNames:f
- variable:true
- words:false
- pointers:true
- classVariableNames:d
- poolDictionaries:s
- category:cat
- comment:nil
- changed:false
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
!
variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -202,25 +215,25 @@
in which the subclass has indexable byte-sized nonpointer variables"
self isVariable ifTrue:[
- self isBytes ifFalse:[
- ^ self error:
- 'cannot make a variable byte subclass of a variable non-byte class'
- ].
+ self isBytes ifFalse:[
+ ^ self error:
+ 'cannot make a variable byte subclass of a variable non-byte class'
+ ].
].
^ 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
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:true
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
!
variableWordSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -228,25 +241,25 @@
in which the subclass has indexable word-sized nonpointer variables"
self isVariable ifTrue:[
- self isWords ifFalse:[
- ^ self error:
- 'cannot make a variable word subclass of a variable non-word class'
- ].
+ self isWords ifFalse:[
+ ^ self error:
+ 'cannot make a variable word subclass of a variable non-word class'
+ ].
].
^ self class
- name:t
- inEnvironment:Smalltalk
- subclassOf:self
- instanceVariableNames:f
- variable:true
- words:true
- pointers:false
- classVariableNames:d
- poolDictionaries:s
- category:cat
- comment:nil
- changed:false
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:true
+ words:true
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
!
variableLongSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -254,25 +267,25 @@
in which the subclass has indexable long-sized nonpointer variables"
self isVariable ifTrue:[
- self isLongs ifFalse:[
- ^ self error:
- 'cannot make a variable long subclass of a variable non-long class'
- ].
+ self isLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable long subclass of a variable non-long class'
+ ].
].
^ self class
- name:t
- inEnvironment:Smalltalk
- subclassOf:self
- instanceVariableNames:f
- variable:#long
- words:false
- pointers:false
- classVariableNames:d
- poolDictionaries:s
- category:cat
- comment:nil
- changed:false
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:#long
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
!
variableFloatSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -281,25 +294,25 @@
in which the subclass has indexable float-sized nonpointer variables"
self isVariable ifTrue:[
- self isFloats ifFalse:[
- ^ self error:
- 'cannot make a variable float subclass of a variable non-float class'
- ].
+ self isFloats ifFalse:[
+ ^ self error:
+ 'cannot make a variable float subclass of a variable non-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
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:#float
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
!
variableDoubleSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
@@ -308,25 +321,25 @@
in which the subclass has indexable double-sized nonpointer variables"
self isVariable ifTrue:[
- self isDoubles ifFalse:[
- ^ self error:
- 'cannot make a variable double subclass of a variable non-double class'
- ].
+ self isDoubles ifFalse:[
+ ^ self error:
+ 'cannot make a variable double subclass of a variable non-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
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:#double
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
! !
!Class methodsFor:'ST/V subclass creation'!
@@ -336,10 +349,10 @@
(which seem to have no category)"
^ self subclass:t
- instanceVariableNames:f
- classVariableNames:d
- poolDictionaries:s
- category:'ST/V classes'
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:'ST/V classes'
!
variableByteSubclass:t classVariableNames:d poolDictionaries:s
@@ -347,10 +360,10 @@
(which seem to have no category and no instvars)"
^ self variableByteSubclass:t
- instanceVariableNames:''
- classVariableNames:d
- poolDictionaries:s
- category:'ST/V classes'
+ instanceVariableNames:''
+ classVariableNames:d
+ poolDictionaries:s
+ category:'ST/V classes'
!
variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s
@@ -358,10 +371,10 @@
(which seem to have no category)"
^ self variableSubclass:t
- instanceVariableNames:f
- classVariableNames:d
- poolDictionaries:s
- category:'ST/V classes'
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:'ST/V classes'
! !
!Class methodsFor:'accessing'!
@@ -373,6 +386,11 @@
classvars isNil ifTrue:[^ ''].
^ classvars
+
+ "
+ Object classVariableString
+ Float classVariableString
+ "
!
classVarNames
@@ -381,12 +399,42 @@
in the returned collection - use allClassVarNames, to get all known names."
classvars isNil ifTrue:[
- ^ OrderedCollection new
+ ^ OrderedCollection new
].
^ classvars asCollectionOfWords
- "Object classVarNames"
- "Float classVarNames"
+ "
+ Object classVarNames
+ Float classVarNames
+ "
+!
+
+classVarAt:aSymbol
+ "return the value of a class variable.
+ Currently, this returns nil if there is no such classvar -
+ this may change."
+
+ "
+ this hides the (current) implementation of classVariables
+ from the outside world. Currently, classvars are stored in
+ the Smalltalk dictionary with a funny name, since there are
+ no classPools yet.
+ "
+ ^ Smalltalk at:(self name , ':' , aSymbol) asSymbol
+!
+
+classVarAt:aSymbol put:something
+ "store something in a classvariable.
+ Currently this creates a global with a funny name if no such
+ classVar exists - this may change."
+
+ "
+ this hides the (current) implementation of classVariables
+ from the outside world. Currently, classvars are stored in
+ the Smalltalk dictionary with a funny name, since there are
+ no classPools yet.
+ "
+ Smalltalk at:(self name , ':' , aSymbol) asSymbol put:something.
!
allClassVarNames
@@ -395,14 +443,20 @@
^ self addAllClassVarNamesTo:(OrderedCollection new)
- "Float allClassVarNames"
+ "
+ Float allClassVarNames
+ "
!
comment
"return the comment (aString) of the class"
^ comment
-!
+
+ "
+ Object comment
+ "
+!
setComment:aString
"set the comment of the class to be the argument, aString;
@@ -413,16 +467,21 @@
comment:aString
"set the comment of the class to be the argument, aString;
- create a change record"
+ create a change record and notify dependents."
+
+ |oldComment|
comment ~= aString ifTrue:[
- comment := aString.
- self addChangeRecordForClassComment:self
+ oldComment := comment.
+ comment := aString.
+ self changed:#comment with:oldComment.
+ self addChangeRecordForClassComment:self.
]
!
classFileName
- "return the name of the file from which the class was compiled"
+ "return the name of the file from which the class was compiled.
+ This is currently NOT used."
^ classFileName
!
@@ -436,8 +495,10 @@
self fileOutDefinitionOn:s.
^ s contents
- "Object definition"
- "Point definition"
+ "
+ Object definition
+ Point definition
+ "
!
sharedPools
@@ -455,73 +516,97 @@
!
setClassVariableString:aString
- "set the classes classvarnames string. This is a dangerous
- (low level) operation, since the classvariables are not really
- created."
+ "set the classes classvarnames string.
+ This is a dangerous (low level) operation, since the
+ classvariables are not really created or updated. Also,
+ NO change record is written."
classvars := aString
!
classVariableString:aString
- "set the classes classvarnames string;
- initialize new class variables with nil,
- clear and remove old ones. No change record is written."
+ "set the classes classvarnames string;
+ Initialize new class variables with nil, clear and remove old ones.
+ No change record is written and no classes are recompiled."
|prevVarNames varNames|
"ignore for metaclasses except the one"
(self isMeta) ifTrue:[
- (self == Metaclass) ifFalse:[
- ^ self
- ]
+ (self == Metaclass) ifFalse:[
+ ^ self
+ ]
].
(classvars = aString) ifFalse:[
- prevVarNames := self classVarNames.
- classvars := aString.
- varNames := self classVarNames.
+ prevVarNames := self classVarNames.
+ classvars := aString.
+ varNames := self classVarNames.
- "new ones get initialized to nil;
- - old ones are nilled and removed from Smalltalk"
+ "new ones get initialized to nil;
+ - old ones are nilled and removed from Smalltalk"
- varNames do:[:aName |
- (prevVarNames includes:aName) ifFalse:[
- "a new one"
- Smalltalk at:(self name , ':' , aName) asSymbol put:nil.
- ] ifTrue:[
- prevVarNames remove:aName
- ]
- ].
- "left overs are gone"
- prevVarNames do:[:aName |
- Smalltalk at:(self name , ':' , aName) asSymbol put:nil.
- Smalltalk removeKey:(self name , ':' , aName) asSymbol
- ].
- Smalltalk changed
+ varNames do:[:aName |
+ (prevVarNames includes:aName) ifFalse:[
+ "a new one"
+ self classVarAt:aName put:nil.
+ ] ifTrue:[
+ prevVarNames remove:aName
+ ]
+ ].
+ "left overs are gone"
+ prevVarNames do:[:aName |
+ self classVarAt:aName put:nil.
+ Smalltalk removeKey:(self name , ':' , aName) asSymbol.
+ ].
+ Smalltalk changed
]
!
addClassVarName:aString
- "add a class variable if not already there"
+ "add a class variable if not already there and initialize it with nil.
+ Also write a change record and notify dependents.
+ BUG: Currently, no recompilation is done - this will change."
(self classVarNames includes:aString) ifFalse:[
- self classVariableString:(self classVariableString , ' ' , aString)
+ self classVariableString:(self classVariableString , ' ' , aString).
+ self addChangeRecordForClass:self.
+ self changed:#definition.
+ ]
+!
+
+removeClassVarName:aString
+ "remove a class variable if not already there.
+ Also write a change record and notify dependents.
+ BUG: Currently, no recompilation is done - this will change."
+
+ |names newNames|
+
+ names := self classVarNames.
+ (names includes:aString) ifTrue:[
+ newNames := ''.
+ names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
+ self classVariableString:newNames withoutSpaces.
+ self addChangeRecordForClass:self.
+ self changed:#definition.
]
!
renameCategory:oldCategory to:newCategory
- "change methods categories"
+ "rename a category (changes category of those methods).
+ Append a change record and notifies dependents."
|any|
any := false.
methodArray do:[:aMethod |
- aMethod category = oldCategory ifTrue:[
- aMethod category:newCategory.
- any := true.
- ]
+ aMethod category = oldCategory ifTrue:[
+ aMethod category:newCategory.
+ any := true.
+ ]
].
any ifTrue:[
- self addChangeRecordForRenameCategory:oldCategory to:newCategory
+ self addChangeRecordForRenameCategory:oldCategory to:newCategory.
+ self changed:#methodCategory.
]
! !
@@ -530,20 +615,21 @@
addSelector:newSelector withMethod:newMethod
"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."
+ Append a change record to the changes file and tell dependents."
(super addSelector:newSelector withMethod:newMethod) ifTrue:[
- self addChangeRecordForMethod:newMethod
+ self addChangeRecordForMethod:newMethod
]
!
removeSelector:aSelector
"remove the selector, aSelector and its associated method
from the methodDictionary.
- Append a change record to the changes file."
+ Append a change record to the changes file and tell dependents."
(super removeSelector:aSelector) ifTrue:[
- self addChangeRecordForRemoveSelector:aSelector
+ self addChangeRecordForRemoveSelector:aSelector.
+ self changed:#methodDictionary with:aSelector.
]
! !
@@ -565,15 +651,15 @@
|aStream|
UpdatingChanges ifTrue:[
- aStream := FileStream oldFileNamed:'changes'.
- aStream isNil ifTrue:[
- aStream := FileStream newFileNamed:'changes'.
- aStream isNil ifTrue:[
- self error:'cannot update changes file'.
- ^ nil
- ]
- ].
- aStream setToEnd
+ aStream := FileStream oldFileNamed:'changes'.
+ aStream isNil ifTrue:[
+ aStream := FileStream newFileNamed:'changes'.
+ aStream isNil ifTrue:[
+ self error:'cannot update changes file'.
+ ^ nil
+ ]
+ ].
+ aStream setToEnd
].
^ aStream
!
@@ -584,15 +670,15 @@
|aStream|
UpdatingChanges ifTrue:[
- aStream := FileStream oldFileNamed:('st.sou').
- aStream isNil ifTrue:[
- aStream := FileStream newFileNamed:'st.sou'.
- aStream isNil ifTrue:[
- Transcript showCr:'cannot update sources file'.
- ^ nil
- ]
- ].
- aStream setToEnd
+ aStream := FileStream oldFileNamed:('st.sou').
+ aStream isNil ifTrue:[
+ aStream := FileStream newFileNamed:'st.sou'.
+ aStream isNil ifTrue:[
+ Transcript showCr:'cannot update sources file'.
+ ^ nil
+ ]
+ ].
+ aStream setToEnd
].
^ aStream
!
@@ -604,14 +690,14 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- self fileOutMethod:aMethod on:aStream.
- aStream cr.
- aStream close.
+ self fileOutMethod:aMethod on:aStream.
+ aStream cr.
+ aStream close.
- "this test allows a smalltalk without Projects/ChangeSets"
- Project notNil ifTrue:[
- Project addMethodChange:aMethod in:self
- ]
+ "this test allows a smalltalk without Projects/ChangeSets"
+ Project notNil ifTrue:[
+ Project addMethodChange:aMethod in:self
+ ]
]
!
@@ -622,11 +708,11 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- self printClassNameOn:aStream.
- aStream nextPutAll:(' removeSelector:#' , aSelector).
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' removeSelector:#' , aSelector).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -637,10 +723,10 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aClass fileOutDefinitionOn:aStream.
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ aClass fileOutDefinitionOn:aStream.
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -651,10 +737,10 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aClass fileOutClassInstVarDefinitionOn:aStream.
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ aClass fileOutClassInstVarDefinitionOn:aStream.
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -665,10 +751,10 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aClass fileOutCommentOn:aStream.
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ aClass fileOutCommentOn:aStream.
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -679,10 +765,10 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -693,10 +779,10 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aStream nextPutAll:('Smalltalk removeClass:' , oldName).
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ aStream nextPutAll:('Smalltalk removeClass:' , oldName).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -707,12 +793,12 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- self printClassNameOn:aStream.
- aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
- aStream nextPutAll:(' to:' , newCategory storeString).
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
+ aStream nextPutAll:(' to:' , newCategory storeString).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -723,11 +809,11 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- self printClassNameOn:aStream.
- aStream nextPutAll:(' category:' , category storeString).
- aStream nextPut:(aStream class chunkSeparator).
- aStream cr.
- aStream close
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' category:' , category storeString).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
]
!
@@ -738,12 +824,12 @@
aStream := self changesStream.
aStream notNil ifTrue:[
- aStream nextPutAll:('''---- snapshot ' , aFileName , ' ',
- Date today printString , ' ' ,
- Time now printString ,
- ' ----''!!').
- aStream cr.
- aStream close
+ aStream nextPutAll:('''---- snapshot ' , aFileName , ' ',
+ Date today printString , ' ' ,
+ Time now printString ,
+ ' ----''!!').
+ aStream cr.
+ aStream close
]
! !
@@ -766,16 +852,25 @@
recompileMethodsAccessingAny:setOfNames
"recompile all methods accessing a variable from setOfNames"
+ self recompileMethodsAccessingAny:setOfNames orSuper:false
+!
+
+recompileMethodsAccessingAny:setOfNames orSuper:superBoolean
+ "recompile all methods accessing a variable from setOfNames,
+ or super (if superBoolean is true)"
+
|p|
selectorArray do:[:aSelector |
- |m|
+ |m|
- m := self compiledMethodAt:aSelector.
- p := Parser parseMethod:(m source) in:self.
- (p isNil or:[p usedVars notNil and:[p usedVars includesAny:setOfNames]]) ifTrue:[
- self recompile:aSelector
- ]
+ 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
+ ]
]
!
@@ -788,11 +883,11 @@
upd := Class updateChanges:false.
[
- cat := (self compiledMethodAt:aSelector) category.
- code := self sourceCodeAt:aSelector.
- self compiler compile:code forClass:self inCategory:cat
+ cat := (self compiledMethodAt:aSelector) category.
+ code := self sourceCodeAt:aSelector.
+ self compiler compile:code forClass:self inCategory:cat
] valueNowOrOnUnwindDo:[
- Class updateChanges:upd
+ Class updateChanges:upd
]
!
@@ -802,7 +897,7 @@
have to be recompiled"
selectorArray do:[:aSelector |
- self recompile:aSelector
+ self recompile:aSelector
]
!
@@ -814,7 +909,7 @@
classes := self subclasses.
self recompile.
classes do:[:aClass |
- aClass recompileAll
+ aClass recompileAll
]
!
@@ -827,12 +922,12 @@
trapByteCode := trap byteCode.
selectorArray do:[:aSelector |
- |m|
+ |m|
- m := self compiledMethodAt:aSelector.
- ((m code == trapCode) and:[m byteCode == trapByteCode]) ifTrue:[
- self recompile:aSelector
- ]
+ m := self compiledMethodAt:aSelector.
+ ((m code == trapCode) and:[m byteCode == trapByteCode]) ifTrue:[
+ self recompile:aSelector
+ ]
]
! !
@@ -853,8 +948,8 @@
newList := OrderedCollection new.
methodArray do:[:aMethod |
- cat := aMethod category.
- newList indexOf:cat ifAbsent:[newList add:cat]
+ cat := aMethod category.
+ newList indexOf:cat ifAbsent:[newList add:cat]
].
^ newList
!
@@ -873,10 +968,10 @@
of all superclasses to the argument, aCollection. Return aCollection"
(superclass notNil) ifTrue:[
- superclass addAllClassVarNamesTo:aCollection
+ superclass addAllClassVarNamesTo:aCollection
].
classvars notNil ifTrue:[
- aCollection addAll:(classvars asCollectionOfWords).
+ aCollection addAll:(classvars asCollectionOfWords).
].
^ aCollection
!
@@ -887,12 +982,12 @@
|cat|
methodArray do:[:aMethod |
- cat := aMethod category.
- (aCollection detect:[:element | cat = element]
- ifNone:[nil])
- isNil ifTrue:[
- aCollection add:cat
- ]
+ cat := aMethod category.
+ (aCollection detect:[:element | cat = element]
+ ifNone:[nil])
+ isNil ifTrue:[
+ aCollection add:cat
+ ]
].
^ aCollection
!
@@ -902,7 +997,7 @@
to the argument, aCollection"
(superclass notNil) ifTrue:[
- superclass addAllCategoriesTo:aCollection
+ superclass addAllCategoriesTo:aCollection
].
^ self addCategoriesTo:aCollection
! !
@@ -957,20 +1052,20 @@
Warning: this interface is EXPERIMENTAL - it may change or even be removed."
StubGenerator createStubFor:selector calling:cFunctionNameString
- args:argTypeArray returning:returnType
- in:self
+ args:argTypeArray returning:returnType
+ in:self
"
Object subclass:#CInterface
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Examples'.
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Examples'.
CInterface cInterfaceFunction:#printfOn:format:withFloat:
- calling:'fprintf'
- args:#(ExternalStream String Float)
- returning:#SmallInteger.
+ calling:'fprintf'
+ args:#(ExternalStream String Float)
+ returning:#SmallInteger.
CInterface printfOn:Stdout format:'this is a float: %g' withFloat:(Float pi). Stdout cr
"
@@ -984,9 +1079,9 @@
aStream nextPutAll:name.
aStream nextPutAll:' comment:'.
comment isNil ifTrue:[
- aStream nextPutAll:''''''
+ aStream nextPutAll:''''''
] ifFalse:[
- aStream nextPutAll:(comment storeString)
+ aStream nextPutAll:(comment storeString)
].
aStream cr
!
@@ -1001,40 +1096,40 @@
"/ previous versions of stc were not able to compile nil-subclasses;
"/ after 2.10, it can ...
"/ line := 'Object "nil"'.
- line := 'nil'
+ line := 'nil'
] ifFalse:[
- line := (superclass name)
+ line := (superclass name)
].
superclass isNil ifTrue:[
- isVar := self isVariable
+ isVar := self isVariable
] ifFalse:[
- "I cant remember what this is for ?"
- isVar := (self isVariable and:[superclass isVariable not])
+ "I cant remember what this is for ?"
+ isVar := (self isVariable and:[superclass isVariable not])
].
isVar ifTrue:[
- self isBytes ifTrue:[
- line := line , ' variableByteSubclass:#'
- ] ifFalse:[
- self isWords ifTrue:[
- line := line , ' variableWordSubclass:#'
- ] ifFalse:[
- self isLongs ifTrue:[
- line := line , ' variableLongSubclass:#'
- ] ifFalse:[
- self isFloats ifTrue:[
- line := line , ' variableFloatSubclass:#'
- ] ifFalse:[
- self isDoubles ifTrue:[
- line := line , ' variableDoubleSubclass:#'
- ] ifFalse:[
- line := line , ' variableSubclass:#'
- ]
- ]
- ]
- ]
- ]
+ self isBytes ifTrue:[
+ line := line , ' variableByteSubclass:#'
+ ] ifFalse:[
+ self isWords ifTrue:[
+ line := line , ' variableWordSubclass:#'
+ ] ifFalse:[
+ self isLongs ifTrue:[
+ line := line , ' variableLongSubclass:#'
+ ] ifFalse:[
+ self isFloats ifTrue:[
+ line := line , ' variableFloatSubclass:#'
+ ] ifFalse:[
+ self isDoubles ifTrue:[
+ line := line , ' variableDoubleSubclass:#'
+ ] ifFalse:[
+ line := line , ' variableSubclass:#'
+ ]
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- line := line , ' subclass:#'
+ line := line , ' subclass:#'
].
line := line , name.
aStream nextPutAll:line.
@@ -1055,9 +1150,9 @@
aStream crTab.
aStream nextPutAll:' category:'.
category isNil ifTrue:[
- aStream nextPutAll:''''''
+ aStream nextPutAll:''''''
] ifFalse:[
- aStream nextPutAll:(category asString storeString)
+ aStream nextPutAll:(category asString storeString)
].
aStream cr
!
@@ -1073,65 +1168,79 @@
fileOutCategory:aCategory on:aStream
"file out all methods belonging to aCategory, aString onto aStream"
- |nMethods count sep|
+ |nMethods count sep source|
methodArray notNil ifTrue:[
- nMethods := 0.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- nMethods := nMethods + 1
- ]
- ].
- sep := aStream class chunkSeparator.
- (nMethods ~~ 0) ifTrue:[
- aStream nextPut:sep.
- self printClassNameOn:aStream.
- aStream nextPutAll:' methodsFor:'''.
- aCategory notNil ifTrue:[
- aStream nextPutAll:aCategory
- ].
- aStream nextPut:$'. aStream nextPut:sep. aStream cr.
- aStream cr.
- count := 1.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- aStream nextChunkPut:(aMethod source).
- (count ~~ nMethods) ifTrue:[
- aStream cr.
- aStream cr
- ].
- count := count + 1
- ]
- ].
- aStream space.
- aStream nextPut:sep.
- aStream cr
- ]
+ nMethods := 0.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ nMethods := nMethods + 1
+ ]
+ ].
+ sep := aStream class chunkSeparator.
+ (nMethods ~~ 0) ifTrue:[
+ aStream nextPut:sep.
+ self printClassNameOn:aStream.
+ aStream nextPutAll:' methodsFor:'''.
+ aCategory notNil ifTrue:[
+ aStream nextPutAll:aCategory
+ ].
+ aStream nextPut:$'. aStream nextPut:sep. aStream cr.
+ aStream cr.
+ count := 1.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal raiseRequestWith:'no source for method'
+ ] ifFalse:[
+ aStream nextChunkPut:(aMethod source).
+ ].
+ (count ~~ nMethods) ifTrue:[
+ aStream cr.
+ aStream cr
+ ].
+ count := count + 1
+ ]
+ ].
+ aStream space.
+ aStream nextPut:sep.
+ aStream cr
+ ]
]
!
fileOutMethod:aMethod on:aStream
"file out the method, aMethod onto aStream"
- |cat sep|
+ |cat sep source|
methodArray notNil ifTrue:[
- sep := aStream class chunkSeparator.
- aStream nextPut:sep.
- self printClassNameOn:aStream.
- aStream nextPutAll:' methodsFor:'''.
- cat := aMethod category.
- cat notNil ifTrue:[
- aStream nextPutAll:cat
- ].
- aStream nextPut:$'.
- aStream nextPut:sep.
- aStream cr.
- aStream cr.
- aStream nextChunkPut:(aMethod source).
- aStream space.
- aStream nextPut:sep.
- aStream cr
+ sep := aStream class chunkSeparator.
+ aStream nextPut:sep.
+ self printClassNameOn:aStream.
+ aStream nextPutAll:' methodsFor:'''.
+ cat := aMethod category.
+ cat notNil ifTrue:[
+ aStream nextPutAll:cat
+ ].
+ aStream nextPut:$'.
+ aStream nextPut:sep.
+ aStream cr.
+ aStream cr.
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:('no source for method: ' ,
+ self name , '>>' ,
+ (self selectorForMethod:aMethod))
+ ] ifFalse:[
+ aStream nextChunkPut:(aMethod source).
+ ].
+ aStream space.
+ aStream nextPut:sep.
+ aStream cr
]
!
@@ -1145,21 +1254,21 @@
at the beginning
"
(self class selectorArray includes:#copyright) ifTrue:[
- "
- get the copyright methods source,
- and insert at beginning.
- "
- copyrightText := (self class compiledMethodAt:#copyright) source.
- copyrightText isNil ifTrue:[
- "
- no source available - trigger an error
- "
- self error:'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.].
+ "
+ get the copyright methods source,
+ and insert at beginning.
+ "
+ copyrightText := (self class compiledMethodAt:#copyright) source.
+ copyrightText isNil ifTrue:[
+ "
+ no source available - trigger an error
+ "
+ self error:'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.].
].
sep := aStream class chunkSeparator.
@@ -1182,22 +1291,22 @@
optional classInstanceVariables
"
self class instanceVariableString isBlank ifFalse:[
- self fileOutClassInstVarDefinitionOn:aStream.
- aStream nextPut:sep.
- aStream cr.
- aStream cr
+ self fileOutClassInstVarDefinitionOn:aStream.
+ aStream nextPut:sep.
+ aStream cr.
+ aStream cr
].
"
a comment - if any
"
comment notNil ifTrue:[
- aStream nextPutAll:name.
- aStream nextPutAll:' comment:'.
- aStream nextPutAll:(comment storeString).
- aStream nextPut:sep.
- aStream cr.
- aStream cr
+ aStream nextPutAll:name.
+ aStream nextPutAll:' comment:'.
+ aStream nextPutAll:(comment storeString).
+ aStream nextPut:sep.
+ aStream cr.
+ aStream cr
].
"
@@ -1205,28 +1314,28 @@
"
collectionOfCategories := self class categories.
collectionOfCategories notNil ifTrue:[
- collectionOfCategories do:[:aCategory |
- self class fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
+ collectionOfCategories do:[:aCategory |
+ self class fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
].
"
methods from all categories in myself
"
collectionOfCategories := self categories.
collectionOfCategories notNil ifTrue:[
- collectionOfCategories do:[:aCategory |
- self fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
].
"
optionally an initialize message
"
(self class implements:#initialize) ifTrue:[
- aStream nextPutAll:(name , ' initialize').
- aStream nextPut:sep.
- aStream cr
+ aStream nextPutAll:(name , ' initialize').
+ aStream nextPut:sep.
+ aStream cr
]
!
@@ -1244,9 +1353,20 @@
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
+ 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 fileOutCategory:aCategory on:aStream.
aStream close
!
@@ -1260,40 +1380,83 @@
selector := self selectorForMethod: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.
- ].
- aStream := FileStream newFileNamed:fileName.
- self fileOutMethod:aMethod on:aStream.
- aStream close
+ 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
]
!
fileOut
"create a file 'class.st' consisting of all methods in myself.
If the current project is not nil, create the file in the projects
- directory."
+ directory. Care is taken, to not clobber any existing file in
+ case of errors (for example: disk full). Also, since the classes
+ methods need a valid sourcefile, the current sourceFile cannot be rewritten,
+ but must be kept around until the fileOut is finished."
- |aStream fileName|
+ |aStream baseName dirName fileName newFileName needRename|
- fileName := (Smalltalk fileNameForClass:self name) , '.st'.
+ baseName := (Smalltalk fileNameForClass:self name).
+ fileName := baseName , '.st'.
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
+ dirName := Project currentProjectDirectory
+ ] ifFalse:[
+ dirName := ''
].
- aStream := FileStream newFileNamed:fileName.
+ fileName := dirName , fileName.
+ "
+ if file exists, copy the existing to a .sav-file,
+ create new file in a .new-file,
+ and, if that worked rename afterwards ...
+ "
+ fileName asFilename exists ifTrue:[
+ fileName asFilename copyTo:('/tmp/' , baseName , '.sav').
+ newFileName := dirName , baseName , '.new'.
+ needRename := true
+ ] ifFalse:[
+ newFileName := fileName.
+ needRename := false
+ ].
+
+ aStream := FileStream newFileNamed:newFileName.
aStream isNil ifTrue:[
- ^ self error:('cannot create source file:', fileName)
+ ^ FileOutErrorSignal raiseRequestWith:newFileName
+ errorString:('cannot create file:', newFileName)
].
self fileOutOn:aStream.
- aStream close
+ aStream close.
+
+ "
+ finally, replace the old-file
+ be careful, if the old one is a symbolic link; in this case,
+ we have to do a copy ...
+ "
+ needRename ifTrue:[
+ newFileName asFilename copyTo:fileName.
+ newFileName asFilename delete
+ ].
!
fileOutIn:aFileDirectory
@@ -1306,97 +1469,12 @@
fileName := (Smalltalk fileNameForClass:self name) , '.st'.
aStream := FileStream newFileNamed:fileName in:aFileDirectory.
aStream isNil ifTrue:[
- ^ self error:('cannot create source file:', fileName)
+ ^ self error:('cannot create source file:', fileName)
].
self fileOutOn:aStream.
aStream close
! !
-!Class methodsFor:'obsolete binary fileOut'!
-
-XXbinaryFileOutMethodsOn:aStream
- "binary file out all methods onto aStream"
-
- |temporaryMethod index|
-
- methodArray notNil ifTrue:[
- aStream nextPut:$!!.
- self printClassNameOn:aStream.
- aStream nextPutAll:' binaryMethods'.
- aStream nextPut:$!!.
- aStream cr.
- index := 1.
- methodArray do:[:aMethod |
- (selectorArray at:index) storeOn:aStream.
- aStream nextPut:$!!.
-
- aMethod byteCode isNil ifTrue:[
- temporaryMethod := self compiler compile:(aMethod source)
- forClass:self
- inCategory:(aMethod category)
- notifying:nil
- install:false.
- temporaryMethod binaryFileOutOn:aStream
- ] ifFalse:[
- aMethod binaryFileOutOn:aStream
- ].
- aStream cr.
- index := index + 1
- ].
- aStream nextPut:$!!.
- aStream cr
- ]
-!
-
-XXbinaryFileOutOn:aStream
- "file out all methods onto aStream"
-
- aStream nextPut:$'.
- aStream nextPutAll:('From Smalltalk/X, Version:'
- , (Smalltalk versionString)
- , ' on ').
- aStream nextPutAll:(Date today printString , ' at ' , Time now printString).
- aStream nextPut:$'.
- aStream nextPut:$!!.
- aStream cr.
- self fileOutDefinitionOn:aStream.
- aStream nextPut:$!!.
- aStream cr.
- comment notNil ifTrue:[
- aStream nextPutAll:name.
- aStream nextPutAll:' comment:'.
- aStream nextPutAll:(comment storeString).
- aStream nextPut:$!!.
- aStream cr
- ].
- self class binaryFileOutMethodsOn:aStream.
- self binaryFileOutMethodsOn:aStream.
- (self class implements:#initialize) ifTrue:[
- aStream nextPutAll:(name , ' initialize').
- aStream nextPut:$!!.
- aStream cr
- ]
-!
-
-XXbinaryFileOut
- "create a file 'class.sb' consisting of all methods in myself.
- If the current project is not nil, create the file in the projects
- directory."
-
- |aStream fileName|
-
- fileName := (Smalltalk fileNameForClass:self name) , '.sb'.
- Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
- ].
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- ^ self error:('cannot create class file:', fileName)
- ].
- self binaryFileOutOn:aStream.
- aStream close
-! !
-
!Class methodsFor:'printOut'!
printClassNameOn:aStream
@@ -1404,10 +1482,10 @@
otherwise my name without -class followed by space-class"
self isMeta ifTrue:[
- aStream nextPutAll:(name copyTo:(name size - 5)).
- aStream nextPutAll:' class'
+ aStream nextPutAll:(name copyTo:(name size - 5)).
+ aStream nextPutAll:' class'
] ifFalse:[
- name printOn:aStream
+ name printOn:aStream
]
!
@@ -1420,37 +1498,37 @@
arraySize := anArray size.
arraySize ~~ 0 ifTrue:[
- pos := indent.
- lenMax := aStream lineLength.
- thisName := anArray at:1.
- line := ''.
- 1 to:arraySize do:[:index |
- 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
+ pos := indent.
+ lenMax := aStream lineLength.
+ thisName := anArray at:1.
+ line := ''.
+ 1 to:arraySize do:[:index |
+ 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
]
!
@@ -1481,7 +1559,7 @@
indent := 0.
(superclass notNil) ifTrue:[
- indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
+ indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
].
aStream spaces:indent.
aStream nextPutAll:name.
@@ -1507,7 +1585,7 @@
aStream cr.
(self subclasses sort:[:a :b | a name < b name]) do:[:aSubclass |
- aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
+ aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
]
"|printStream|
@@ -1527,9 +1605,9 @@
aPrintStream nextPutAll:'superclass '.
superclass isNil ifTrue:[
- aPrintStream nextPutAll:'Object'
+ aPrintStream nextPutAll:'Object'
] ifFalse:[
- aPrintStream nextPutAll:(superclass name)
+ aPrintStream nextPutAll:(superclass name)
].
aPrintStream cr.
@@ -1542,19 +1620,19 @@
aPrintStream cr.
category notNil ifTrue:[
- aPrintStream nextPutAll:'category '.
- aPrintStream nextPutAll:(category printString).
- aPrintStream cr
+ aPrintStream nextPutAll:'category '.
+ aPrintStream nextPutAll:(category printString).
+ aPrintStream cr
].
comment notNil ifTrue:[
- aPrintStream cr.
- aPrintStream nextPutAll:'comment:'.
- aPrintStream cr.
- aPrintStream italic.
- aPrintStream nextPutAll:comment.
- aPrintStream normal.
- aPrintStream cr
+ aPrintStream cr.
+ aPrintStream nextPutAll:'comment:'.
+ aPrintStream cr.
+ aPrintStream italic.
+ aPrintStream nextPutAll:comment.
+ aPrintStream normal.
+ aPrintStream cr
]
!
@@ -1571,30 +1649,30 @@
aPrintStream nextPutAll:(text at:1).
aPrintStream cr.
(text size >= 2) ifTrue:[
- aPrintStream italic.
- line := (text at:2).
- nQuote := line occurrencesOf:(Character doubleQuote).
- (nQuote == 2) ifTrue:[
- aPrintStream nextPutAll:line.
- aPrintStream cr
- ] ifFalse:[
- (nQuote == 1) ifTrue:[
- aPrintStream nextPutAll:line.
- aPrintStream cr.
- index := 3.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote).
- [nQuote ~~ 1] whileTrue:[
- aPrintStream nextPutAll:line.
- aPrintStream cr.
- index := index + 1.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote)
- ].
- aPrintStream nextPutAll:(text at:index).
- aPrintStream cr
- ]
- ]
+ aPrintStream italic.
+ line := (text at:2).
+ nQuote := line occurrencesOf:(Character doubleQuote).
+ (nQuote == 2) ifTrue:[
+ aPrintStream nextPutAll:line.
+ aPrintStream cr
+ ] ifFalse:[
+ (nQuote == 1) ifTrue:[
+ aPrintStream nextPutAll:line.
+ aPrintStream cr.
+ index := 3.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote).
+ [nQuote ~~ 1] whileTrue:[
+ aPrintStream nextPutAll:line.
+ aPrintStream cr.
+ index := index + 1.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote)
+ ].
+ aPrintStream nextPutAll:(text at:index).
+ aPrintStream cr
+ ]
+ ]
].
aPrintStream normal
!
@@ -1613,32 +1691,32 @@
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
+ 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
]
!
@@ -1647,27 +1725,27 @@
|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.
- aPrintStream cr.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- self printOutSource:(aMethod source) on:aPrintStream.
- aPrintStream cr.
- aPrintStream cr
- ]
- ].
- aPrintStream cr
- ]
+ any := false.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ any := true
+ ]
+ ].
+ any ifTrue:[
+ aPrintStream italic.
+ aPrintStream nextPutAll:aCategory.
+ aPrintStream normal.
+ aPrintStream cr.
+ aPrintStream cr.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ self printOutSource:(aMethod source) on:aPrintStream.
+ aPrintStream cr.
+ aPrintStream cr
+ ]
+ ].
+ aPrintStream cr
+ ]
]
!
@@ -1679,19 +1757,19 @@
aPrintStream cr.
collectionOfCategories := self class categories.
collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'class protocol'.
- aPrintStream cr. aPrintStream cr.
- collectionOfCategories do:[:aCategory |
- self class printOutCategory:aCategory on:aPrintStream
- ]
+ aPrintStream nextPutAll:'class protocol'.
+ aPrintStream cr. aPrintStream cr.
+ collectionOfCategories do:[:aCategory |
+ self class printOutCategory:aCategory on:aPrintStream
+ ]
].
collectionOfCategories := self categories.
collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'instance protocol'.
- aPrintStream cr. aPrintStream cr.
- collectionOfCategories do:[:aCategory |
- self printOutCategory:aCategory on:aPrintStream
- ]
+ aPrintStream nextPutAll:'instance protocol'.
+ aPrintStream cr. aPrintStream cr.
+ collectionOfCategories do:[:aCategory |
+ self printOutCategory:aCategory on:aPrintStream
+ ]
]
!
@@ -1699,28 +1777,28 @@
|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.
- aPrintStream cr.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- self printOutSourceProtocol:(aMethod source)
- on:aPrintStream.
- aPrintStream cr.
- aPrintStream cr
- ]
- ].
- aPrintStream cr
- ]
+ any := false.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ any := true
+ ]
+ ].
+ any ifTrue:[
+ aPrintStream italic.
+ aPrintStream nextPutAll:aCategory.
+ aPrintStream normal.
+ aPrintStream cr.
+ aPrintStream cr.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ self printOutSourceProtocol:(aMethod source)
+ on:aPrintStream.
+ aPrintStream cr.
+ aPrintStream cr
+ ]
+ ].
+ aPrintStream cr
+ ]
]
!
@@ -1730,19 +1808,19 @@
aPrintStream cr.
collectionOfCategories := self class categories.
collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'class protocol'.
- aPrintStream cr. aPrintStream cr.
- collectionOfCategories do:[:aCategory |
- self class printOutCategoryProtocol:aCategory on:aPrintStream
- ]
+ aPrintStream nextPutAll:'class protocol'.
+ aPrintStream cr. aPrintStream cr.
+ collectionOfCategories do:[:aCategory |
+ self class printOutCategoryProtocol:aCategory on:aPrintStream
+ ]
].
collectionOfCategories := self categories.
collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'instance protocol'.
- aPrintStream cr. aPrintStream cr.
- collectionOfCategories do:[:aCategory |
- self printOutCategoryProtocol:aCategory on:aPrintStream
- ]
+ aPrintStream nextPutAll:'instance protocol'.
+ aPrintStream cr. aPrintStream cr.
+ collectionOfCategories do:[:aCategory |
+ self printOutCategoryProtocol:aCategory on:aPrintStream
+ ]
]
! !
@@ -1751,9 +1829,9 @@
addGlobalsTo: globalDictionary manager: manager
"
classPool == nil ifFalse: [
- classPool associationsDo: [:assoc|
- globalDictionary at: assoc put: self
- ]
+ classPool associationsDo: [:assoc|
+ globalDictionary at: assoc put: self
+ ]
]
"
!