--- a/ClassDescription.st Mon Sep 20 10:45:23 2004 +0200
+++ b/ClassDescription.st Mon Sep 20 10:47:54 2004 +0200
@@ -75,86 +75,87 @@
[Instance variables:]
- instvars <String> the names of the instance variables
+ instvars <String> the names of the instance variables
+ | <Collection of words>
[Class variables:]
- UpdatingChanges <Boolean> true if the changes-file shall be updated
- (except during startup and when filing in, this flag
- is usually true)
- Please do no longer use this - see the two queries
- below.
-
- 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).
-
- UpdateChangeListQuerySignal used as an upQuery from the change management.
- Whenever a change is to be added to the changeSet,
- 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).
-
- 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.
-
- 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.
-
- TryLocalSourceFirst If true, local source files are tried
- first BEFORE the sourceCodeManager is
- consulted. If false, the sourceCodeManager
- is asked first.
- Should be turned on, if you run an image from
- local sources which have not yet been checked in.
-
- NameSpaceQuerySignal used as an upQuery to ask for a namespace into
- which new classes are to be installed.
-
- PackageQuerySignal used as an upQuery to ask for a packageSymbol with
- which new classes/methods are to be marked.
-
- CreateNameSpaceQuerySignal used as an upQuery to ask if unknown namespaces
- should be silently created (without asking the user)
-
- MethodHistory if nonNil, this must be an OrderedCollection,
- which is filled with method->previousversionMethod
- associations. Can be used for undo-last-method-change
- The number of remembered methods is controlled via the
- UserPreferences.
- Notice: this may fillup your memory over time,
- the preferences are set too high.
-
- MethodHistorySize the size of the methodHistory
- (nil: unlimited)
+ UpdatingChanges <Boolean> true if the changes-file shall be updated
+ (except during startup and when filing in, this flag
+ is usually true)
+ Please do no longer use this - see the two queries
+ below.
+
+ 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).
+
+ UpdateChangeListQuerySignal used as an upQuery from the change management.
+ Whenever a change is to be added to the changeSet,
+ 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).
+
+ 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.
+
+ 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.
+
+ TryLocalSourceFirst If true, local source files are tried
+ first BEFORE the sourceCodeManager is
+ consulted. If false, the sourceCodeManager
+ is asked first.
+ Should be turned on, if you run an image from
+ local sources which have not yet been checked in.
+
+ NameSpaceQuerySignal used as an upQuery to ask for a namespace into
+ which new classes are to be installed.
+
+ PackageQuerySignal used as an upQuery to ask for a packageSymbol with
+ which new classes/methods are to be marked.
+
+ CreateNameSpaceQuerySignal used as an upQuery to ask if unknown namespaces
+ should be silently created (without asking the user)
+
+ MethodHistory if nonNil, this must be an OrderedCollection,
+ which is filled with method->previousversionMethod
+ associations. Can be used for undo-last-method-change
+ The number of remembered methods is controlled via the
+ UserPreferences.
+ Notice: this may fillup your memory over time,
+ the preferences are set too high.
+
+ MethodHistorySize the size of the methodHistory
+ (nil: unlimited)
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Behavior Class Metaclass
+ Behavior Class Metaclass
"
! !
@@ -165,16 +166,16 @@
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 := CatchClassRedefinitions := true.
TryLocalSourceFirst := false.
FileOutErrorSignal isNil ifTrue:[
- FileOutErrorSignal := Error newSignalMayProceed:true.
- FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.
- FileOutErrorSignal notifierString:'error during fileOut'.
+ FileOutErrorSignal := Error newSignalMayProceed:true.
+ FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.
+ FileOutErrorSignal notifierString:'error during fileOut'.
"/ MethodRedefinitionSignal := QuerySignal new.
"/ MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal.
@@ -186,65 +187,65 @@
"/ ClassRedefinitionSignal notifierString:'attempt to redefine class from different package'.
"/ ClassRedefinitionSignal defaultAnswer:#keep.
- UpdateChangeFileQuerySignal := QuerySignal new.
- UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal.
- UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'.
- UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
-
- UpdateChangeListQuerySignal := QuerySignal new.
- UpdateChangeListQuerySignal nameClass:self message:#updateChangeListQuerySignal.
- UpdateChangeListQuerySignal notifierString:'asking if changeList update is wanted'.
- UpdateChangeListQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
-
- NameSpaceQuerySignal isNil ifTrue:[
- NameSpaceQuerySignal := QuerySignal new.
- NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.
- NameSpaceQuerySignal notifierString:'asking for nameSpace'.
- NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk defaultNameSpace].
- ].
- UsedNameSpaceQuerySignal isNil ifTrue:[
- UsedNameSpaceQuerySignal := QuerySignal new.
- UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.
- UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.
- ].
-
- CreateNameSpaceQuerySignal := QuerySignal new.
- CreateNameSpaceQuerySignal nameClass:self message:#createNameSpaceQuerySignal.
- CreateNameSpaceQuerySignal notifierString:'asking for nameSpace creation'.
- CreateNameSpaceQuerySignal defaultAnswer:false.
-
- ClassConventionViolationConfirmationQuerySignal := QuerySignal new.
- ClassConventionViolationConfirmationQuerySignal nameClass:self message:#classConventionViolationConfirmationQuerySignal.
- ClassConventionViolationConfirmationQuerySignal notifierString:'asking for class convention'.
-
- PackageQuerySignal := QuerySignal new.
- PackageQuerySignal nameClass:self message:#packageQuerySignal.
- PackageQuerySignal notifierString:'asking for package'.
- PackageQuerySignal handlerBlock:[:ex | ex proceedWith:(Project isNil
- ifTrue:[
- nil
- ] ifFalse:[
- Project currentPackageName
- ])].
-
- FileOutNameSpaceQuerySignal := QuerySignal new.
- FileOutNameSpaceQuerySignal defaultAnswer:false.
-
- ForceNoNameSpaceQuerySignal := QuerySignal new.
- ForceNoNameSpaceQuerySignal defaultAnswer:false.
-
- ChangeFileAccessLock := RecursionLock new.
- ChangeFileAccessLock name:'ChangeFileAccessLock'.
+ UpdateChangeFileQuerySignal := QuerySignal new.
+ UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal.
+ UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'.
+ UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
+
+ UpdateChangeListQuerySignal := QuerySignal new.
+ UpdateChangeListQuerySignal nameClass:self message:#updateChangeListQuerySignal.
+ UpdateChangeListQuerySignal notifierString:'asking if changeList update is wanted'.
+ UpdateChangeListQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
+
+ NameSpaceQuerySignal isNil ifTrue:[
+ NameSpaceQuerySignal := QuerySignal new.
+ NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.
+ NameSpaceQuerySignal notifierString:'asking for nameSpace'.
+ NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk defaultNameSpace].
+ ].
+ UsedNameSpaceQuerySignal isNil ifTrue:[
+ UsedNameSpaceQuerySignal := QuerySignal new.
+ UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.
+ UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.
+ ].
+
+ CreateNameSpaceQuerySignal := QuerySignal new.
+ CreateNameSpaceQuerySignal nameClass:self message:#createNameSpaceQuerySignal.
+ CreateNameSpaceQuerySignal notifierString:'asking for nameSpace creation'.
+ CreateNameSpaceQuerySignal defaultAnswer:false.
+
+ ClassConventionViolationConfirmationQuerySignal := QuerySignal new.
+ ClassConventionViolationConfirmationQuerySignal nameClass:self message:#classConventionViolationConfirmationQuerySignal.
+ ClassConventionViolationConfirmationQuerySignal notifierString:'asking for class convention'.
+
+ PackageQuerySignal := QuerySignal new.
+ PackageQuerySignal nameClass:self message:#packageQuerySignal.
+ PackageQuerySignal notifierString:'asking for package'.
+ PackageQuerySignal handlerBlock:[:ex | ex proceedWith:(Project isNil
+ ifTrue:[
+ nil
+ ] ifFalse:[
+ Project currentPackageName
+ ])].
+
+ FileOutNameSpaceQuerySignal := QuerySignal new.
+ FileOutNameSpaceQuerySignal defaultAnswer:false.
+
+ ForceNoNameSpaceQuerySignal := QuerySignal new.
+ ForceNoNameSpaceQuerySignal defaultAnswer:false.
+
+ ChangeFileAccessLock := RecursionLock new.
+ ChangeFileAccessLock name:'ChangeFileAccessLock'.
].
DefaultApplicationQuerySignal isNil ifTrue:[
- DefaultApplicationQuerySignal := QuerySignal new defaultAnswer:nil.
- DefaultApplicationQuerySignal nameClass:self message:#defaultApplicationQuerySignal.
- DefaultApplicationQuerySignal notifierString:'query for default application'.
-
- ChangeDefaultApplicationNotificationSignal := QuerySignal new defaultAnswer:nil.
- ChangeDefaultApplicationNotificationSignal nameClass:self message:#changeDefaultApplicationNotificationSignal.
- ChangeDefaultApplicationNotificationSignal notifierString:'change default application'.
+ DefaultApplicationQuerySignal := QuerySignal new defaultAnswer:nil.
+ DefaultApplicationQuerySignal nameClass:self message:#defaultApplicationQuerySignal.
+ DefaultApplicationQuerySignal notifierString:'query for default application'.
+
+ ChangeDefaultApplicationNotificationSignal := QuerySignal new defaultAnswer:nil.
+ ChangeDefaultApplicationNotificationSignal nameClass:self message:#changeDefaultApplicationNotificationSignal.
+ ChangeDefaultApplicationNotificationSignal notifierString:'change default application'.
].
"
@@ -363,10 +364,10 @@
Will be used when filing in code"
NameSpaceQuerySignal isNil ifTrue:[
- NameSpaceQuerySignal := QuerySignal new.
- NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.
- NameSpaceQuerySignal notifierString:'asking for nameSpace'.
- NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk defaultNameSpace].
+ NameSpaceQuerySignal := QuerySignal new.
+ NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.
+ NameSpaceQuerySignal notifierString:'asking for nameSpace'.
+ NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk defaultNameSpace].
].
^ NameSpaceQuerySignal
@@ -422,9 +423,9 @@
Will be used when filing in code"
UsedNameSpaceQuerySignal isNil ifTrue:[
- UsedNameSpaceQuerySignal := QuerySignal new.
- UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.
- UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.
+ UsedNameSpaceQuerySignal := QuerySignal new.
+ UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.
+ UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.
].
^ UsedNameSpaceQuerySignal
@@ -442,7 +443,7 @@
!
catchClassRedefinitions:aBoolean
- "turn on/off class redefinition catching.
+ "turn on/off class redefinition catching.
If on, redefining classes from another package will show a
warning dialog. Useful, when filing in alien code to avoid defefinition
of system methods.
@@ -466,7 +467,7 @@
!
catchMethodRedefinitions:aBoolean
- "turn on/off method redefinition catching.
+ "turn on/off method redefinition catching.
If on, redefining methods from another package will show a
warning dialog. Useful, when filing in alien code to avoid defefinition
of system methods.
@@ -486,11 +487,11 @@
is kept locally, for later undo (or compare)."
aBoolean ifTrue:[
- MethodHistory isNil ifTrue:[
- MethodHistory := OrderedCollection new.
- ]
+ MethodHistory isNil ifTrue:[
+ MethodHistory := OrderedCollection new.
+ ]
] ifFalse:[
- MethodHistory := nil
+ MethodHistory := nil
].
"
@@ -525,7 +526,7 @@
all method history is lost."
MethodHistory notNil ifTrue:[
- MethodHistory := OrderedCollection new
+ MethodHistory := OrderedCollection new
].
"Created: 7.11.1996 / 19:07:25 / cg"
@@ -535,7 +536,7 @@
"return a dictionary containing method->previousVersion associations,
nil if method remembering has been turned off"
- ^ MethodHistory
+ ^ MethodHistory
"
Class methodHistory
@@ -556,8 +557,8 @@
Smalltalk allClassesInCategory:aCategory do:aBlock
"
- Class allClassesInCategory:'Kernel-Classes'
- do:[:class |Transcript showCR:class name]
+ Class allClassesInCategory:'Kernel-Classes'
+ do:[:class |Transcript showCR:class name]
"
"Created: / 1.4.1997 / 23:45:09 / stefan"
@@ -639,47 +640,47 @@
newNames := self instanceVariableString , ' ' , anotherInstVar.
self isMeta ifTrue:[
- ^ self instanceVariableNames:newNames.
+ ^ self instanceVariableNames:newNames.
].
sel := self definitionSelector.
Class nameSpaceQuerySignal answer:(self nameSpace)
do:[
- args := Array
- with:(self nameWithoutPrefix asSymbol)
- with:newNames
- with:(self classVariableString)
- with:''
- with:(self category).
-
- sel numArgs == 6 ifTrue:[
- args := args copyWith:(self owningClass).
- ].
-
- newClass := self superclass
- perform:sel withArguments:args.
- newClass isNil ifTrue:[
- self error:'oops - cannot compile newClass'.
- ] ifFalse:[
- newClass recompile.
- ]
+ args := Array
+ with:(self nameWithoutPrefix asSymbol)
+ with:newNames
+ with:(self classVariableString)
+ with:''
+ with:(self category).
+
+ sel numArgs == 6 ifTrue:[
+ args := args copyWith:(self owningClass).
+ ].
+
+ newClass := self superclass
+ perform:sel withArguments:args.
+ newClass isNil ifTrue:[
+ self error:'oops - cannot compile newClass'.
+ ] ifFalse:[
+ newClass recompile.
+ ]
].
^ newClass
!
organization
- "for ST80 compatibility;
+ "for ST80 compatibility;
read the documentation in ClassOrganizer for more info."
^ ClassOrganizer for:self
!
preSave: aParcel
- "Allow additional process of a Parcel before writing. This method works
- with the matching method postLoad:, to handle additional processing
- after loading a Parcel. The typical operation to do here is to save
- named objects to aParcel (and retrieve them in postLoad:)."
+ "Allow additional process of a Parcel before writing. This method works
+ with the matching method postLoad:, to handle additional processing
+ after loading a Parcel. The typical operation to do here is to save
+ named objects to aParcel (and retrieve them in postLoad:)."
!
removeInstVarName:anInstVar
@@ -690,33 +691,33 @@
newNames := newNames asStringWith:Character space.
self isMeta ifTrue:[
- ^ self instanceVariableNames:newNames.
+ ^ self instanceVariableNames:newNames.
].
sel := self definitionSelector.
Class nameSpaceQuerySignal answer:(self nameSpace)
do:[
- args := Array
- with:(self nameWithoutPrefix asSymbol)
- with:newNames
- with:(self classVariableString)
- with:''
- with:(self category).
-
- sel numArgs == 6 ifTrue:[
- args := args copyWith:(self owningClass).
- ].
-
- newClass := self superclass
- perform:sel withArguments:args.
- newClass recompile.
+ args := Array
+ with:(self nameWithoutPrefix asSymbol)
+ with:newNames
+ with:(self classVariableString)
+ with:''
+ with:(self category).
+
+ sel numArgs == 6 ifTrue:[
+ args := args copyWith:(self owningClass).
+ ].
+
+ newClass := self superclass
+ perform:sel withArguments:args.
+ newClass recompile.
].
^ newClass
!
reorganize
- "for ST80 compatibility;
+ "for ST80 compatibility;
nothing done here."
!
@@ -737,7 +738,7 @@
|mthd|
(mthd := self compiledMethodAt:aSelector) notNil ifTrue:[
- mthd category:listOfCategories first.
+ mthd category:listOfCategories first.
].
"Created: / 15.6.1998 / 17:11:02 / cg"
@@ -814,13 +815,13 @@
mthd := self compile: aString classified: protocol.
attributes notEmpty ifTrue:[
- attributes keysAndValuesDo:[:aK :aV |
- aK = 'package' ifTrue:[
- "/ mthd package:aV
- ] ifFalse:[
- self error:(aK , '-attribute not yet supported') mayProceed:true.
- ].
- ].
+ attributes keysAndValuesDo:[:aK :aV |
+ aK = 'package' ifTrue:[
+ "/ mthd package:aV
+ ] ifFalse:[
+ self error:(aK , '-attribute not yet supported') mayProceed:true.
+ ].
+ ].
].
^ mthd.
@@ -829,7 +830,7 @@
defineStatic:name private:private constant:constant category:category initializer:initializer attributes:annotations
self addClassVarName:name.
initializer notNil ifTrue:[
- self shouldImplement
+ self shouldImplement
].
! !
@@ -845,11 +846,12 @@
^ s contents
"
- Object definition
- Point definition
- Array definition
- ByteArray definition
- FloatArray definition
+ Object definition
+ Point definition
+ Array definition
+ ByteArray definition
+ FloatArray definition
+ OpenGLConstantImporter definition
"
"Created: / 19.6.1998 / 02:25:49 / cg"
@@ -866,18 +868,18 @@
"return a collection of the instance variable name-strings"
instvars isNil ifTrue:[
- ^ #()
+ ^ #()
].
instvars isString ifTrue:[
- instvars := instvars asCollectionOfWords asArray collect:[:varName| varName asSymbol].
+ instvars := instvars asCollectionOfWords asArray collect:[:varName| varName asSymbol].
].
^ instvars
"
- Point instVarNames
- SortedCollection instVarNames
- SortedCollection allInstVarNames
+ Point instVarNames
+ SortedCollection instVarNames
+ SortedCollection allInstVarNames
"
"Modified: 22.8.1997 / 17:43:05 / cg"
@@ -902,9 +904,9 @@
^ nil
"
- Point instVarOffsetOf:'x'
+ Point instVarOffsetOf:'x'
View instVarOffsetOf:'paint'
- Button instVarOffsetOf:'logo'
+ Button instVarOffsetOf:'logo'
"
"Modified: 23.8.1997 / 16:59:15 / cg"
@@ -921,8 +923,8 @@
^ dict
"
- Point instanceVariableOffsets
- GraphicsContext instanceVariableOffsets
+ Point instanceVariableOffsets
+ GraphicsContext instanceVariableOffsets
"
!
@@ -937,7 +939,7 @@
^ instvars asStringWith:(Character space)
"
- Point instanceVariableString
+ Point instanceVariableString
"
"Modified: 22.8.1997 / 14:59:14 / cg"
@@ -959,13 +961,13 @@
any := false.
self methodDictionary 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.
]
"Modified: 12.6.1996 / 11:49:08 / stefan"
@@ -976,7 +978,7 @@
addSelector:newSelector withMethod:newMethod
"add the method given by 2nd argument under the selector given by
- 1st argument to the methodDictionary.
+ 1st argument to the methodDictionary.
Append a change record to the changes file and tell dependents."
|oldMethod oldPackage newPackage|
@@ -984,70 +986,70 @@
oldMethod := self compiledMethodAt:newSelector.
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 notNil ifTrue:[
- oldPackage := oldMethod package.
- newPackage := newMethod package.
- oldPackage ~= newPackage ifTrue:[
- "
- attempt to redefine an existing method, which was
- defined in another package (see oldPackage vs. newPackage).
- If you continue in the debugger, the new method gets installed.
- Otherwise, the existing (old) method remains valid.
-
- This check was added to help prevent accidental modifications
- of system code - especially, when alien code is filedIn.
- After you became familiar with the system, may want to disable this
- check if it becomes too annoying (and only turn it on
- temporarily, when filing in unknown code-files).
-
- You can turn off the catching of redefinitions by setting
- my classVariable
- CatchMethodRedefinitions
- to false.
- (also found in the Launchers 'settings-compilation' menu)
- "
- (Class methodRedefinitionSignal
- raiseRequestWith:(oldMethod -> newMethod)
- errorString:('redefinition of method: ' , self name , '>>' , newSelector)
- ) == #keep ifTrue:[
- newMethod setPackage:oldMethod package
- ].
-
- "/ if proceeded, install as usual.
- ]
- ]
+ "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 notNil ifTrue:[
+ oldPackage := oldMethod package.
+ newPackage := newMethod package.
+ oldPackage ~= newPackage ifTrue:[
+ "
+ attempt to redefine an existing method, which was
+ defined in another package (see oldPackage vs. newPackage).
+ If you continue in the debugger, the new method gets installed.
+ Otherwise, the existing (old) method remains valid.
+
+ This check was added to help prevent accidental modifications
+ of system code - especially, when alien code is filedIn.
+ After you became familiar with the system, may want to disable this
+ check if it becomes too annoying (and only turn it on
+ temporarily, when filing in unknown code-files).
+
+ You can turn off the catching of redefinitions by setting
+ my classVariable
+ CatchMethodRedefinitions
+ to false.
+ (also found in the Launchers 'settings-compilation' menu)
+ "
+ (Class methodRedefinitionSignal
+ raiseRequestWith:(oldMethod -> newMethod)
+ errorString:('redefinition of method: ' , self name , '>>' , newSelector)
+ ) == #keep ifTrue:[
+ newMethod setPackage:oldMethod package
+ ].
+
+ "/ if proceeded, install as usual.
+ ]
+ ]
].
"/ remember new->old association in the MethodHistory dictionary (if non-nil)
MethodHistory notNil ifTrue:[
- oldMethod notNil ifTrue:[
- MethodHistory add:(Array with:#methodChange with:oldMethod with:newMethod).
- (MethodHistorySize notNil and:[MethodHistory size > MethodHistorySize]) ifTrue:[
- MethodHistory removeFirst.
- ]
- ]
+ oldMethod notNil ifTrue:[
+ MethodHistory add:(Array with:#methodChange with:oldMethod with:newMethod).
+ (MethodHistorySize notNil and:[MethodHistory size > MethodHistorySize]) ifTrue:[
+ MethodHistory removeFirst.
+ ]
+ ]
].
"/ remember in the projects overwritten dictionary
oldMethod notNil ifTrue:[
- oldMethod package ~= newMethod package ifTrue:[
- Project notNil ifTrue:[
- "/ allow configurations without Project
- Project rememberOverwrittenMethod:newMethod from:oldMethod
- ]
- ]
+ oldMethod package ~= newMethod package ifTrue:[
+ Project notNil ifTrue:[
+ "/ allow configurations without Project
+ Project rememberOverwrittenMethod:newMethod from:oldMethod
+ ]
+ ]
].
(super addSelector:newSelector withMethod:newMethod) ifTrue:[
- self addChangeRecordForMethod:newMethod fromOld:oldMethod.
+ self addChangeRecordForMethod:newMethod fromOld:oldMethod.
]
"Modified: / 9.9.1996 / 22:39:32 / stefan"
@@ -1057,8 +1059,8 @@
basicAddSelector:newSelector withMethod:newMethod
"add the method given by 2nd argument under the selector given by
- 1st argument to the methodDictionary.
- This does NOT append a change record to the changes file and tell
+ 1st argument to the methodDictionary.
+ This does NOT append a change record to the changes file and tell
dependents. Also, no methodHistory is kept or redefinition is checked."
super addSelector:newSelector withMethod:newMethod
@@ -1067,7 +1069,7 @@
!
removeSelector:aSelector
- "remove the selector, aSelector and its associated method
+ "remove the selector, aSelector and its associated method
from the methodDictionary.
Append a change record to the changes file and tell dependents."
@@ -1076,28 +1078,28 @@
oldMethod := self compiledMethodAt:aSelector.
MethodHistory notNil ifTrue:[
- oldMethod notNil ifTrue:[
- MethodHistory add:(Array with:#methodRemove with:oldMethod).
- (MethodHistorySize notNil and:[MethodHistory size > MethodHistorySize]) ifTrue:[
- MethodHistory removeFirst.
- ]
- ]
+ oldMethod notNil ifTrue:[
+ MethodHistory add:(Array with:#methodRemove with:oldMethod).
+ (MethodHistorySize notNil and:[MethodHistory size > MethodHistorySize]) ifTrue:[
+ MethodHistory removeFirst.
+ ]
+ ]
].
(super removeSelector:aSelector) ifTrue:[
- self addChangeRecordForRemoveSelector:aSelector fromOld:oldMethod.
- "/
- "/ also notify a change of mySelf;
- "/
- self changed:#methodDictionary with:aSelector.
-
- "/
- "/ also notify a change of Smalltalk;
- "/ this allows a dependent of Smalltalk to watch all class
- "/ changes (no need for observing all classes)
- "/ - this allows for watchers to find out if its a new method or a method-change
- "/
- Smalltalk changed:#methodInClassRemoved with:(Array with:self with:aSelector).
+ self addChangeRecordForRemoveSelector:aSelector fromOld:oldMethod.
+ "/
+ "/ also notify a change of mySelf;
+ "/
+ self changed:#methodDictionary with:aSelector.
+
+ "/
+ "/ also notify a change of Smalltalk;
+ "/ this allows a dependent of Smalltalk to watch all class
+ "/ changes (no need for observing all classes)
+ "/ - this allows for watchers to find out if its a new method or a method-change
+ "/
+ Smalltalk changed:#methodInClassRemoved with:(Array with:self with:aSelector).
]
"Modified: 8.1.1997 / 23:03:49 / cg"
@@ -1113,19 +1115,19 @@
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:
+ 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
+ StubGenerator
+ createStubFor:selector
+ calling:cFunctionNameString
+ args:argTypeArray
returning:returnType
- in:self
+ in:self
"
Object subclass:#CInterface
@@ -1134,12 +1136,12 @@
poolDictionaries:''
category:'Examples'.
- CInterface cInterfaceFunction:#printfOn:format:withFloat:
- calling:'fprintf'
- args:#(ExternalStream String Float)
+ 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
+ CInterface printfOn:Stdout format:'this is a float: %g' withFloat:(Float pi). Stdout cr
"
"Modified: 5.1.1997 / 19:58:22 / cg"
@@ -1154,14 +1156,14 @@
"add a method-change-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
+ self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addMethodChange:aMethod in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addMethodChange:aMethod in:self
+ ]
]
"Modified: / 20.1.1997 / 12:36:02 / cg"
@@ -1175,14 +1177,14 @@
"add a method-change-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
+ self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addMethodChange:aMethod fromOld:oldMethod in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addMethodChange:aMethod fromOld:oldMethod in:self
+ ]
]
"Modified: / 20.1.1997 / 12:36:02 / cg"
@@ -1198,19 +1200,19 @@
"add a methodCategory-change-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- (mthd := aMethodOrSelector) isSymbol ifTrue:[
- mthd := self compiledMethodAt:aMethodOrSelector
- ].
- self writingChangeDo:[:aStream |
- self addChangeRecordForMethodCategory:mthd category:aString to:aStream.
- ].
+ (mthd := aMethodOrSelector) isSymbol ifTrue:[
+ mthd := self compiledMethodAt:aMethodOrSelector
+ ].
+ self writingChangeDo:[:aStream |
+ self addChangeRecordForMethodCategory:mthd category:aString to:aStream.
+ ].
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addMethodCategoryChange:mthd category:aString in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addMethodCategoryChange:mthd category:aString in:self
+ ]
].
"Modified: / 18.3.1999 / 18:16:50 / stefan"
@@ -1223,14 +1225,14 @@
"add a method-privacy-change-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForMethodPrivacy:to: with:aMethod.
+ self writingChangePerform:#addChangeRecordForMethodPrivacy:to: with:aMethod.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addMethodPrivacyChange:aMethod in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addMethodPrivacyChange:aMethod in:self
+ ]
]
"Modified: / 27.8.1995 / 22:47:32 / claus"
@@ -1245,14 +1247,14 @@
"add a method-remove-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
+ self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addRemoveSelectorChange:aSelector fromOld:oldMethod in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addRemoveSelectorChange:aSelector fromOld:oldMethod in:self
+ ]
].
"Created: / 2.4.1997 / 17:30:47 / stefan"
@@ -1266,16 +1268,16 @@
"add a category-rename record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangeDo:[:aStream |
- self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
- ].
+ self writingChangeDo:[:aStream |
+ self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
+ ].
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addRenameCategoryChangeIn:self from:oldCategory to:newCategory
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addRenameCategoryChangeIn:self from:oldCategory to:newCategory
+ ]
]
"Created: / 2.4.1997 / 17:31:03 / stefan"
@@ -1303,9 +1305,9 @@
"add an info-record (snapshot, class fileOut etc.) to the changes file"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangeWithTimeStamp:false
- perform:#addInfoRecord:to:
- with:aMessage.
+ self writingChangeWithTimeStamp:false
+ perform:#addInfoRecord:to:
+ with:aMessage.
]
"Modified: / 24.1.1997 / 19:13:14 / cg"
@@ -1316,42 +1318,42 @@
changesStream
"return a Stream for the writing changes file.
This returns a regular stream or a locked stream - according to
- the LockChangesFile settings
+ the LockChangesFile settings
(recommended if multiple images operate on a common changes file)"
- |streamType changesStream fileName
+ |streamType changesStream fileName
encoding encoder changeFileIsNew|
fileName := ObjectMemory nameForChanges.
-
+
LockChangesFile ifTrue:[
- streamType := LockedFileStream.
+ streamType := LockedFileStream.
] ifFalse:[
- streamType := FileStream.
+ streamType := FileStream.
].
changeFileIsNew := fileName asFilename exists not or:[fileName asFilename fileSize = 0].
changeFileIsNew ifTrue:[
- encoder := CharacterEncoder encoderForUTF8.
+ encoder := CharacterEncoder encoderForUTF8.
] ifFalse:[
- encoding := SourceCodeManagerUtilities guessEncodingOfFile:fileName.
- encoding isNil ifTrue:[
- encoding := #'iso8859-1'.
- ].
- encoder := CharacterEncoder encoderFor:encoding.
+ encoding := SourceCodeManagerUtilities guessEncodingOfFile:fileName.
+ encoding isNil ifTrue:[
+ encoding := #'iso8859-1'.
+ ].
+ encoder := CharacterEncoder encoderFor:encoding.
].
[
- changesStream := streamType fileNamed:fileName.
- ] on:FileStream openErrorSignal do:[:ex|
- self warn:'cannot create/update the changes file (check permissions)'.
- ^ nil
+ changesStream := streamType fileNamed:fileName.
+ ] on:FileStream openErrorSignal do:[:ex|
+ self warn:'cannot create/update the changes file (check permissions)'.
+ ^ nil
].
changesStream setToEnd.
changesStream := EncodedStream stream:changesStream encoder:encoder.
changeFileIsNew ifTrue:[
- changesStream nextPutLine:'"{ Encoding: ' , encoder nameOfEncoding , ' }" !!'.
+ changesStream nextPutLine:'"{ Encoding: ' , encoder nameOfEncoding , ' }" !!'.
].
^ changesStream
@@ -1368,10 +1370,10 @@
UpdateChangeFileQuerySignal answer:false
do:[
- UpdateChangeListQuerySignal answer:false
- do:[
- retVal := aBlock value
- ].
+ UpdateChangeListQuerySignal answer:false
+ do:[
+ retVal := aBlock value
+ ].
].
^ retVal
@@ -1383,8 +1385,8 @@
compiler
"return the compiler to use for this class.
- OBSOLETE: This is the old ST/X interface, kept for migration.
- Dont use it - it will vanish."
+ OBSOLETE: This is the old ST/X interface, kept for migration.
+ Dont use it - it will vanish."
<resource:#obsolete>
@@ -1397,21 +1399,21 @@
!ClassDescription methodsFor:'compiling'!
compile:code
- "compile code, aString for this class;
+ "compile code, aString for this class;
if successful update the method dictionary.
Returns the new method or nil (on failure)."
- ^ self compilerClass
- compile:code
- forClass:self
+ ^ self compilerClass
+ compile:code
+ forClass:self
"Modified: 13.12.1995 / 10:56:00 / cg"
"Created: 1.4.1997 / 23:43:51 / stefan"
!
compile:code classified:category
- "compile code, aString for this class;
- if successful update the method dictionary.
+ "compile code, aString for this class;
+ if successful update the method dictionary.
The method is classified under category.
Returns the new method or nil (on failure)."
@@ -1422,8 +1424,8 @@
!
compile:code classified:category logged:logged
- "compile code, aString for this class;
- if successful update the method dictionary.
+ "compile code, aString for this class;
+ if successful update the method dictionary.
The method is classified under category.
If logged is true, a changeRecord is written.
Returns the new method or nil (on failure)."
@@ -1433,17 +1435,17 @@
compiler := self compilerClass.
logged ifFalse:[
- self withoutUpdatingChangesDo:[
- ^ compiler
- compile:code
- forClass:self
- inCategory:category
- ]
+ self withoutUpdatingChangesDo:[
+ ^ compiler
+ compile:code
+ forClass:self
+ inCategory:category
+ ]
] ifTrue:[
- ^ compiler
- compile:code
- forClass:self
- inCategory:category
+ ^ compiler
+ compile:code
+ forClass:self
+ inCategory:category
].
"Modified: 13.12.1995 / 11:02:34 / cg"
@@ -1456,11 +1458,11 @@
Install the method under the category, cat.
Returns the new method or nil (on failure)."
- ^ self compilerClass
- compile:code
- forClass:self
- inCategory:cat
- notifying:requestor
+ ^ self compilerClass
+ compile:code
+ forClass:self
+ inCategory:cat
+ notifying:requestor
"Modified: / 13.12.1995 / 11:02:40 / cg"
"Created: / 18.6.1998 / 15:52:15 / cg"
@@ -1471,10 +1473,10 @@
requestor, anObject with the error reason.
Returns the new method or nil (on failure)."
- ^ self compilerClass
- compile:code
- forClass:self
- notifying:requestor
+ ^ self compilerClass
+ compile:code
+ forClass:self
+ notifying:requestor
"Modified: 13.12.1995 / 11:02:40 / cg"
"Created: 1.4.1997 / 23:43:43 / stefan"
@@ -1487,13 +1489,13 @@
|rslt|
- rslt := self compilerClass
- compile:code
- forClass:self
- notifying:requestor.
+ rslt := self compilerClass
+ compile:code
+ forClass:self
+ notifying:requestor.
(rslt isNil or:[rslt == #Error]) ifTrue:[
- ^ failBlock value
+ ^ failBlock value
].
^ rslt
@@ -1509,7 +1511,7 @@
have to be recompiled"
self selectorsAndMethodsDo:[:aSelector :aMethod |
- self recompile:aSelector
+ self recompile:aSelector
]
"Modified: 12.6.1996 / 11:51:15 / stefan"
@@ -1527,28 +1529,28 @@
|cat code compiler oldMethod oldPackage newMethod|
Class withoutUpdatingChangesDo:[
- oldMethod := self compiledMethodAt:aSelector.
- oldPackage := oldMethod package.
- cat := oldMethod category.
- code := self sourceCodeAt:aSelector.
- compiler := self compilerClass.
-
- Class methodRedefinitionSignal answer:#keep do:[
- (compiler respondsTo:#compile:forClass:inCategory:)
- ifTrue:[
- "/ ST/X's compiler
- compiler compile:code forClass:self inCategory:cat
- ] ifFalse:[
- "/ some other (TGEN) compiler
- compiler new
- compile:code
- in:self
- notifying:nil
- ifFail:[].
- ].
- ].
- newMethod := self compiledMethodAt:aSelector.
- newMethod setPackage:oldPackage.
+ oldMethod := self compiledMethodAt:aSelector.
+ oldPackage := oldMethod package.
+ cat := oldMethod category.
+ code := self sourceCodeAt:aSelector.
+ compiler := self compilerClass.
+
+ Class methodRedefinitionSignal answer:#keep do:[
+ (compiler respondsTo:#compile:forClass:inCategory:)
+ ifTrue:[
+ "/ ST/X's compiler
+ compiler compile:code forClass:self inCategory:cat
+ ] ifFalse:[
+ "/ some other (TGEN) compiler
+ compiler new
+ compile:code
+ in:self
+ notifying:nil
+ ifFail:[].
+ ].
+ ].
+ newMethod := self compiledMethodAt:aSelector.
+ newMethod setPackage:oldPackage.
]
"Created: / 1.4.1997 / 23:43:34 / stefan"
@@ -1583,26 +1585,26 @@
|cat code prev oldMethod oldPackage newMethod|
Class withoutUpdatingChangesDo:[
- oldMethod := self compiledMethodAt:aSelector.
- oldPackage := oldMethod package.
- cat := oldMethod category.
- code := self sourceCodeAt:aSelector.
-
- Class methodRedefinitionSignal answer:#keep do:[
- prev := Compiler stcCompilation:#always.
-
- [
- self compilerClass compile:code forClass:self inCategory:cat
- ] ensure:[
- Compiler stcCompilation:prev.
-
- (self compiledMethodAt:aSelector) isNil ifTrue:[
- self primAddSelector:aSelector withMethod:oldMethod
- ]
- ]
- ].
- newMethod := self compiledMethodAt:aSelector.
- newMethod package:oldPackage.
+ oldMethod := self compiledMethodAt:aSelector.
+ oldPackage := oldMethod package.
+ cat := oldMethod category.
+ code := self sourceCodeAt:aSelector.
+
+ Class methodRedefinitionSignal answer:#keep do:[
+ prev := Compiler stcCompilation:#always.
+
+ [
+ self compilerClass compile:code forClass:self inCategory:cat
+ ] ensure:[
+ Compiler stcCompilation:prev.
+
+ (self compiledMethodAt:aSelector) isNil ifTrue:[
+ self primAddSelector:aSelector withMethod:oldMethod
+ ]
+ ]
+ ].
+ newMethod := self compiledMethodAt:aSelector.
+ newMethod package:oldPackage.
]
"Modified: 5.1.1997 / 19:55:33 / cg"
@@ -1615,16 +1617,16 @@
"recompile all invalidated methods"
self selectorsAndMethodsDo:[:aSelector :aMethod |
- |trap trapCode trapByteCode|
-
- trap := aMethod trapMethodForNumArgs:aMethod numArgs.
- trapCode := trap code.
- trapByteCode := trap byteCode.
-
- (aMethod code = trapCode
- or:[aMethod byteCode == trapByteCode]) ifTrue:[
- self recompile:aSelector
- ]
+ |trap trapCode trapByteCode|
+
+ trap := aMethod trapMethodForNumArgs:aMethod numArgs.
+ trapCode := trap code.
+ trapByteCode := trap byteCode.
+
+ (aMethod code = trapCode
+ or:[aMethod byteCode == trapByteCode]) ifTrue:[
+ self recompile:aSelector
+ ]
]
"Modified: 12.6.1996 / 11:52:09 / stefan"
@@ -1652,33 +1654,33 @@
|p|
self selectorsAndMethodsDo:[:aSelector :aMethod |
- |mustCompile lits source|
-
- mustCompile := nil.
-
- source := aMethod source.
-
- "/ avoid parsing, if possible
- superBoolean ifFalse:[
- setOfNames size == 1 ifTrue:[
- (source findString:(setOfNames first)) == 0 ifTrue:[
- mustCompile := false.
- ]
- ]
- ].
-
- mustCompile isNil ifTrue:[
- p := Parser parseMethod:source in:self.
- (p isNil
- or:[(p usedVars includesAny:setOfNames)
- or:[superBoolean and:[p usesSuper]]]) ifTrue:[
- mustCompile := true
- ]
- ].
-
- mustCompile == true ifTrue:[
- self recompile:aSelector
- ]
+ |mustCompile lits source|
+
+ mustCompile := nil.
+
+ source := aMethod source.
+
+ "/ avoid parsing, if possible
+ superBoolean ifFalse:[
+ setOfNames size == 1 ifTrue:[
+ (source findString:(setOfNames first)) == 0 ifTrue:[
+ mustCompile := false.
+ ]
+ ]
+ ].
+
+ mustCompile isNil ifTrue:[
+ p := Parser parseMethod:source in:self.
+ (p isNil
+ or:[(p usedVars includesAny:setOfNames)
+ or:[superBoolean and:[p usesSuper]]]) ifTrue:[
+ mustCompile := true
+ ]
+ ].
+
+ mustCompile == true ifTrue:[
+ self recompile:aSelector
+ ]
]
"Modified: 12.6.1996 / 11:52:35 / stefan"
@@ -1694,23 +1696,23 @@
"/ Transcript showCR:self name , ' recompiling accesses to ' , aCollection printString.
self selectorsAndMethodsDo:[:aSelector :aMethod |
- (aMethod literalsDetect:[ :lit | |i l|
- "classVars are named 'className:varName' in
- the literal array"
-
- lit isSymbol and:[
- i := lit lastIndexOf:$:.
- i == 0 ifTrue:[
- l := lit.
- ] ifFalse:[
- l := lit copyFrom:(i + 1).
- ].
- aCollection includes:l
- ].
- ] ifNone:[]) notNil ifTrue:[
+ (aMethod literalsDetect:[ :lit | |i l|
+ "classVars are named 'className:varName' in
+ the literal array"
+
+ lit isSymbol and:[
+ i := lit lastIndexOf:$:.
+ i == 0 ifTrue:[
+ l := lit.
+ ] ifFalse:[
+ l := lit copyFrom:(i + 1).
+ ].
+ aCollection includes:l
+ ].
+ ] ifNone:[]) notNil ifTrue:[
"/ Transcript showCR:self name , ' recompiling ' , aSelector.
- self recompile:aSelector
- ]
+ self recompile:aSelector
+ ]
]
"Modified: / 29.8.1997 / 07:59:24 / cg"
@@ -1724,11 +1726,11 @@
"recompile all methods accessing the global variable aGlobalKey"
self selectorsAndMethodsDo:[:aSelector :aMethod |
- (aMethod literalsDetect:[:lit|
- lit = aGlobalKey
- ] ifNone:[]) notNil ifTrue:[
- self recompile:aSelector.
- ].
+ (aMethod literalsDetect:[:lit|
+ lit = aGlobalKey
+ ] ifNone:[]) notNil ifTrue:[
+ self recompile:aSelector.
+ ].
].
"Created: / 1.4.1997 / 23:44:53 / stefan"
@@ -1739,21 +1741,21 @@
recompileMethodsWithMachineCode
"{ Pragma: +optSpace }"
- "recompile all methods which have non-dynamic machineCode
+ "recompile all methods which have non-dynamic machineCode
(i.e. those, which were loaded from a classLibrary)"
self selectorsAndMethodsDo:[:aSelector :oldMethod |
- |newMethod|
-
- oldMethod isLazyMethod ifFalse:[
- oldMethod byteCode isNil ifTrue:[
- self recompile:aSelector.
- newMethod := self compiledMethodAt:aSelector.
- oldMethod ~~ newMethod ifTrue:[
- newMethod sourceFilename:(oldMethod getSource) position:(oldMethod getSourcePosition)
- ]
- ].
- ].
+ |newMethod|
+
+ oldMethod isLazyMethod ifFalse:[
+ oldMethod byteCode isNil ifTrue:[
+ self recompile:aSelector.
+ newMethod := self compiledMethodAt:aSelector.
+ oldMethod ~~ newMethod ifTrue:[
+ newMethod sourceFilename:(oldMethod getSource) position:(oldMethod getSourcePosition)
+ ]
+ ].
+ ].
].
! !
@@ -1765,7 +1767,7 @@
This was added to allow squeak code to be filedIn."
^ Squeak::ClassCommentReader new
- class:self
+ class:self
category:#Comment
changeStamp:aStamp
@@ -1825,7 +1827,7 @@
privateMethods
"this method allows fileIn of V'Age methods
- The privateMethods keyword is for documentation only;
+ The privateMethods keyword is for documentation only;
by default, methods are public (for backward compatibility)
(although, they could be made private here)."
@@ -1852,7 +1854,7 @@
!
protectedMethodsFor:aCategory
- "this method allows fileIn of ENVY and ST/X protected methods.
+ "this method allows fileIn of ENVY and ST/X protected methods.
The following methods are only allowed to be executed if sent from a method
within the current class or a subclass. Out-of-class sends will raise
@@ -1866,7 +1868,7 @@
publicMethods
"this method allows fileIn of V'Age methods
- The publicMethods keyword is for documentation only;
+ The publicMethods keyword is for documentation only;
by default, methods are public anyway (for backward compatibility)."
^ self methodsFor:'public'
@@ -1902,21 +1904,21 @@
"/ this test allows a smalltalk to be built without Projects/ChangeSets
"/
Project notNil ifTrue:[
- fileName := Project currentProjectDirectory asFilename construct:(fileName name).
+ fileName := Project currentProjectDirectory asFilename construct:(fileName name).
].
"/
"/ if the file exists, save original in a .sav file
"/
fileName exists ifTrue:[
- fileName copyTo:(fileName withSuffix:'sav')
+ fileName copyTo:(fileName withSuffix:'sav')
].
[
- aStream := fileName newReadWriteStream.
+ aStream := fileName newReadWriteStream.
] on:FileStream openErrorSignal do:[:ex|
- ^ FileOutErrorSignal
- raiseRequestWith:fileName name
- errorString:(' - cannot create file:', fileName name)
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName name
+ errorString:(' - cannot create file:', fileName name)
].
self fileOutCategory:aCategory on:aStream.
@@ -1938,75 +1940,75 @@
dict := self methodDictionary.
dict notNil ifTrue:[
- interestingMethods := OrderedCollection new.
- dict do:[:aMethod |
- |wanted|
-
- (methodFilter isNil
- or:[methodFilter value:aMethod]) ifTrue:[
- (aCategory = aMethod category) ifTrue:[
- skippedMethods notNil ifTrue:[
- wanted := (skippedMethods includesIdentical:aMethod) not
- ] ifFalse:[
- savedMethods notNil ifTrue:[
- wanted := (savedMethods includesIdentical:aMethod).
- ] ifFalse:[
- wanted := true
- ]
- ].
- wanted ifTrue:[interestingMethods add:aMethod].
- ]
- ]
- ].
- interestingMethods notEmpty ifTrue:[
- first := true.
- privacy := nil.
-
- "/
- "/ sort by selector
- "/
- sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
- sortedSelectors sortWith:interestingMethods.
-
- interestingMethods 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:'.
- ].
- cat := aCategory.
- cat isNil ifTrue:[ cat := '' ].
- aStream nextPutAll:aCategory asString storeString.
- aStream nextPutChunkSeparator; cr; cr.
- first := false.
- ].
- source := aMethod source.
- source isNil ifTrue:[
- FileOutErrorSignal
- raiseRequestWith:self
- errorString:' - no source for method: ', (aMethod displayString)
- ] ifFalse:[
- aStream nextChunkPut:source.
- ].
- ].
- aStream space.
- aStream nextPutChunkSeparator.
- aStream cr
- ]
+ interestingMethods := OrderedCollection new.
+ dict do:[:aMethod |
+ |wanted|
+
+ (methodFilter isNil
+ or:[methodFilter value:aMethod]) ifTrue:[
+ (aCategory = aMethod category) ifTrue:[
+ skippedMethods notNil ifTrue:[
+ wanted := (skippedMethods includesIdentical:aMethod) not
+ ] ifFalse:[
+ savedMethods notNil ifTrue:[
+ wanted := (savedMethods includesIdentical:aMethod).
+ ] ifFalse:[
+ wanted := true
+ ]
+ ].
+ wanted ifTrue:[interestingMethods add:aMethod].
+ ]
+ ]
+ ].
+ interestingMethods notEmpty ifTrue:[
+ first := true.
+ privacy := nil.
+
+ "/
+ "/ sort by selector
+ "/
+ sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
+ sortedSelectors sortWith:interestingMethods.
+
+ interestingMethods 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:'.
+ ].
+ cat := aCategory.
+ cat isNil ifTrue:[ cat := '' ].
+ aStream nextPutAll:aCategory asString storeString.
+ aStream nextPutChunkSeparator; cr; cr.
+ first := false.
+ ].
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:' - no source for method: ', (aMethod displayString)
+ ] ifFalse:[
+ aStream nextChunkPut:source.
+ ].
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
]
"Modified: 28.8.1995 / 14:30:41 / claus"
@@ -2023,11 +2025,11 @@
fileOut for what this is needed."
self
- fileOutCategory:aCategory
- except:skippedMethods
- only:savedMethods
- methodFilter:nil
- on:aStream
+ fileOutCategory:aCategory
+ except:skippedMethods
+ only:savedMethods
+ methodFilter:nil
+ on:aStream
"Modified: 28.8.1995 / 14:30:41 / claus"
"Modified: 12.6.1996 / 11:37:33 / stefan"
@@ -2050,7 +2052,7 @@
"/ must use the classes full name
"/
Class fileOutNameSpaceQuerySignal answer:true do:[
- self fileOutCategory:aCategory except:nil only:nil methodFilter:nil on:aStream
+ self fileOutCategory:aCategory except:nil only:nil methodFilter:nil on:aStream
]
"Created: 1.4.1997 / 16:04:44 / stefan"
@@ -2065,32 +2067,32 @@
selector := self selectorAtMethod:aMethod.
selector notNil ifTrue:[
- fileName := (self name , '-' , selector, '.st') asFilename.
- fileName makeLegalFilename.
-
- "
- this test allows a smalltalk to be built without Projects/ChangeSets
- "
- Project notNil ifTrue:[
- fileName := Project currentProjectDirectory asFilename construct:fileName name.
- ].
-
- "
- if file exists, save original in a .sav file
- "
- fileName exists ifTrue:[
- fileName copyTo:(fileName withSuffix: 'sav')
- ].
-
- [
- aStream := fileName newReadWriteStream.
- ] on:FileStream openErrorSignal do:[:ex|
- ^ FileOutErrorSignal
- raiseRequestWith:fileName name
- errorString:(' - cannot create file:', fileName name)
- ].
- self fileOutMethod:aMethod on:aStream.
- aStream close
+ fileName := (self name , '-' , selector, '.st') asFilename.
+ fileName makeLegalFilename.
+
+ "
+ this test allows a smalltalk to be built without Projects/ChangeSets
+ "
+ Project notNil ifTrue:[
+ fileName := Project currentProjectDirectory asFilename construct:fileName name.
+ ].
+
+ "
+ if file exists, save original in a .sav file
+ "
+ fileName exists ifTrue:[
+ fileName copyTo:(fileName withSuffix: 'sav')
+ ].
+
+ [
+ aStream := fileName newReadWriteStream.
+ ] on:FileStream openErrorSignal do:[:ex|
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName name
+ errorString:(' - cannot create file:', fileName name)
+ ].
+ self fileOutMethod:aMethod on:aStream.
+ aStream close
]
"Modified: / 1.4.1997 / 16:00:57 / stefan"
@@ -2105,34 +2107,34 @@
dict := self methodDictionary.
dict notNil ifTrue:[
- aStream nextPutChunkSeparator.
- self name printOn:aStream.
+ aStream nextPutChunkSeparator.
+ self name printOn:aStream.
"/ self printClassNameOn:aStream.
- (privacy := aMethod privacy) ~~ #public ifTrue:[
- aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
- ] ifFalse:[
- aStream nextPutAll:' methodsFor:'.
- ].
- cat := aMethod category.
- cat isNil ifTrue:[
- cat := ''
- ].
- aStream nextPutAll:cat asString storeString.
- aStream nextPutChunkSeparator; cr; cr.
- source := aMethod source.
- source isNil ifTrue:[
- FileOutErrorSignal
- raiseRequestWith:self
- errorString:(' - no source for method: ' ,
- self name , '>>' ,
- (self selectorAtMethod:aMethod))
- ] ifFalse:[
- aStream nextChunkPut:source.
- ].
- aStream space.
- aStream nextPutChunkSeparator.
- aStream cr
+ (privacy := aMethod privacy) ~~ #public ifTrue:[
+ aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
+ ] ifFalse:[
+ aStream nextPutAll:' methodsFor:'.
+ ].
+ cat := aMethod category.
+ cat isNil ifTrue:[
+ cat := ''
+ ].
+ aStream nextPutAll:cat asString storeString.
+ aStream nextPutChunkSeparator; cr; cr.
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:(' - no source for method: ' ,
+ self name , '>>' ,
+ (self selectorAtMethod:aMethod))
+ ] ifFalse:[
+ aStream nextChunkPut:source.
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
]
"Modified: 27.8.1995 / 01:23:19 / claus"
@@ -2143,7 +2145,7 @@
fileOutMethods:methods on:aStream
methods do:[:aMethod |
- self fileOutMethod:aMethod on:aStream
+ self fileOutMethod:aMethod on:aStream
].
"Created: / 29.1.2000 / 16:39:53 / cg"
@@ -2159,67 +2161,67 @@
dict := self methodDictionary.
dict notNil ifTrue:[
- interestingMethods := OrderedCollection new.
- dict do:[:aMethod |
- (methodFilter isNil
- or:[methodFilter value:aMethod]) ifTrue:[
- (aCategory = aMethod category) ifTrue:[
- interestingMethods add:aMethod.
- ]
- ]
- ].
- interestingMethods notEmpty ifTrue:[
- first := true.
- privacy := nil.
-
- "/
- "/ sort by selector
- "/
- sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
- sortedSelectors sortWith:interestingMethods.
-
- interestingMethods do:[:aMethod |
- first ifFalse:[
- privacy ~~ aMethod privacy ifTrue:[
- first := true.
- aStream nextPutLine:'</methods>'.
- ].
- ].
-
- privacy := aMethod privacy.
-
- first ifTrue:[
- cat := aCategory.
- cat isNil ifTrue:[ cat := '' ].
-
- aStream nextPutLine:'<methods>'.
- aStream nextPutAll:' <class-id>'.
- aStream nextPutAll:self name.
- aStream nextPutLine:'</class-id>'.
- aStream nextPutAll:' <category>'.
- aStream nextPutAll:cat.
- aStream nextPutLine:'</category>'.
-
- privacy ~~ #public ifTrue:[
- aStream nextPutAll:' <privacy>'.
- aStream nextPutAll:privacy.
- aStream nextPutLine:'</privacy>'.
- ].
- first := false.
- ].
- source := aMethod source.
- source isNil ifTrue:[
- FileOutErrorSignal
- raiseRequestWith:self
- errorString:' - no source for method: ', (aMethod displayString)
- ] ifFalse:[
- aStream nextPutAll:' <body>'.
- self fileOutXMLString:source on:aStream.
- aStream nextPutLine:'</body>'.
- ].
- ].
- aStream nextPutLine:'</methods>'.
- ]
+ interestingMethods := OrderedCollection new.
+ dict do:[:aMethod |
+ (methodFilter isNil
+ or:[methodFilter value:aMethod]) ifTrue:[
+ (aCategory = aMethod category) ifTrue:[
+ interestingMethods add:aMethod.
+ ]
+ ]
+ ].
+ interestingMethods notEmpty ifTrue:[
+ first := true.
+ privacy := nil.
+
+ "/
+ "/ sort by selector
+ "/
+ sortedSelectors := interestingMethods collect:[:m | self selectorAtMethod:m].
+ sortedSelectors sortWith:interestingMethods.
+
+ interestingMethods do:[:aMethod |
+ first ifFalse:[
+ privacy ~~ aMethod privacy ifTrue:[
+ first := true.
+ aStream nextPutLine:'</methods>'.
+ ].
+ ].
+
+ privacy := aMethod privacy.
+
+ first ifTrue:[
+ cat := aCategory.
+ cat isNil ifTrue:[ cat := '' ].
+
+ aStream nextPutLine:'<methods>'.
+ aStream nextPutAll:' <class-id>'.
+ aStream nextPutAll:self name.
+ aStream nextPutLine:'</class-id>'.
+ aStream nextPutAll:' <category>'.
+ aStream nextPutAll:cat.
+ aStream nextPutLine:'</category>'.
+
+ privacy ~~ #public ifTrue:[
+ aStream nextPutAll:' <privacy>'.
+ aStream nextPutAll:privacy.
+ aStream nextPutLine:'</privacy>'.
+ ].
+ first := false.
+ ].
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:' - no source for method: ', (aMethod displayString)
+ ] ifFalse:[
+ aStream nextPutAll:' <body>'.
+ self fileOutXMLString:source on:aStream.
+ aStream nextPutLine:'</body>'.
+ ].
+ ].
+ aStream nextPutLine:'</methods>'.
+ ]
]
!
@@ -2239,20 +2241,20 @@
aStream nextPutLine:'</category>'.
privacy ~~ #public ifTrue:[
- aStream nextPutAll:' <privacy>'.
- aStream nextPutAll:privacy.
- aStream nextPutLine:'</privacy>'.
+ aStream nextPutAll:' <privacy>'.
+ aStream nextPutAll:privacy.
+ aStream nextPutLine:'</privacy>'.
].
source := aMethod source.
source isNil ifTrue:[
- FileOutErrorSignal
- raiseRequestWith:self
- errorString:' - no source for method: ', (aMethod displayString)
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:' - no source for method: ', (aMethod displayString)
] ifFalse:[
- aStream nextPutAll:' <body>'.
- self fileOutXMLString:source on:aStream.
- aStream nextPutLine:' </body>'.
+ aStream nextPutAll:' <body>'.
+ self fileOutXMLString:source on:aStream.
+ aStream nextPutLine:' </body>'.
].
aStream nextPutLine:'</methods>'.
!
@@ -2269,45 +2271,45 @@
!ClassDescription methodsFor:'printOut'!
nameWithNameSpacePrefix
- "return my names printString,
+ "return my names printString,
with nameSpace prefix (even if its the Smalltalk namespace)"
|nm owner|
(owner := self owningClass) notNil ifTrue:[
- ^ (owner nameWithNameSpacePrefix , '::' , self nameWithoutPrefix)
- ].
+ ^ (owner nameWithNameSpacePrefix , '::' , self nameWithoutPrefix)
+ ].
nm := self name.
self nameSpace == Smalltalk ifTrue:[
- nm := 'Smalltalk::' , nm
+ nm := 'Smalltalk::' , nm
].
^ nm
"a public class:
- Array name
- Array nameWithoutPrefix
- Array nameWithoutNameSpacePrefix
- Array nameWithNameSpacePrefix
+ Array name
+ Array nameWithoutPrefix
+ Array nameWithoutNameSpacePrefix
+ Array nameWithNameSpacePrefix
"
"a private class:
- Method::MethodWhoInfo name
- Method::MethodWhoInfo nameWithoutPrefix
- Method::MethodWhoInfo nameWithoutNameSpacePrefix
- Method::MethodWhoInfo nameWithNameSpacePrefix
+ Method::MethodWhoInfo name
+ Method::MethodWhoInfo nameWithoutPrefix
+ Method::MethodWhoInfo nameWithoutNameSpacePrefix
+ Method::MethodWhoInfo nameWithNameSpacePrefix
"
"a namespace class:
- CodingExamples::TopClass name
- CodingExamples::TopClass nameWithoutPrefix
+ CodingExamples::TopClass name
+ CodingExamples::TopClass nameWithoutPrefix
CodingExamples::TopClass nameWithoutNameSpacePrefix
CodingExamples::TopClass nameWithNameSpacePrefix
"
"a private class in a namespace class:
- CodingExamples::TopClass::SubClass name
- CodingExamples::TopClass::SubClass nameWithoutPrefix
+ CodingExamples::TopClass::SubClass name
+ CodingExamples::TopClass::SubClass nameWithoutPrefix
CodingExamples::TopClass::SubClass nameWithoutNameSpacePrefix
CodingExamples::TopClass::SubClass nameWithNameSpacePrefix
"
@@ -2317,7 +2319,7 @@
!
nameWithoutNameSpacePrefix
- "helper for fileOut and others - return my names printString,
+ "helper for fileOut and others - return my names printString,
without any nameSpace prefix (but with owningClasses prefix)"
|nm owner|
@@ -2330,26 +2332,26 @@
^ (owner nameWithoutNameSpacePrefix , '::' , nm)
"a public class:
- Array name
- Array nameWithoutPrefix
- Array nameWithoutNameSpacePrefix
+ Array name
+ Array nameWithoutPrefix
+ Array nameWithoutNameSpacePrefix
"
"a private class:
- Method::MethodWhoInfo name
- Method::MethodWhoInfo nameWithoutPrefix
- Method::MethodWhoInfo nameWithoutNameSpacePrefix
+ Method::MethodWhoInfo name
+ Method::MethodWhoInfo nameWithoutPrefix
+ Method::MethodWhoInfo nameWithoutNameSpacePrefix
"
"a namespace class:
- CodingExamples::TopClass name
- CodingExamples::TopClass nameWithoutPrefix
+ CodingExamples::TopClass name
+ CodingExamples::TopClass nameWithoutPrefix
CodingExamples::TopClass nameWithoutNameSpacePrefix
"
"a private class in a namespace class:
- CodingExamples::TopClass::SubClass name
- CodingExamples::TopClass::SubClass nameWithoutPrefix
+ CodingExamples::TopClass::SubClass name
+ CodingExamples::TopClass::SubClass nameWithoutPrefix
CodingExamples::TopClass::SubClass nameWithoutNameSpacePrefix
"
@@ -2358,7 +2360,7 @@
!
nameWithoutPrefix
- "helper for fileOut and others - return my names printString,
+ "helper for fileOut and others - return my names printString,
without any owningClass or nameSpace prefix"
|nm idx|
@@ -2366,32 +2368,32 @@
nm := self name.
idx := nm lastIndexOf:$:.
idx == 0 ifTrue:[
- ^ nm
+ ^ nm
].
^ nm copyFrom:idx+1.
"a public class:
- Array name
- Array nameWithoutPrefix
- Array nameWithoutNameSpacePrefix
+ Array name
+ Array nameWithoutPrefix
+ Array nameWithoutNameSpacePrefix
"
"a private class:
- Method::MethodWhoInfo name
- Method::MethodWhoInfo nameWithoutPrefix
- Method::MethodWhoInfo nameWithoutNameSpacePrefix
+ Method::MethodWhoInfo name
+ Method::MethodWhoInfo nameWithoutPrefix
+ Method::MethodWhoInfo nameWithoutNameSpacePrefix
"
"a namespace class:
- Demos::WalkingGirl name
- Demos::WalkingGirl nameWithoutPrefix
- Demos::WalkingGirl nameWithoutNameSpacePrefix
+ Demos::WalkingGirl name
+ Demos::WalkingGirl nameWithoutPrefix
+ Demos::WalkingGirl nameWithoutNameSpacePrefix
"
"a private class in a namespace class:
- Demos::WalkingGirl::AnimationView name
- Demos::WalkingGirl::AnimationView nameWithoutPrefix
- Demos::WalkingGirl::AnimationView nameWithoutNameSpacePrefix
+ Demos::WalkingGirl::AnimationView name
+ Demos::WalkingGirl::AnimationView nameWithoutPrefix
+ Demos::WalkingGirl::AnimationView nameWithoutNameSpacePrefix
"
"Modified: 5.1.1997 / 18:23:14 / cg"
@@ -2408,9 +2410,9 @@
|nm|
Class fileOutNameSpaceQuerySignal query == false ifTrue:[
- nm := self nameWithoutNameSpacePrefix
+ nm := self nameWithoutNameSpacePrefix
] ifFalse:[
- nm := self name.
+ nm := self name.
].
aStream nextPutAll:nm.
@@ -2430,7 +2432,7 @@
indent := 0.
superclass := self superclass.
(superclass notNil) ifTrue:[
- indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
+ indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
].
aStream spaces:indent.
nm := self printNameInHierarchy.
@@ -2600,23 +2602,23 @@
(cat = 'obsolete'
or:[cat = '* obsolete *']) ifTrue:[
- "add obsolete - to make life easier ..."
- more := ' (obsolete)'
+ "add obsolete - to make life easier ..."
+ more := ' (obsolete)'
].
(cat = 'removed'
or:[cat = '* removed *']) ifTrue:[
- "add removed - to make life easier ..."
- more := ' (removed)'
+ "add removed - to make life easier ..."
+ more := ' (removed)'
].
self isLoaded ifFalse:[
- more := ' (autoloaded)'
+ more := ' (autoloaded)'
].
self isPrivate ifTrue:[
- nm := self nameWithoutPrefix.
- more := ' (private in ' , self owningClass name , ')'.
+ nm := self nameWithoutPrefix.
+ more := ' (private in ' , self owningClass name , ')'.
] ifFalse:[
- nm := self name.
+ nm := self name.
].
more isNil ifTrue:[^ nm].
^ nm , more
@@ -2756,39 +2758,39 @@
accept in the browser in a multi-display (or timesliced) configuration"
ChangeFileAccessLock critical:[
- |aStream|
-
- FileOutNameSpaceQuerySignal answer:true
- do:[
- aStream := self changesStream.
- aStream notNil ifTrue:[
- [
- FileStream writeErrorSignal handle:[:ex |
- self warn:('Could not update the changes-file\\' , ex description) withCRs.
- ex return
- ] do:[
- |didWarn|
-
- didWarn := false.
- EncodingError handle:[:ex |
- didWarn ifFalse:[
- self warn:('The changeFile cannot correctly represent this change.\(ChangeFile is not utf8 encoded.)\Please start with a fresh changeFile.') withCRs.
- didWarn := true.
- ].
- ex proceedWith:(ex defaultValue).
- ] do:[
- doStampIt ifTrue:[
- self addChangeTimeStampTo:aStream
- ].
- aBlock value:aStream.
- aStream cr.
- ].
- ].
- ] ensure:[
- aStream close
- ]
- ]
- ]
+ |aStream|
+
+ FileOutNameSpaceQuerySignal answer:true
+ do:[
+ aStream := self changesStream.
+ aStream notNil ifTrue:[
+ [
+ FileStream writeErrorSignal handle:[:ex |
+ self warn:('Could not update the changes-file\\' , ex description) withCRs.
+ ex return
+ ] do:[
+ |didWarn|
+
+ didWarn := false.
+ EncodingError handle:[:ex |
+ didWarn ifFalse:[
+ self warn:('The changeFile cannot correctly represent this change.\(ChangeFile is not utf8 encoded.)\Please start with a fresh changeFile.') withCRs.
+ didWarn := true.
+ ].
+ ex proceedWith:(ex defaultValue).
+ ] do:[
+ doStampIt ifTrue:[
+ self addChangeTimeStampTo:aStream
+ ].
+ aBlock value:aStream.
+ aStream cr.
+ ].
+ ].
+ ] ensure:[
+ aStream close
+ ]
+ ]
+ ]
]
"Modified: 22.3.1997 / 17:12:40 / cg"
@@ -2815,7 +2817,7 @@
superclass := self superclass.
(superclass notNil) ifTrue:[
- superclass addAllCategoriesTo:aCollection
+ superclass addAllCategoriesTo:aCollection
].
self addCategoriesTo:aCollection
@@ -2893,11 +2895,11 @@
aPrintStream bold.
aPrintStream nextPutLine:(source at:1).
(source size >= 2) ifTrue:[
- (comment := aMethod comment) notNil ifTrue:[
- aPrintStream italic.
- aPrintStream spaces:((source at:2) indexOfNonSeparatorStartingAt:1).
- aPrintStream nextPutLine:comment.
- ]
+ (comment := aMethod comment) notNil ifTrue:[
+ aPrintStream italic.
+ aPrintStream spaces:((source at:2) indexOfNonSeparatorStartingAt:1).
+ aPrintStream nextPutLine:comment.
+ ]
].
aPrintStream normal
@@ -2924,11 +2926,11 @@
^ coll asOrderedCollection
"
- Point categories
- Point allCategories
-
- Point class categories
- Point class allCategories
+ Point categories
+ Point allCategories
+
+ Point class categories
+ Point class allCategories
"
"Modified: 21.3.1996 / 16:28:57 / cg"
@@ -2944,13 +2946,13 @@
newList := Set new.
self methodDictionary do:[:aMethod |
- newList add:(aMethod category ? '* no category *')
+ newList add:(aMethod category ? '* no category *')
].
^ newList
"
- Point categories
- Point class categories
+ Point categories
+ Point class categories
"
"Modified: 16.4.1996 / 18:06:11 / cg"
@@ -2958,16 +2960,16 @@
"Created: 1.4.1997 / 15:57:18 / stefan"
!
-isObsolete
- "return true, if the receiver is obsolete
- (i.e. has been replaced by a different class or was removed,
+isObsolete
+ "return true, if the receiver is obsolete
+ (i.e. has been replaced by a different class or was removed,
but is still referenced by instanced)"
|cat|
cat := self category.
- ^ cat = 'obsolete'
+ ^ cat = 'obsolete'
or:[cat = 'removed'
or:[cat = '* removed *'
or:[cat = '* obsolete *']]]
@@ -3015,9 +3017,9 @@
^ nil
"
- StandardSystemView whichClassDefinesInstVar:'label'
- StandardSystemView whichClassDefinesInstVar:'paint'
- StandardSystemView whichClassDefinesInstVar:'foo'
+ StandardSystemView whichClassDefinesInstVar:'label'
+ StandardSystemView whichClassDefinesInstVar:'paint'
+ StandardSystemView whichClassDefinesInstVar:'foo'
"
"Created: 2.4.1997 / 01:12:27 / stefan"
@@ -3030,14 +3032,14 @@
|set|
(self instVarNames includes:instVarName) ifFalse:[
- ^ #()
+ ^ #()
].
set := IdentitySet new.
self selectorsAndMethodsDo:[:sel :mthd |
- (mthd accessedInstVars includes:instVarName) ifTrue:[
- set add:sel
- ]
+ (mthd accessedInstVars includes:instVarName) ifTrue:[
+ set add:sel
+ ]
].
^ set.
@@ -3061,27 +3063,27 @@
The subclass will have indexed variables if the receiving-class has."
self isVariable ifFalse:[
- ^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:false
- words:true
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ ^ self class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
].
- ^ self
- perform:(self definitionSelector)
- withArguments:(Array with:nameSymbol
- with:instVarNameString
- with:classVarString
- with:pool
- with:cat).
+ ^ self
+ perform:(self definitionSelector)
+ withArguments:(Array with:nameSymbol
+ with:instVarNameString
+ with:classVarString
+ with:pool
+ with:cat).
"Modified: / 8.3.1997 / 00:41:08 / cg"
"Modified: / 18.3.1999 / 18:18:25 / stefan"
@@ -3092,19 +3094,19 @@
The subclass will have indexed variables if the receiving-class has."
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:false
- words:true
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
- classInstanceVariableNames:classInstanceVariableNames
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ classInstanceVariableNames:classInstanceVariableNames
!
subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat inEnvironment:aNameSpace
@@ -3114,59 +3116,59 @@
|rslt|
self isVariable ifTrue:[
- Class nameSpaceQuerySignal answer:aNameSpace
- do:[
- rslt := self
- subclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- ].
- ^ rslt
+ Class nameSpaceQuerySignal answer:aNameSpace
+ do:[
+ rslt := self
+ subclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ ].
+ ^ rslt
].
^ self class
- name:nameSymbol
- inEnvironment:aNameSpace
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:false
- words:true
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:aNameSpace
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: 8.2.1997 / 19:41:44 / cg"
"Modified: 31.8.1997 / 07:48:14 / cg"
!
variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:18 / cg"
"Modified: / 6.11.1996 / 22:48:18 / cg"
@@ -3174,29 +3176,29 @@
!
variableDoubleSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#double
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#double
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:21 / cg"
"Modified: / 6.11.1996 / 22:48:22 / cg"
@@ -3204,29 +3206,29 @@
!
variableFloatSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#float
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#float
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:24 / cg"
"Modified: / 6.11.1996 / 22:48:26 / cg"
@@ -3234,59 +3236,59 @@
!
variableLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable unsigned long-long-sized nonpointer variables"
self isVariable ifTrue:[
- self isLongLongs ifFalse:[
- ^ self error:
- 'cannot make a variable long-long subclass of a variable non-long-long class'
- ].
+ self isLongLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable long-long subclass of a variable non-long-long class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#longLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#longLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Modified: / 18.3.1999 / 18:19:17 / stefan"
!
variableLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable long-sized nonpointer variables"
self isVariable ifTrue:[
- self isLongs ifFalse:[
- self isBytes ifFalse:[
- ^ self error:
- 'cannot make a variable long subclass of a variable non-long class'
- ].
- ].
+ self isLongs ifFalse:[
+ self isBytes ifFalse:[
+ ^ self error:
+ 'cannot make a variable long subclass of a variable non-long class'
+ ].
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#long
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#long
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:27 / cg"
"Modified: / 6.11.1996 / 22:48:29 / cg"
@@ -3294,57 +3296,57 @@
!
variableSignedLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable signed long-long-sized nonpointer variables"
self isVariable ifTrue:[
- self isSignedLongLongs ifFalse:[
- ^ self error:
- 'cannot make a variable signed long-long subclass of a variable non-long-long class'
- ].
+ self isSignedLongLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed long-long subclass of a variable non-long-long class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedLongLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedLongLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Modified: / 18.3.1999 / 18:19:35 / stefan"
!
variableSignedLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable signed long-sized nonpointer variables"
self isVariable ifTrue:[
- self isSignedLongs ifFalse:[
- ^ self error:
- 'cannot make a variable signed long subclass of a variable non-long class'
- ].
+ self isSignedLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed long subclass of a variable non-long class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:31 / cg"
"Modified: / 6.11.1996 / 22:48:32 / cg"
@@ -3352,29 +3354,29 @@
!
variableSignedWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable word-sized signed nonpointer variables"
self isVariable ifTrue:[
- self isSignedWords ifFalse:[
- ^ self error:
- 'cannot make a variable signed word subclass of a variable non-word class'
- ].
+ self isSignedWords ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed word subclass of a variable non-word class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedWord
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedWord
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:34 / cg"
"Modified: / 6.11.1996 / 22:48:35 / cg"
@@ -3382,29 +3384,29 @@
!
variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:false
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:37 / cg"
"Modified: / 6.11.1996 / 22:48:40 / cg"
@@ -3412,30 +3414,30 @@
!
variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat classInstanceVariableNames:classInstanceVariableNames
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:false
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
- classInstanceVariableNames:classInstanceVariableNames
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ classInstanceVariableNames:classInstanceVariableNames
"Created: / 12.10.1996 / 19:18:37 / cg"
"Modified: / 6.11.1996 / 22:48:40 / cg"
@@ -3443,31 +3445,31 @@
!
variableWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
- "create a new class as a subclass of an existing class (the receiver)
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable word-sized nonpointer variables"
self isVariable ifTrue:[
- self isWords ifFalse:[
- self isBytes ifFalse:[
- ^ self error:
- 'cannot make a variable word subclass of a variable non-word class'
- ]
- ].
+ self isWords ifFalse:[
+ self isBytes ifFalse:[
+ ^ self error:
+ 'cannot make a variable word subclass of a variable non-word class'
+ ]
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:(Class nameSpaceQuerySignal query)
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:true
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:cat
- comment:nil
- changed:true
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal query)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:true
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
"Created: / 12.10.1996 / 19:18:40 / cg"
"Modified: / 6.11.1996 / 22:48:43 / cg"
@@ -3476,395 +3478,395 @@
!ClassDescription methodsFor:'subclass creation-private classes'!
-subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
"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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:false
- words:true
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ ^ self class
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
].
self isBytes ifTrue:[
- ^ self
- variableByteSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableByteSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isLongs ifTrue:[
- ^ self
- variableLongSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableLongSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isLongLongs ifTrue:[
- ^ self
- variableLongLongSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableLongLongSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isFloats ifTrue:[
- ^ self
- variableFloatSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableFloatSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isDoubles ifTrue:[
- ^ self
- variableDoubleSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableDoubleSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isWords ifTrue:[
- ^ self
- variableWordSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableWordSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isSignedWords ifTrue:[
- ^ self
- variableSignedWordSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableSignedWordSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isSignedLongs ifTrue:[
- ^ self
- variableSignedLongSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableSignedLongSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
self isSignedLongLongs ifTrue:[
- ^ self
- variableSignedLongLongSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ ^ self
+ variableSignedLongLongSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
].
^ self
- variableSubclass:nameSymbol
- instanceVariableNames:instVarNameString
- classVariableNames:classVarString
- poolDictionaries:pool
- privateIn:aClass
+ variableSubclass:nameSymbol
+ instanceVariableNames:instVarNameString
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ privateIn:aClass
"Created: / 11.10.1996 / 16:30:53 / cg"
"Modified: / 4.7.1999 / 18:42:31 / cg"
!
-variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:31:27 / cg"
"Modified: / 4.7.1999 / 18:42:36 / cg"
!
-variableDoubleSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
-
- "create a new class as a subclass of an existing class (the receiver)
+variableDoubleSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#double
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#double
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:32:23 / cg"
"Modified: / 4.7.1999 / 18:42:41 / cg"
!
-variableFloatSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableFloatSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#float
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#float
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:32:37 / cg"
"Modified: / 4.7.1999 / 18:42:45 / cg"
!
-variableLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable longlong-sized nonpointer variables"
self isVariable ifTrue:[
- self isLongLongs ifFalse:[
- ^ self error:
- 'cannot make a variable longlong subclass of a variable non-longlong class'
- ].
+ self isLongLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable longlong subclass of a variable non-longlong class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#longLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#longLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:32:48 / cg"
"Modified: / 4.7.1999 / 18:42:49 / cg"
!
-variableLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#long
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#long
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:32:48 / cg"
"Modified: / 4.7.1999 / 18:42:53 / cg"
!
-variableSignedLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableSignedLongLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable signed longlong-sized nonpointer variables"
self isVariable ifTrue:[
- self isSignedLongLongs ifFalse:[
- ^ self error:
- 'cannot make a variable signed longlong subclass of a variable non-longlong class'
- ].
+ self isSignedLongLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed longlong subclass of a variable non-longlong class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedLongLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedLongLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:46:30 / cg"
"Modified: / 4.7.1999 / 18:42:57 / cg"
!
-variableSignedLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableSignedLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable signed long-sized nonpointer variables"
self isVariable ifTrue:[
- self isSignedLongs ifFalse:[
- ^ self error:
- 'cannot make a variable signed long subclass of a variable non-long class'
- ].
+ self isSignedLongs ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed long subclass of a variable non-long class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedLong
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedLong
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:46:30 / cg"
"Modified: / 4.7.1999 / 18:43:03 / cg"
!
-variableSignedWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableSignedWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable word-sized signed nonpointer variables"
self isVariable ifTrue:[
- self isSignedWords ifFalse:[
- ^ self error:
- 'cannot make a variable signed word subclass of a variable non-word class'
- ].
+ self isSignedWords ifFalse:[
+ ^ self error:
+ 'cannot make a variable signed word subclass of a variable non-word class'
+ ].
].
^ self class
- name:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:#signedWord
- words:false
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:#signedWord
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:46:44 / cg"
"Modified: / 4.7.1999 / 18:43:06 / cg"
!
-variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:false
- pointers:true
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:54:33 / cg"
"Modified: / 4.7.1999 / 18:43:10 / cg"
!
-variableWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
- "create a new class as a subclass of an existing class (the receiver)
+variableWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass
+ "create a new class as a subclass of an existing class (the receiver)
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:nameSymbol
- inEnvironment:aClass
- subclassOf:self
- instanceVariableNames:instVarNameString
- variable:true
- words:true
- pointers:false
- classVariableNames:classVarString
- poolDictionaries:pool
- category:(aClass category)
- comment:nil
- changed:true.
+ name:nameSymbol
+ inEnvironment:aClass
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:true
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:(aClass category)
+ comment:nil
+ changed:true.
"Created: / 11.10.1996 / 16:54:48 / cg"
"Modified: / 4.7.1999 / 18:43:18 / cg"
@@ -3935,7 +3937,7 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.175 2004-08-22 17:49:35 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.176 2004-09-20 08:47:43 ca Exp $'
! !
ClassDescription initialize!