--- a/Smalltalk.st Mon Aug 18 18:48:07 2003 +0200
+++ b/Smalltalk.st Tue Aug 19 00:32:25 2003 +0200
@@ -391,17 +391,12 @@
].
ClassesFailedToInitialize add:aClass.
('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- (Smalltalk commandLineArguments includes:'--debug') ifTrue:[
- ex reject
- ].
] do:[
aClass initialize
].
!
-initializeModules
- "perform module specific initialization and
- send #initialize to all classes.
+itialize to all classes.
Notice: this is not called when an image is restarted"
self initializeModulesOnce.
@@ -415,9 +410,7 @@
].
!
-initializeModulesOnce
- "perform module specific initialization and
- send #initialize to all classes.
+#initialize to all classes.
Notice: this is not called when an image is restarted"
%{
@@ -429,8 +422,7 @@
^ self primitiveFailed
!
-initializeSystem
- "initialize all other classes; setup dispatcher processes etc.
+etc.
This one is the very first entry into the smalltalk world,
right after startup, ususally immediately followed by Smalltalk>>start.
Notice:
@@ -540,17 +532,13 @@
"Modified: 7.9.1997 / 23:34:44 / cg"
!
-isInitialized
- "this returns true, if the system is properly initialized;
- i.e. false during startup. Especially, the whole viewing stuff is
+i.e. false during startup. Especially, the whole viewing stuff is
not working correctly until initialized."
^ Initializing not
!
-reinitStandardStreams
- "reinitialize some well-known streams.
- Tis must be done very early during startup, to allow for
+be done very early during startup, to allow for
debug and trace messages to be output
(otherwise, the file-descriptors are invalid)"
@@ -559,14 +547,6 @@
!Smalltalk class methodsFor:'Compatibility-Squeak'!
-beep
- Screen current beep
-!
-
-garbageCollect
- ObjectMemory garbageCollect
-!
-
garbageCollectMost
"collect recently created garbage; return the amount of freeSpace.
In ST/X, only the newSpace is collected here, and the sum of
@@ -578,12 +558,27 @@
!
-isMorphic
- ^ false
-!
-
-registerExternalObject: anObject
- "Register the given object in the external objects array and return its index.
+t recently created garbage; return the amount of freeSpace.
+ In ST/X, only the newSpace is collected here, and the sum of
+ newSpace + freeListSpace is returned."
+
+ ObjectMemory scavenge.
+ ^ ObjectMemory freeSpace
+ + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
+
+!
+
+freeSpace.
+ In ST/X, only the newSpace is collected here, and the sum of
+ newSpace + freeListSpace is returned."
+
+ ObjectMemory scavenge.
+ ^ ObjectMemory freeSpace
+ + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
+
+!
+
+en object in the external objects array and return its index.
If it is already there, just return its index.
ExternalObjects are protected from GC and can be accessed easily from
primitive code (via the global Smalltalk:SpecialObjectArray)"
@@ -620,8 +615,44 @@
!
-unregisterExternalObject: anObject
- "Unregister the given object in the external objects array.
+objects array and return its index.
+ If it is already there, just return its index.
+ ExternalObjects are protected from GC and can be accessed easily from
+ primitive code (via the global Smalltalk:SpecialObjectArray)"
+
+ | objects firstEmptyIndex obj sz newObjects |
+
+ objects := SpecialObjectArray.
+ objects isNil ifTrue:[
+ objects := Array new:5.
+ ].
+
+ "find the first empty slot and look if already registered"
+ firstEmptyIndex := 0.
+ 1 to: objects size do: [:i |
+ obj := objects at: i.
+ obj == anObject ifTrue: [^ i]. "object already there, just return its index"
+ (obj == nil and: [firstEmptyIndex = 0]) ifTrue: [
+ firstEmptyIndex := i
+ ]
+ ].
+
+ "if no empty slots, expand the array"
+ firstEmptyIndex = 0 ifTrue: [
+ sz := objects size.
+ newObjects := objects species new: sz + 20. "grow linearly"
+ newObjects replaceFrom: 1 to: sz with: objects startingAt: 1.
+ firstEmptyIndex := sz + 1.
+ SpecialObjectArray := newObjects.
+ objects := newObjects
+ ].
+
+ objects at: firstEmptyIndex put: anObject.
+ ^ firstEmptyIndex
+
+!
+
+rnal objects array.
Do nothing if it isn't registered."
|objects|
@@ -637,13 +668,12 @@
!Smalltalk class methodsFor:'Compatibility-V''Age'!
-allClassesImplementing:aSelector
- ^ self allClasses select:[:cls | cls implements:aSelector].
+ments:aSelector].
! !
!Smalltalk class methodsFor:'Compatibility-VW5.4'!
-defineClass:nameSymbol superclass:superclass indexedType:indexed private:private instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category attributes:annotations
+e instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category attributes:annotations
|newClass|
indexed == #none ifTrue:[
@@ -664,9 +694,7 @@
!Smalltalk class methodsFor:'accessing'!
-associationAt:aKey
- "return a key-value association for aKey.
- Since ST/X's Smalltalk as no real dictionary, this is
+X's Smalltalk as no real dictionary, this is
simulated here."
|val|
@@ -678,8 +706,7 @@
"Created: / 1.11.1997 / 13:27:20 / cg"
!
-associationAt:aKey ifAbsent:exceptionBlock
- "return a key-value association for aKey, or the value
+for aKey, or the value
from exceptionBlock, if no such key is present.
Since ST/X's Smalltalk as no real dictionary, this is
simulated here."
@@ -693,9 +720,7 @@
"Created: / 18.6.1998 / 17:05:24 / cg"
!
-at:aKey
- "retrieve the value stored under aKey, a symbol.
- Return nil if not present
+f not present
(this will be changed to trigger an error - better use #at:ifAbsent:)"
aKey class == String ifTrue:[self error:'expected symbol'].
@@ -706,9 +731,7 @@
^ self primitiveFailed
!
-at:aKey ifAbsent:aBlock
- "retrieve the value stored at aKey.
- If there is nothing stored under this key, return the value of
+s nothing stored under this key, return the value of
the evaluation of aBlock."
(self includesKey:aKey) ifTrue:[
@@ -722,9 +745,7 @@
"
!
-at:aKey ifPresent:aBlock
- "try to retrieve the value stored at aKey.
- If there is nothing stored under this key, do nothing.
+there is nothing stored under this key, do nothing.
Otherwise, evaluate aBlock, passing the retrieved value as argument."
(self includesKey:aKey) ifTrue:[
@@ -739,9 +760,7 @@
!
-at:aKey put:aValue
- "store the argument aValue under aKey, a symbol.
- Return aValue (sigh)."
+turn aValue (sigh)."
|oldValue|
@@ -778,10 +797,7 @@
"Modified: 19.4.1996 / 11:31:49 / cg"
!
-includesKey:aKey
- "return true, if the key is known"
-
- "/ for debugging - this is a common mistake,
+this is a common mistake,
"/ to try to access a class by nameString, instead
"/ of by symbol.
@@ -793,8 +809,7 @@
^ self primitiveFailed
!
-keyAtValue:anObject
- "return the symbol under which anObject is stored - or nil"
+nil"
self keysDo:[:aKey |
(self at:aKey) == anObject ifTrue:[^ aKey]
@@ -804,18 +819,14 @@
"Smalltalk keyAtValue:Object"
!
-keys
- "return a collection with all keys in the Smalltalk dictionary"
-
- |keys|
+keys|
keys := IdentitySet new.
self keysDo:[:k | keys add:k].
^ keys
!
-removeKey:aKey
- "remove the association stored under the key-argument from the globals dictionary.
+he globals dictionary.
WARNING:
this is somewhat dangerous: conceptionally, the association is removed,
to which machine & byte compiled code refers if it accesses a global.
@@ -837,10 +848,7 @@
!
-values
- "return a collection with all values in the Smalltalk dictionary"
-
- |values|
+|values|
values := OrderedCollection new.
self do:[:v | values add:v].
@@ -851,10 +859,7 @@
!Smalltalk class methodsFor:'binary storage'!
-addGlobalsForBinaryStorageTo:globalDictionary
- |pools|
-
- pools := Set new.
+.
self keysAndValuesDo:[:key :value |
(key includes:$:) ifFalse:[ "/ skip classVars
@@ -881,10 +886,7 @@
"Created: 21.3.1997 / 15:40:31 / cg"
!
-storeBinaryDefinitionOf:anObject on:stream manager:manager
- |string|
-
- anObject class == Association ifTrue:[
+Object class == Association ifTrue:[
string := 'Smalltalk associationAt: ', anObject key storeString
] ifFalse: [
string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
@@ -898,10 +900,7 @@
!Smalltalk class methodsFor:'browsing'!
-browseAllCallsOn:aSelectorSymbol
- "{ Pragma: +optSpace }"
-
- "startup a browser for all methods sending a particular message"
+owser for all methods sending a particular message"
UserPreferences systemBrowserClass browseAllCallsOn:aSelectorSymbol
@@ -910,10 +909,7 @@
"
!
-browseAllSelect:aBlock
- "{ Pragma: +optSpace }"
-
- "startup a browser for all methods for which aBlock returns true"
+all methods for which aBlock returns true"
UserPreferences systemBrowserClass browseAllSelect:aBlock
@@ -922,12 +918,7 @@
"
!
-browseChanges
- "{ Pragma: +optSpace }"
-
- "startup a changes browser"
-
- ChangesBrowser notNil ifTrue:[
+ChangesBrowser notNil ifTrue:[
ChangesBrowser open
] ifFalse:[
self warn:'no ChangesBrowser built in'
@@ -938,10 +929,7 @@
"
!
-browseClass:aClass
- "{ Pragma: +optSpace }"
-
- "startup a browser on aClass"
+s"
UserPreferences systemBrowserClass browseClass:aClass
@@ -950,8 +938,7 @@
"
!
-browseImplementorsMatching:aSelectorSymbolOrMatchPattern
- "{ Pragma: +optSpace }"
+ce }"
"startup a browser for all methods implementing a message matching"
@@ -963,10 +950,7 @@
"
!
-browseImplementorsOf:aSelectorSymbol
- "{ Pragma: +optSpace }"
-
- "startup a browser for all methods implementing a particular message"
+a browser for all methods implementing a particular message"
UserPreferences systemBrowserClass browseImplementorsOf:aSelectorSymbol
@@ -975,10 +959,7 @@
"
!
-browseInClass:aClass
- "{ Pragma: +optSpace }"
-
- "startup a full browser showing aClass"
+howing aClass"
UserPreferences systemBrowserClass openInClass:aClass
@@ -987,10 +968,7 @@
"
!
-browseInClass:aClass selector:selector
- "{ Pragma: +optSpace }"
-
- "startup a full browser showing aClass>>selector"
+p a full browser showing aClass>>selector"
UserPreferences systemBrowserClass openInClass:aClass selector:selector
@@ -1001,8 +979,7 @@
!Smalltalk class methodsFor:'class management'!
-changeCategoryOf:aClass to:newCategory
- "change a classes category, add a change record,
+ange record,
send change notifications"
|ns|
@@ -1026,28 +1003,21 @@
"Modified: / 11.2.2000 / 11:36:27 / cg"
!
-defineNameSpace: name private: private imports: imports category: category attributes: annotations
+ibutes: annotations
NameSpace name:name
!
-flushCachedClass:aClass
- CachedClasses notNil ifTrue:[
- CachedClasses remove:aClass ifAbsent:[]
+:aClass ifAbsent:[]
]
!
-flushCachedClasses
- CachedClasses := nil.
- Class flushSubclassInfo.
-
- "
+"
Smalltalk flushCachedClasses
"
!
-removeClass:aClass
- "remove the argument, aClass from the smalltalk dictionary;
+ry;
we have to flush the caches since these methods are now void.
Also, class variables of aClass are removed."
@@ -1168,8 +1138,7 @@
"Modified: / 20.6.1998 / 13:26:10 / cg"
!
-renameClass:aClass to:newName
- "rename aClass to newName. Most of the work is in
+s in
renaming the classVariables (create & copy over values)
and patching the classes methods to access the new variables."
@@ -1392,32 +1361,28 @@
!Smalltalk class methodsFor:'copying'!
-deepCopy
- "redefined to return self - there is only one Smalltalk dictionary"
+"
^ self
"Modified: 18.5.1996 / 12:13:33 / cg"
!
-deepCopyUsing:aDictionary
- "redefined to return self - there is only one Smalltalk dictionary"
+lltalk dictionary"
^ self
"Modified: 18.5.1996 / 12:13:36 / cg"
!
-shallowCopy
- "redefined to return self - there is only one Smalltalk dictionary"
+ary"
^ self
"Modified: 18.5.1996 / 12:13:39 / cg"
!
-simpleDeepCopy
- "redefined to return self - there is only one Smalltalk dictionary"
+ionary"
^ self
@@ -1426,8 +1391,7 @@
!Smalltalk class methodsFor:'debugging ST/X'!
-compileTrace:aBoolean
- "dump generated inline code (NOOP if VM was compiled without the trace-debug option)"
+without the trace-debug option)"
%{
extern char __compileTrace__;
@@ -1439,10 +1403,7 @@
"
!
-debugBreakPoint
- "{ Pragma: +optSpace }"
-
- "call the dummy debug function, on which a breakpoint
+, on which a breakpoint
can be put in adb, sdb, dbx or gdb.
WARNING: this method is for debugging only
it will be removed without notice."
@@ -1456,12 +1417,7 @@
!
-exitWithCoreDump
- "{ Pragma: +optSpace }"
-
- "abort program and dump core"
-
- OperatingSystem exitWithCoreDump
+OperatingSystem exitWithCoreDump
"/ never returns
"Be careful evaluating this
@@ -1470,10 +1426,7 @@
!
-fatalAbort
- "{ Pragma: +optSpace }"
-
- "report a fatal-error, print a stack backtrace and exit with core dump.
+k backtrace and exit with core dump.
(You may turn off the stack print with debugPrinting:false)"
%{
__fatal0(__context, "fatalAbort");
@@ -1483,10 +1436,7 @@
!
-fatalAbort:aMessage
- "{ Pragma: +optSpace }"
-
- "report a fatal-error; print a stack backtrace and exit with core dump
+nt a stack backtrace and exit with core dump
(You may turn off the stack print with debugPrinting:false)"
%{
@@ -1504,13 +1454,6 @@
!
-vmInstructionTrace:aBoolean
-
-
-! !
-
-!Smalltalk class methodsFor:'enumerating'!
-
allBehaviorsDo:aBlock
"evaluate the argument, aBlock for all classes and metaclasses in the system"
@@ -1519,12 +1462,20 @@
"
Smalltalk allBehaviorsDo:[:aClass | aClass name printCR]
"
-!
-
-allClassCategories
- "return a set of all class categories in the system"
-
- |allCategories|
+! !
+
+!Smalltalk class methodsFor:'enumerating'!
+
+taclasses in the system"
+
+ self allClassesAndMetaclassesDo:aBlock
+
+ "
+ Smalltalk allBehaviorsDo:[:aClass | aClass name printCR]
+ "
+!
+
+|allCategories|
allCategories := Set new.
Smalltalk allClassesDo:[:cls | |category|
@@ -1543,8 +1494,7 @@
"Created: / 17.11.2001 / 12:13:09 / cg"
!
-allClassesAndMetaclassesDo:aBlock
- "evaluate the argument, aBlock for all classes and metaclasses in the system."
+asses and metaclasses in the system."
|already|
@@ -1563,8 +1513,7 @@
].
!
-allClassesDo:aBlock
- "evaluate the argument, aBlock for all classes in the system."
+ystem."
self allClasses do:aBlock
@@ -1573,8 +1522,7 @@
"
!
-allClassesInCategory:aCategory
- "return a collection of for all classes in aCategory;
+Category;
The order of the classes is not defined."
|coll|
@@ -1592,8 +1540,7 @@
"Modified: 25.4.1996 / 18:06:13 / cg"
!
-allClassesInCategory:aCategory do:aBlock
- "evaluate the argument, aBlock for all classes in the aCategory;
+all classes in the aCategory;
The order of the classes is not defined."
aCategory notNil ifTrue:[
@@ -1611,8 +1558,7 @@
"
!
-allClassesInCategory:aCategory inOrderDo:aBlock
- "evaluate the argument, aBlock for all classes in aCategory;
+ock for all classes in aCategory;
superclasses come first - then subclasses"
|classes|
@@ -1633,8 +1579,7 @@
"Modified: / 17.11.2001 / 12:18:15 / cg"
!
-allClassesInOrderDo:aBlock
- "evaluate the argument, aBlock for all classes in the system;
+n the system;
Evaluation order is by inheritance: superclasses come first."
|already|
@@ -1658,16 +1603,12 @@
"
!
-allKeysDo:aBlock
- "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+lk dictionary"
^ self keysDo:aBlock
!
-allMethodCategories
- "return a set of all method categories in the system"
-
- |allCategories|
+|allCategories|
allCategories := Set new.
Smalltalk allClassesDo:[:cls |
@@ -1681,8 +1622,7 @@
"
!
-associationsDo:aBlock
- "evaluate the argument, aBlock for all key/value pairs
+s
in the Smalltalk dictionary"
self keysDo:[:aKey |
@@ -1692,20 +1632,7 @@
"Smalltalk associationsDo:[:assoc | assoc printCR]"
!
-basicKeys
- "for rel > 5 only"
-
- self primitiveFailed
-
-
-
-
-
-
-!
-
-do:aBlock
- "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
+"evaluate the argument, aBlock for all values in the Smalltalk dictionary"
|work|
@@ -1718,16 +1645,27 @@
]
!
-keysAndValuesDo:aBlock
- "evaluate the two-arg block, aBlock for all keys and values"
+ctionary"
+
+ |work|
+
+%{ /* NOREGISTER - work may not be placed into a register here */
+ __GLOBALS_DO(&aBlock, &work);
+ RETURN (self);
+%}.
+ self keysDo:[:aKey |
+ aBlock value:(self at:aKey)
+ ]
+!
+
+values"
self keysDo:[:aKey |
aBlock value:aKey value:(self at:aKey)
]
!
-keysDo:aBlock
- "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+dictionary"
|work|
%{ /* NOREGISTER - work may not be placed into a register here */
@@ -1741,10 +1679,7 @@
!Smalltalk class methodsFor:'inspecting'!
-inspectorClass
- "{ Pragma: +optSpace }"
-
- "redefined to launch a DictionaryInspector
+ryInspector
(instead of the default Inspector)."
^ DictionaryInspectorView
@@ -1752,16 +1687,10 @@
!Smalltalk class methodsFor:'message control'!
-silentLoading
- "returns the Silentloading class variable."
-
- ^ SilentLoading
-!
-
-silentLoading:aBoolean
- "{ Pragma: +optSpace }"
-
- "allows access to the Silentloading class variable, which controls
+ding
+!
+
+ilentloading class variable, which controls
messages from all kinds of system onto the transcript.
You can save a snapshot with this flag set to true, which makes
the image come up silent. Can also be set, to read in files unlogged."
@@ -1775,24 +1704,15 @@
!Smalltalk class methodsFor:'misc accessing'!
-beHeadless:aBoolean
- "set/clear the headlessOperation flag."
-
- HeadlessOperation := aBoolean
-!
-
-standAloneApp:aBoolean
- "set/clear the StandAlone flag."
-
- StandAlone := aBoolean
+eration := aBoolean
+!
+
+aBoolean
! !
!Smalltalk class methodsFor:'misc stuff'!
-addExitBlock:aBlock
- "{ Pragma: +optSpace }"
-
- "add a block to be executed when Smalltalk finishes.
+d when Smalltalk finishes.
This feature is currently not used anywhere - but could be useful for
cleanup in stand alone applications."
@@ -1803,10 +1723,7 @@
]
!
-addImageStartBlock:aBlock
- "{ Pragma: +optSpace }"
-
- "add a blocks to be executed in a separate process after
+executed in a separate process after
everything has been initialized.
These blocks will be executed after an image restart."
@@ -1819,10 +1736,7 @@
"Created: 9.9.1996 / 16:48:20 / stefan"
!
-addStartBlock:aBlock
- "{ Pragma: +optSpace }"
-
- "add a blocks to be executed in a separate process after
+ted in a separate process after
everything has been initialized. These blocks will
be deleted after execution and therefore not be
executed after an image restart.
@@ -1837,12 +1751,7 @@
"Created: 9.9.1996 / 16:46:53 / stefan"
!
-exit
- "{ Pragma: +optSpace }"
-
- "finish the Smalltalk system"
-
- ObjectMemory changed:#aboutToExit. "/ for ST/X backward compatibility
+Memory changed:#aboutToExit. "/ for ST/X backward compatibility
ObjectMemory changed:#aboutToQuit. "/ for ST-80 compatibility
ExitBlocks notNil ifTrue:[
ExitBlocks do:[:aBlock |
@@ -1857,20 +1766,14 @@
"
!
-sleep:aDelay
- "{ Pragma: +optSpace }"
-
- "wait for aDelay seconds.
- OBSOLETE: this is historical leftover and will be removed"
+SOLETE: this is historical leftover and will be removed"
OperatingSystem sleep:aDelay
! !
!Smalltalk class methodsFor:'queries'!
-allClasses
- "return an unordered collection of all classes in the system.
- Only globally anchored classes are returned
+Only globally anchored classes are returned
(i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
|classes|
@@ -1919,8 +1822,7 @@
"Modified: / 23.2.2000 / 10:49:46 / cg"
!
-allClassesAndMetaclasses
- "return an unordered collection of all classes with their metaclasses in the system."
+h their metaclasses in the system."
|classes|
@@ -1932,8 +1834,7 @@
^ classes
!
-allClassesWithAllPrivateClasses
- "return an unordered collection of all classes in the Smalltalk namespace.
+ses in the Smalltalk namespace.
Only globally anchored classes are returned
(i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
@@ -1953,10 +1854,7 @@
"
!
-cellAt:aName
- "{ Pragma: +optSpace }"
-
- "return the address of a global cell
+ell
- used internally for compiler only"
%{ /* NOCONTEXT */
@@ -1966,8 +1864,7 @@
!
-classCategoryCompletion:aPartialCategory
- "given a partial class category name, return an array consisting of
+me, return an array consisting of
2 entries: 1st: collection consisting of matching categories
2nd: the longest match"
@@ -2014,9 +1911,7 @@
"
!
-classNamed:aString
- "return the class with name aString, or nil if absent.
- To get to the metaClass, append ' class' to the string.
+To get to the metaClass, append ' class' to the string.
To get a nameSpace or private class, prefix the name as required."
|cls sym nonMeta idx ns nm|
@@ -2068,18 +1963,14 @@
"Modified: 19.6.1996 / 14:22:21 / stefan"
!
-classNames
- "return a collection of all classNames in the system"
-
- ^ self allClasses collect:[:aClass | aClass name]
+f allClasses collect:[:aClass | aClass name]
"
Smalltalk classNames
"
!
-classnameCompletion:aPartialClassName
- "given a partial classname, return an array consisting of
+array consisting of
2 entries: 1st: collection consisting of matching names
2nd: the best (longest) match"
@@ -2087,8 +1978,7 @@
classnameCompletion:aPartialClassName inEnvironment:self
!
-classnameCompletion:aPartialClassName inEnvironment:anEnvironment
- "given a partial classname, return an array consisting of
+partial classname, return an array consisting of
2 entries: 1st: collection consisting of matching names
2nd: the best (longest) match"
@@ -2178,8 +2068,7 @@
"Modified: 3.4.1997 / 18:25:01 / cg"
!
-defaultNameSpace
- "return the default namespace, where new classes are installed,
+lled,
if NO special nameSpace handler is present"
|p|
@@ -2194,8 +2083,7 @@
"Modified: 2.1.1997 / 20:01:31 / cg"
!
-globalnameCompletion:aPartialGlobalName
- "given a partial globalName, return an array consisting of
+an array consisting of
2 entries: 1st: collection consisting of matching names
2nd: the best (longest) match"
@@ -2265,33 +2153,23 @@
"Modified: 3.4.1997 / 18:25:01 / cg"
!
-hasNamespaces
- "can be redefined by dummy namespaces/environments, to suppress
+ss
the namespace display in a browser (PocketSmalltalk)"
^ true
!
-includes:something
- "this should come from Collection.
- will change the inheritance - Smalltalk is actually a collection"
+inheritance - Smalltalk is actually a collection"
self do:[:element | element = something ifTrue:[^ true]].
^ false
!
-isNameSpace
+NameSpace
^ true
-
- "Created: 11.10.1996 / 18:10:43 / cg"
-!
-
-isTopLevelNameSpace
- ^ true
-!
-
-isTopLevelNamespace
- "obsolete - use isTopLevelNameSpace"
+!
+
+LevelNameSpace"
<resource:#obsolete>
@@ -2300,8 +2178,14 @@
"Created: 11.10.1996 / 18:10:43 / cg"
!
-methodProtocolCompletion:aPartialProtocolName
- "given a partial method protocol name, return an array consisting of
+solete>
+
+ ^ true
+
+ "Created: 11.10.1996 / 18:10:43 / cg"
+!
+
+col name, return an array consisting of
2 entries: 1st: collection consisting of matching protocols
2nd: the longest match"
@@ -2352,10 +2236,7 @@
"
!
-numberOfGlobals
- "return the number of global variables in the system"
-
- |tally "{ Class: SmallInteger }" |
+|tally "{ Class: SmallInteger }" |
tally := 0.
self do:[:obj | tally := tally + 1].
@@ -2364,8 +2245,7 @@
"Smalltalk numberOfGlobals"
!
-referencesAny:aCollection
- "redefined, since the references are only kept in the VM's symbol table"
+the VM's symbol table"
self keysAndValuesDo:[:key :val |
aCollection do:[:anObject |
@@ -2378,8 +2258,7 @@
"Created: / 2.2.1998 / 16:01:20 / cg"
!
-referencesDerivedInstanceOf:aClass
- "redefined, since the references are only kept in the VM's symbol table"
+y kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
(key isKindOf:aClass) ifTrue:[^ true].
@@ -2388,8 +2267,7 @@
^ super referencesDerivedInstanceOf:aClass
!
-referencesInstanceOf:aClass
- "redefined, since the references are only kept in the VM's symbol table"
+in the VM's symbol table"
self keysAndValuesDo:[:key :val |
(key isMemberOf:aClass) ifTrue:[^ true].
@@ -2398,8 +2276,7 @@
^ super referencesInstanceOf:aClass
!
-referencesObject:anObject
- "redefined, since the references are only kept in the VM's symbol table"
+the VM's symbol table"
self keysAndValuesDo:[:key :val |
(key == anObject) ifTrue:[^ true].
@@ -2410,8 +2287,7 @@
"Modified: / 3.2.1998 / 14:22:46 / cg"
!
-resolveName:nameIn inClass:aClass
- "resolve aName as if compiled within aClass;
+ss;
i.e. if it has a private class with this name, return it;
if aName is known within the classes namespace, return that.
Otherwise, return a global with that name.
@@ -2448,8 +2324,7 @@
"Modified: / 9.7.1999 / 01:18:07 / cg"
!
-selectorCompletion:aPartialSymbolName
- "given a partial selector, return an array consisting of
+array consisting of
2 entries: 1st: collection consisting of matching implemented selectors
2nd: the longest match"
@@ -2457,8 +2332,7 @@
selectorCompletion:aPartialSymbolName inEnvironment:self
!
-selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
- "given a partial selector, return an array consisting of
+partial selector, return an array consisting of
2 entries: 1st: collection consisting of matching implemented selectors
2nd: the longest match"
@@ -2508,15 +2382,7 @@
!Smalltalk class methodsFor:'queries-system'!
-dialectName
- ^ 'SmalltalkX'
-
- "
- Smalltalk dialectName
- "
-!
-
-dialectReleaseVersion
+ctReleaseVersion
^ self versionString
"
@@ -2524,57 +2390,48 @@
"
!
-isDolphinSmalltalk
- "return false here - this may be useful to write portable
+easeVersion
+ "
+!
+
+e
applications - add #isDolphinSmalltalk to your dolphin,
returning true there."
^ false
!
-isSmalltalkMT
- "return false here - this may be useful to write portable
- applications - add #isSmalltalkMT to your smalltalk-MT,
+applications - add #isSmalltalkMT to your smalltalk-MT,
returning true there."
^ false
!
-isSmalltalkV
- "return false here - this may be useful to write portable
- applications - add #isSmalltalkV to your smalltalkV,
+applications - add #isSmalltalkV to your smalltalkV,
returning true there."
^ false
!
-isSmalltalkX
- "return true here - this may be useful to write portable
- applications - add #isSmalltalkX to your other smalltalks,
+applications - add #isSmalltalkX to your other smalltalks,
returning false there."
^ true
!
-isSqueak
- "return false here - this may be useful to write portable
- applications - add #isSqueak to your squeak,
+lications - add #isSqueak to your squeak,
returning true there."
^ false
!
-isVisualAge
- "return false here - this may be useful to write portable
- applications - add #isVisualAge to your visualAge,
+applications - add #isVisualAge to your visualAge,
returning true there."
^ false
!
-isVisualWorks
- "return false here - this may be useful to write portable
- applications - add #isVisualWorks to your visualWorks,
+applications - add #isVisualWorks to your visualWorks,
returning true there."
^ false
@@ -2582,14 +2439,12 @@
!Smalltalk class methodsFor:'startup'!
-displayInitializationDone
- "inform the restart, that the display has been initialized"
+itialized"
CallbackSignal raiseRequest.
!
-mainStartup:graphicalMode
- "common start/restart action, if there is a Display, initialize it
+ay, initialize it
and start dispatching; otherwise go into a read-eval-print loop."
|process imageName thisIsARestart|
@@ -2747,10 +2602,7 @@
"Modified: / 25.5.1998 / 15:02:57 / cg"
!
-readEvalPrint
- "{ Pragma: +optSpace }"
-
- "simple read-eval-print loop for non-graphical Minitalk"
+non-graphical Minitalk"
|text|
@@ -2775,9 +2627,7 @@
'' printCR
!
-restart
- "startup after an image has been loaded;
- there are three change-notifications made to dependents of ObjectMemory,
+e-notifications made to dependents of ObjectMemory,
which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
#earlySystemInstallation is sent for ST80 compatibility
@@ -2972,9 +2822,7 @@
"Modified: / 3.8.1999 / 09:42:21 / stefan"
!
-start
- "main startup, if there is a Display, initialize it
- and start dispatching; otherwise go into a read-eval-print loop."
+spatching; otherwise go into a read-eval-print loop."
|idx graphicalMode arg didReadRCFile|
@@ -3124,16 +2972,14 @@
!Smalltalk class methodsFor:'startup queries'!
-commandLine
- "return the full command line arguments (with which ST/X was started)"
+arted)"
^ CommandLine
"Created: 19.7.1996 / 11:09:06 / cg"
!
-commandLineArgumentNamed:aString
- "extract a named argument from the command line arguments."
+line arguments."
|args index|
@@ -3149,9 +2995,7 @@
"
!
-commandLineArguments
- "return the user command line arguments;
- This is a collection of strings (separated command line words),
+a collection of strings (separated command line words),
from which the internal startup arguments have already been removed.
I.e. if started with: 'smalltalk -I -f xxx foo bar baz',
the commandLineArguments will be #('foo' 'bar' 'baz').
@@ -3162,45 +3006,34 @@
"Modified: 19.7.1996 / 11:11:03 / cg"
!
-commandName
- "return the excutables name - this is normally 'smalltalk', but
- can be something else for standAlone apps."
+can be something else for standAlone apps."
^ CommandName.
"Modified: 19.7.1996 / 11:11:16 / cg"
!
-isHeadless
- "return true, if this is a headless application
- i.e. no default Display connection is required/used"
+ault Display connection is required/used"
^ HeadlessOperation
!
-isStandAloneApp
- "return true, if this is a standAlone application
- (in contrast to a full smalltalk system)."
+contrast to a full smalltalk system)."
^ StandAlone
!
-startupArguments
- "return the arguments passed to StartupClass"
-
- ^ StartupArguments
-!
-
-startupClass
- "return the class, that will get the start message when smalltalk
+upArguments
+!
+
+alk
starts and its non-nil. Usually this is nil, but saving an image
with a non-nil StartupClass allows stand-alone applications"
^ StartupClass
!
-startupClass:aClass selector:aSymbol arguments:anArrayOrNil
- "{ Pragma: +optSpace }"
+Space }"
"set the class, selector and arguments to be performed when smalltalk
starts. Setting those before saving a snapshot, will make the saved
@@ -3211,30 +3044,18 @@
StartupArguments := anArrayOrNil
!
-startupSelector
- "return the selector, that will be sent to StartupClass"
-
- ^ StartupSelector
+^ StartupSelector
! !
!Smalltalk class methodsFor:'system environment'!
-language
- "return the language setting"
-
- ^ Language
-
- "
- Smalltalk language
+k language
"
"Modified: 26.4.1996 / 17:10:05 / cg"
!
-language:aLanguageSymbol
- "set the language"
-
- Language := aLanguageSymbol.
+l.
self changed:#Language
"
@@ -3244,16 +3065,10 @@
"Modified: 26.4.1996 / 17:13:34 / cg"
!
-languageTerritory
- "return the language territory setting"
-
- ^ LanguageTerritory
-!
-
-languageTerritory:aTerritorySymbol
- "set the language territory"
-
- LanguageTerritory := aTerritorySymbol.
+rritory
+!
+
+geTerritory := aTerritorySymbol.
self changed:#LanguageTerritory
"
@@ -3271,10 +3086,7 @@
!Smalltalk class methodsFor:'system management'!
-compressSources
- "{ Pragma: +optSpace }"
-
- "compress the sources file, and remove all method source strings
+d remove all method source strings
from the system and replace them by refs to a string in the source file.
This is a bit different in ST/X than in other smalltalks,
since we use per-class sourcefiles for the compiled classes,
@@ -3341,10 +3153,7 @@
"Modified: 16.1.1997 / 01:25:58 / cg"
!
-generateSingleSourceFile
- "{ Pragma: +optSpace }"
-
- "generate the sources file, and remove all method source strings
+file, and remove all method source strings
from the system and replace them by refs to a string in the source file.
This makes the image independent from the per-class source files
and makes transportation of endUser applications easier, since
@@ -3403,6 +3212,15 @@
If revisionOrNil is non-nil, set it up to load exactly that revision
(otherwise, the newest revision will be loaded"
+ self installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:nil
+!
+
+installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:numClassInstVarsOrNil
+ "create & install an autoload stub for a class named: clsName,
+ to be loaded from package.
+ If revisionOrNil is non-nil, set it up to load exactly that revision
+ (otherwise, the newest revision will be loaded"
+
|clsSym cls|
clsSym := clsName asSymbol.
@@ -3439,8 +3257,7 @@
"Created: / 5.11.1998 / 15:10:25 / cg"
!
-installAutoloadedClasses
- "read the standard abbreviation file; install all classes found there as
+classes found there as
autoloaded. This takes some time ..."
|dirsConsulted p|
@@ -3500,8 +3317,7 @@
"Modified: / 13.12.1999 / 11:56:50 / cg"
!
-installAutoloadedClassesFrom:anAbbrevFilePath
- "read the given abbreviation file; install all classes found there as
+file; install all classes found there as
autoloaded. This takes some time ..."
|f s|
@@ -3534,7 +3350,7 @@
abbreviation (className-to-fileName mapping) table.
This takes some time ..."
- |s2 l clsName abbrev package cat cls words w abbrevs oldAbbrev nameKey|
+ |s2 l clsName abbrev package cat numClassInstVars cls words w abbrevs oldAbbrev nameKey|
"/ on the fly, update the abbreviations
CachedAbbreviations isNil ifTrue:[
@@ -3581,6 +3397,9 @@
abbrev := (words at:2).
package := (words at:3) asSymbol.
cat := words at:4 ifAbsent:nil.
+ numClassInstVars := words at:5 ifAbsent:'0'.
+ numClassInstVars := Integer readFrom:numClassInstVars onError:[0].
+
"/ KnownPackages add:package.
(cat size == 0) ifTrue:[
@@ -3623,24 +3442,19 @@
"/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
- self installAutoloadedClassNamed:clsName category:cat package:package revision:nil.
+ self installAutoloadedClassNamed:clsName category:cat package:package revision:nil numClassInstVars:numClassInstVars.
]
]
]
]
!
-loadBinaries
- "return true, if binaries should be loaded into the system,
- false if this should be suppressed. The default is false (for now)."
+false if this should be suppressed. The default is false (for now)."
^ LoadBinaries
!
-loadBinaries:aBoolean
- "{ Pragma: +optSpace }"
-
- "turn on/off loading of binary objects"
+binary objects"
aBoolean ifTrue:[
(ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
@@ -3654,9 +3468,7 @@
"Modified: 10.1.1997 / 15:11:00 / cg"
!
-logDoits
- "return true if doits should go into the changes file
- as well as changes - by default, this is off, since
+as changes - by default, this is off, since
it can blow up the changes file enormously ...
"
@@ -3668,10 +3480,7 @@
"
!
-logDoits:aBoolean
- "{ Pragma: +optSpace }"
-
- "turn on/off logging of doits in the changes file.
+s in the changes file.
By default, this is off, since it can blow up the
changes file enormously ...
"
@@ -3680,10 +3489,7 @@
!
-makeBytecodeMethods
- "{ Pragma: +optSpace }"
-
- "walk over all methods and make each a bytecode method
+make each a bytecode method
iff it does not contain primitive C code.
Experimental and not yet used."
@@ -3706,7 +3512,7 @@
"Created: 17.10.1997 / 13:52:19 / cg"
!
-recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
+vels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
"read all abbrev.stc files from and under aDirectory
and install autoloaded classes.
If a file called NOAUTOLOAD is found, no classes there and below are installed as autoloaded
@@ -3809,10 +3615,7 @@
"
!
-replaceReferencesTo:anObject with:newRef
- |toAdd|
-
- toAdd := OrderedCollection new.
+ction new.
self keysAndValuesDo:[:key :val |
(key == anObject) ifTrue:[
self shouldImplement.
@@ -3826,8 +3629,7 @@
].
!
-saveEmergencyImage:aBoolean
- "set/clear the flag which controls if ST/X should save an
+ld save an
emergency image in case of a broken display connection.
The default is true.
This may be useful, if you work with an unsecure display
@@ -3842,9 +3644,7 @@
"Modified: / 24.10.1997 / 18:22:26 / cg"
!
-systemOrganization
- "for partial ST80 compatibility;
- In ST80, Smalltalk organization returns a systemOrganizer, which
+organization returns a systemOrganizer, which
keeps track of class-categories, while all classes return a classOrganizer
from #organization, which keeps track of method categories of that class.
Since in ST/X, Smalltalk is a class, there is now a conflict.
@@ -3860,8 +3660,7 @@
!Smalltalk class methodsFor:'system management-fileIn'!
-fileIn:aFileName
- "read in the named file - look for it in some standard places;
+ces;
return true if ok, false if failed.
This method can load almost anything which makes sense:
.st - source files
@@ -3880,8 +3679,7 @@
"Created: 28.10.1995 / 17:06:28 / cg"
!
-fileIn:aFileName inPackage:aPackageID
- "read in the named file in a packages directory."
+directory."
|dir|
@@ -3893,8 +3691,7 @@
or:[ self fileIn:((dir construct:'source') construct:aFileName) ]
!
-fileIn:aFileName lazy:lazy
- "read in the named file - look for it in some standard places;
+andard places;
return true if ok, false if failed.
If lazy is true, no code is generated for methods, instead stubs
are created which compile themself when first executed. This allows
@@ -3911,8 +3708,7 @@
"Created: 28.10.1995 / 17:06:36 / cg"
!
-fileIn:aFileName lazy:lazy silent:silent
- "read in the named file - look for it in some standard places;
+it in some standard places;
return true if ok, false if failed.
If lazy is true, no code is generated for methods, instead stubs
are created which compile themself when first executed. This allows
@@ -3927,8 +3723,7 @@
"Created: 28.10.1995 / 17:06:41 / cg"
!
-fileIn:aFileNameOrString lazy:lazy silent:silent logged:logged
- "read in the named file - look for it in some standard places;
+named file - look for it in some standard places;
return true if ok, false if failed.
If lazy is true, no code is generated for methods, instead stubs
are created which compile themself when first executed. This allows
@@ -4012,8 +3807,7 @@
"Modified: / 16.2.1999 / 10:03:26 / cg"
!
-fileIn:aFileName logged:logged
- "read in the named file - look for it in some standard places;
+e standard places;
return true if ok, false if failed.
The argument logged controls, if the changefile is to be updated."
@@ -4024,8 +3818,7 @@
"
!
-fileInChanges
- "read in the last changes file - bringing the system to the state it
+tate it
had when left the last time.
WARNING: this method is rubbish: it should only read things after the
last '**snapshot**' - entry
@@ -4041,8 +3834,7 @@
"
!
-fileInClass:aClassName
- "find a source/object file for aClassName and -if found - load it.
+und - load it.
search is in some standard places trying driver-file (.ld), object-file (.o) and
finally source file (.st) in that order.
The file is first searched for using the class name, then the abbreviated name."
@@ -4057,8 +3849,7 @@
"Modified: / 9.1.1998 / 14:41:46 / cg"
!
-fileInClass:aClassName fromObject:aFileName
- "read in the named object file and dynamic-link it into the system
+and dynamic-link it into the system
- look for it in some standard places.
Only install the named class from this object file.
Return true if ok, false if failed."
@@ -4087,8 +3878,7 @@
"Modified: 10.9.1996 / 20:43:52 / cg"
!
-fileInClass:aClassName initialize:doInit
- "find a source/object file for aClassName and -if found - load it.
+assName and -if found - load it.
search is in some standard places trying driver-file (.ld), object-file (.o) and
finally source file (.st) in that order.
The file is first searched for using the class name, then the abbreviated name."
@@ -4103,8 +3893,7 @@
"Modified: / 9.1.1998 / 14:42:02 / cg"
!
-fileInClass:aClassName initialize:doInit lazy:loadLazy
- "find a source/object file for aClassName and -if found - load it.
+t file for aClassName and -if found - load it.
search is in some standard places trying driver-file (.ld), object-file (.o) and
finally source file (.st) in that order.
The file is first searched for using the class name, then the abbreviated name."
@@ -4119,8 +3908,7 @@
"Modified: / 9.1.1998 / 14:42:19 / cg"
!
-fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
- "find a source/object file for aClassName and -if found - load it.
+nd a source/object file for aClassName and -if found - load it.
Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
finally source file (.st), in that order.
The file is first searched for using the class name, then the abbreviated name.
@@ -4139,7 +3927,7 @@
"Modified: / 9.1.1998 / 14:42:28 / cg"
!
-fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
+eSilent
"find a source/object file for aClassName and -if found - load it.
This is the workhorse for autoloading.
Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
@@ -4466,8 +4254,7 @@
"Modified: / 5.6.1999 / 14:53:01 / cg"
!
-fileInClassLibrary:aClassLibraryName
- "find an object file containing a binary class library in some standard places
+ry class library in some standard places
and load it. This install all of its contained classes.
Return true if ok, false if not.
Notice: the argument may not have an extension (by purpose);
@@ -4497,8 +4284,7 @@
"Modified: 8.1.1997 / 17:58:56 / cg"
!
-fileInClassLibrary:aClassLibraryName inPackage:packageID
- "find an object file containing a binary class library in some standard places
+le containing a binary class library in some standard places
and load it. This install all of its contained classes.
Return true if ok, false if not.
Notice: the argument may not have an extension (by purpose);
@@ -4528,8 +4314,7 @@
"Modified: 8.1.1997 / 17:58:56 / cg"
!
-fileInStream:aStream lazy:lazy silent:silent logged:logged addPath:morePath
- "read sourceCode from aStream;
+"read sourceCode from aStream;
return true if ok, false if failed.
If lazy is true, no code is generated for methods, instead stubs
are created which compile themself when first executed. This allows
@@ -4581,8 +4366,7 @@
"Modified: 5.11.1996 / 20:03:35 / cg"
!
-isClassLibraryLoaded:name
- "return true, if a particular class library is already loaded"
+ready loaded"
ObjectMemory
binaryModuleInfo
@@ -4602,8 +4386,7 @@
"
!
-loadClassLibraryIfAbsent:name
- "dynamically load a classLibrary, if not already loaded
+ady loaded
and the system supports dynamic loading.
Return true, if the library is loaded, false if not.
This entry is called without system specific filename
@@ -4622,8 +4405,7 @@
"Modified: 31.10.1996 / 16:57:24 / cg"
!
-secureFileIn:aFileName
- "read in the named file, looking for it at standard places.
+places.
Catch any error during fileIn. Return true if ok, false if failed"
|retVal|
@@ -4639,8 +4421,7 @@
^ retVal
!
-silentFileIn:aFilename
- "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
+ssages on Transcript.
Main use is during startup."
|wasSilent|
@@ -4655,9 +4436,7 @@
!Smalltalk class methodsFor:'system management-files'!
-bitmapFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
+return a readonly fileStream or nil if not found.
Searches in subdirectories named 'bitmaps' in the SystemPath.
Notice: this does not look in the package-specific bitmaps directories."
@@ -4670,8 +4449,7 @@
^ nil
!
-bitmapFromFileNamed:aFileName forClass:aClass
- "search aFileName in some standard places:
+ndard places:
first in the redefinable bitmaps path,
then in the classes own package directory if existing.
Return an image or nil."
@@ -4683,8 +4461,7 @@
"
!
-bitmapFromFileNamed:aFileName inPackage:aPackage
- "search aFileName in some standard places:
+standard places:
first in the redefinable bitmaps path,
then in the package directory if existing.
Return an image or nil."
@@ -4697,8 +4474,7 @@
"
!
-classNameForFile:aFileName
- "return the className which corresponds to an abbreviated fileName,
+breviated fileName,
or nil if no special translation applies. The given filename arg may
include a '.st' suffix (but no other)."
@@ -4721,9 +4497,7 @@
"Modified: 11.12.1995 / 14:51:10 / cg"
!
-constructPathFor:aDirectoryName
- "search for aDirectory in SystemPath;
- return a collection of pathes which include that directory."
+return a collection of pathes which include that directory."
^ self realSystemPath select:[:dirName |
|fullPath|
@@ -4734,9 +4508,7 @@
].
!
-fileInFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
+return a readonly fileStream or nil if not found.
Searches in subdirectories named 'fileIn' in SystemPath"
|aString|
@@ -4748,8 +4520,7 @@
^ nil
!
-fileNameForClass:aClassOrClassName
- "return a good filename for aClassOrClassName -
+sName -
using the abbreviation file if there is one"
|fileName abbrev cls fullClassName shortClassName|
@@ -4792,8 +4563,7 @@
"Modified: / 5.11.2001 / 16:49:17 / cg"
!
-filenameAbbreviations
- "return a dictionary containing the classname-to-filename
+name
mappings. (needed for sys5.3 users, where filenames are limited
to 14 chars)"
@@ -4811,10 +4581,7 @@
"
!
-flushPathCaches
- "{ Pragma: +optSpace }"
-
- "forget pathCaches - these are collections containing valid directory names,
+collections containing valid directory names,
where system files (resource, bitmaps etc.) are found.
A flush is only required, if a new system directory has been created while
the system is active, and those files should override the others
@@ -4828,9 +4595,7 @@
"
!
-getBinaryFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'binary' in SystemPath);
+(subdirectories named 'binary' in SystemPath);
return the absolute filename or nil if none is found."
BinaryPath isNil ifTrue:[
@@ -4842,9 +4607,7 @@
"Modified: 18.7.1996 / 15:53:49 / cg"
!
-getBitmapFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'bitmaps' in SystemPath);
+(subdirectories named 'bitmaps' in SystemPath);
return the absolute filename or nil if none is found."
|f|
@@ -4868,9 +4631,7 @@
"Modified: 18.7.1996 / 15:53:55 / cg"
!
-getFileInFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'fileIn' in SystemPath);
+(subdirectories named 'fileIn' in SystemPath);
return the absolute filename or nil if none is found."
FileInPath isNil ifTrue:[
@@ -4882,8 +4643,7 @@
"Modified: 18.7.1996 / 15:53:59 / cg"
!
-getPackageDirectoryForPackage:aPackageID
- "search for a particular package; return its directory, or nil"
+return its directory, or nil"
|packageDir|
@@ -4911,9 +4671,7 @@
"
!
-getPackageFileName:aFileName
- "search aFileName in some standard places
- (packagePath and subdirectories named 'packages' in SystemPath);
+(packagePath and subdirectories named 'packages' in SystemPath);
return the absolute filename or nil if none is found."
|f|
@@ -4946,9 +4704,7 @@
"
!
-getResourceFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'resource' in SystemPath);
+(subdirectories named 'resource' in SystemPath);
return the absolute filename or nil if none is found."
|f|
@@ -4972,8 +4728,7 @@
"Modified: 18.7.1996 / 15:54:03 / cg"
!
-getResourceFileName:aFileName forClass:aClassOrNil
- "search aFileName in some standard places
+e standard places
(subdirectories named 'resource' in SystemPath);
and in aClasses package directory.
Return the absolute filename or nil if none is found."
@@ -4990,8 +4745,7 @@
"
!
-getResourceFileName:aFileName forPackage:aPackageIDOrNil
- "search aFileName in some standard places
+in some standard places
(subdirectories named 'resource' in SystemPath);
and in a packages directory.
Return the absolute filename or nil if none is found."
@@ -5039,9 +4793,7 @@
"
!
-getSourceFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'source' in SystemPath);
+(subdirectories named 'source' in SystemPath);
return the absolute filename or nil if none is found.
This is used to find a sourceFile for a methods source,
if no sourceCodeManager is available."
@@ -5070,8 +4822,7 @@
"Modified: 18.7.1996 / 15:54:07 / cg"
!
-getSystemFileName:aFileNameOrString
- "search aFileNameOrString in some standard places;
+ard places;
return the absolute filename or nil if none is found.
see comment in Smalltalk>>initSystemPath.
This should be used to access resources such as bitmaps, doc-files,
@@ -5116,8 +4867,7 @@
"Modified: / 6.5.1999 / 10:40:37 / cg"
!
-imageFromFileNamed:aFileName forClass:aClass
- "search aFileName in some standard places:
+dard places:
first in the redefinable bitmaps path, then in the classes
own package directory if existing.
Return an image or nil."
@@ -5152,8 +4902,7 @@
"
!
-imageFromFileNamed:aFileName inPackage:aPackage
- "search aFileName in some standard places:
+tandard places:
first in the redefinable bitmaps path, then in the
package directory if existing.
Return an image or nil."
@@ -5186,8 +4935,7 @@
"
!
-libraryFileNameOfClass:aClassOrClassName
- "for a given class, return the name of a classLibrary which contains
+e of a classLibrary which contains
binary code for it.
Read the libinfo file 'liblist.stc' (which is created during the compilation process)
for an entry for aClassOrClassName.
@@ -5245,8 +4993,7 @@
"Modified: 6.11.1995 / 15:41:39 / cg"
!
-packagePath
- "return a collection of additional directorynames, where smalltalk
+alk
looks for package directories.
Notice, that directories named 'packages' under the systemPath are
always consulted - even if not in the packagePath"
@@ -5260,9 +5007,7 @@
"
!
-packagePath:aPath
- "set the packagePath;
- a collection of additional directorynames, where smalltalk
+ectorynames, where smalltalk
looks for package directories.
Notice, that directories named 'packages' under the systemPath are
always consulted - even if not in the packagePath"
@@ -5274,8 +5019,7 @@
"
!
-projectDirectoryForClass:aClass
- "given a class, return the path to its package directory;
+age directory;
nil if not found."
|pkg|
@@ -5291,8 +5035,7 @@
"
!
-projectDirectoryForPackage:aPackage
- "given a packageID, return the path to its package directory;
+its package directory;
nil if not found."
|prj prjDir|
@@ -5314,8 +5057,7 @@
"
!
-readAbbreviations
- "read classname to filename mappings from include/abbrev.stc.
+stc.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
|aStream f dirsConsulted|
@@ -5364,8 +5106,7 @@
"Modified: / 10.12.1999 / 17:48:53 / cg"
!
-readAbbreviationsFromStream:aStream
- "read classname to filename mappings from aStream.
+om aStream.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
|abbrevs line words nm abbrev pkg key oldAbbrev cls s w|
@@ -5440,9 +5181,7 @@
"Modified: / 13.12.1999 / 11:54:17 / cg"
!
-realSystemPath
- "return the realSystemPath - thats the directorynames from
- SystemPath which exist and are readable"
+SystemPath which exist and are readable"
|nP|
@@ -5486,12 +5225,10 @@
^ RealSystemPath
!
-recursiveReadAllAbbreviationsFrom:aDirectory
- self recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:15
-!
-
-recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:maxLevels
- "read all abbreviations from and under aDirectory."
+ionsFrom:aDirectory maxLevels:15
+!
+
+abbreviations from and under aDirectory."
|abbrevStream dir directoryContents|
@@ -5534,16 +5271,13 @@
].
!
-resourceFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
+return a readonly fileStream or nil if not found.
Searches in subdirectories named 'resource' in SystemPath"
^ self resourceFileStreamFor:aFileName forClass:nil
!
-resourceFileStreamFor:aFileName forClass:aClassOrNil
- "search aFileName in some standard places and in the classes
+ome standard places and in the classes
package-resource directory.
Return a readonly fileStream or nil if not found.
Searches in subdirectories named 'resource' in SystemPath"
@@ -5557,8 +5291,7 @@
^ nil
!
-searchPath:aPath for:aFileName in:aDirName
- "search aPath for a subdirectory named aDirectory with a file
+named aDirectory with a file
named aFileName"
|f|
@@ -5592,8 +5325,7 @@
"Modified: / 29.4.1999 / 15:06:43 / cg"
!
-sourceDirectoryNameOfClass:aClassOrClassName
- "for a given class, return the pathname relative to TOP of the classes source code.
+pathname relative to TOP of the classes source code.
Read the files 'abbrev.stc' and 'liblist.stc' (which are created during the compilation process)
for an entry for aClassOrClassName.
Search for the className in the first col, and return the value found in
@@ -5649,9 +5381,7 @@
"Modified: 3.1.1997 / 11:26:44 / stefan"
!
-sourceFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
+return a readonly fileStream or nil if not found.
Searches in subdirectories named 'source' in SystemPath"
|aString|
@@ -5663,9 +5393,7 @@
^ nil
!
-systemFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
+return a readonly fileStream or nil if not found.
see comment in Smalltalk>>initSystemPath"
|aString|
@@ -5677,9 +5405,7 @@
^ nil
!
-systemPath
- "return a collection of directorynames, where smalltalk
- looks for system files
+ks for system files
(usually in subdirs such as resources, bitmaps, source etc.)
see comment in Smalltalk>>initSystemPath."
@@ -5691,9 +5417,7 @@
"
!
-systemPath:aPath
- "set the collection of directorynames, where smalltalk
- looks for system files
+looks for system files
(usually in subdirs such as resources, bitmaps, source etc.)
see comment in Smalltalk>>initSystemPath."
@@ -5708,12 +5432,7 @@
!Smalltalk class methodsFor:'system management-packages'!
-knownPackages
- ^ KnownPackages ? #()
-!
-
-loadExtensionsForPackage:aPackageId
- |packageDirName|
+|packageDirName|
packageDirName := aPackageId copyReplaceAll:$: with:$/.
@@ -5724,10 +5443,16 @@
^ self loadExtensionsFromDirectory:packageDirName
!
-loadExtensionsFromDirectory:packageDirOrString
- |packageDir f|
-
- packageDir := packageDirOrString asFilename.
+aPackageId copyReplaceAll:$: with:$/.
+
+ packageDirName := self getPackageFileName:packageDirName.
+ packageDirName isNil ifTrue:[
+ ^ false
+ ].
+ ^ self loadExtensionsFromDirectory:packageDirName
+!
+
+ir := packageDirOrString asFilename.
f := packageDir construct:'extensions.st'.
f exists ifTrue:[
@@ -5740,8 +5465,7 @@
^ false
!
-loadPackage:aPackageIdOrPackage
- "make certain, that some particular package is loaded into the system.
+is loaded into the system.
Experimental."
(aPackageIdOrPackage isSymbol
@@ -5758,8 +5482,7 @@
"
!
-loadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
- "load all source files found in aDirectory and treat them like
+urce files found in aDirectory and treat them like
a package. Allows for initial import of alien ST-code as a new package.
Experimental."
@@ -5809,8 +5532,7 @@
!
-loadPackage:packageId fromClassLibrary:aFilename
- "load a package from a compiled classLib.
+piled classLib.
Experimental."
|p t new|
@@ -5837,8 +5559,7 @@
^ true
!
-loadPackage:packageId fromLoadAllFile:aFilename
- "load a package from a loadAll - loader script.
+All - loader script.
Experimental."
|p t new|
@@ -5866,8 +5587,7 @@
^ true
!
-loadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded
- "load a package from a .prj spec.
+oad a package from a .prj spec.
Experimental."
@@ -5921,16 +5641,14 @@
"
!
-loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded
- "load a package from a .zip delivery file.
+ad a package from a .zip delivery file.
Experimental."
"/ not yet implemented ...
^ false
!
-loadPackageWithId:aPackageId
- "make certain, that some particular package is loaded into the system.
+loaded into the system.
Experimental."
@@ -5945,8 +5663,7 @@
"
!
-loadPackageWithId:aPackageId asAutoloaded:doLoadAsAutoloaded
- "make certain, that some particular package is loaded into the system.
+that some particular package is loaded into the system.
Experimental."
|pkg packageDirName packageBaseName packageDir|
@@ -5996,7 +5713,7 @@
"
!
-loadPackageWithId:aPackageId name:packageName fromDirectory:packageDirOrString asAutoloaded:doLoadAsAutoloaded
+asAutoloaded:doLoadAsAutoloaded
|f s packageDir shLibName|
packageDir := packageDirOrString asFilename.
@@ -6128,30 +5845,21 @@
!Smalltalk class methodsFor:'system management-undeclared variables'!
-clearUndeclaredVariables
- "remove all undeclared variables"
-
- (Smalltalk at:#Undeclared) do:[:eachKey |
+at:#Undeclared) do:[:eachKey |
Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
].
(Smalltalk at:#Undeclared) removeAll.
Smalltalk removeKey:#Undeclared.
!
-undeclaredPrefix
- "the prefix used for undeclared variables"
-
- ^ 'Undeclared:::'
+red:::'
"Created: / 31.10.1997 / 01:13:10 / cg"
! !
!Smalltalk class methodsFor:'time-versions'!
-configuration
- "{ Pragma: +optSpace }"
-
- "for developers only: return the configuration, with which
+configuration, with which
this smalltalk was compiled."
%{ /* NOCONTEXT */
@@ -6166,12 +5874,7 @@
"
!
-copyrightString
- "{ Pragma: +optSpace }"
-
- "return a copyright string"
-
-%{ /* NOCONTEXT */
+{ /* NOCONTEXT */
#ifndef __getCopyrightString
extern OBJ __getCopyrightString();
#endif
@@ -6185,10 +5888,7 @@
"
!
-distributorString
- "{ Pragma: +optSpace }"
-
- "return a string describing the distributor of this software"
+the distributor of this software"
%{ /* NOCONTEXT */
#ifndef __getDistributorString
@@ -6204,10 +5904,7 @@
"
!
-expirationTime
- "{ Pragma: +optSpace }"
-
- "for developers only: return the time when the system will expire.
+e time when the system will expire.
after this time it will not run any longer.
It returns nil, if no expiration time has been set (system runs forever :-))"
@@ -6228,10 +5925,7 @@
"
!
-fullVersionString
- "{ Pragma: +optSpace }"
-
- "return a full version string"
+g"
^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
@@ -6243,12 +5937,7 @@
"Modified: / 27.10.1997 / 17:04:02 / cg"
!
-hello
- "{ Pragma: +optSpace }"
-
- "return a greeting string"
-
- "stupid: this should come from a resource file ...
+this should come from a resource file ...
but I dont use it here, to allow mini-systems without
Resource-stuff."
@@ -6296,8 +5985,7 @@
"Modified: 18.5.1996 / 14:25:13 / cg"
!
-imageRestartTime
- "return a timestamp for the moment when this image was restarted.
+tarted.
If we do not execute from an image (i.e. fresh start), return nil."
^ ImageRestartTime
@@ -6311,18 +5999,12 @@
"Modified: 6.3.1996 / 11:56:35 / cg"
!
-imageSaveTime
- "{ Pragma: +optSpace }"
-
- "return a timestamp for the moment when this image was saved"
+nt when this image was saved"
^ ObjectMemory imageSaveTime
!
-imageStartTime
- "{ Pragma: +optSpace }"
-
- "return a timestamp for the moment when this system started the first time
+ent when this system started the first time
(i.e. the first initial start without an image)"
^ ImageStartTime
@@ -6336,10 +6018,7 @@
"Modified: 13.12.1995 / 17:45:47 / cg"
!
-majorVersionNr
- "{ Pragma: +optSpace }"
-
- "return the major version number.
+r.
This is only incremented for very fundamental changes,
which make old object files totally incompatible
(for example, if the layout/representation of fundamental
@@ -6357,10 +6036,7 @@
"Modified: 8.11.1996 / 19:59:21 / cg"
!
-minorVersionNr
- "{ Pragma: +optSpace }"
-
- "return the minor version number.
+r.
This is incremented for changes which make some old object
files incompatible, or the protocol changes such that some
classes need rework.
@@ -6377,10 +6053,7 @@
"Modified: / 3.11.1997 / 14:49:48 / cg"
!
-releaseIdentification
- "{ Pragma: +optSpace }"
-
- "for developers only: return the release
+turn the release
(to further identify the version in case of errors)"
%{ /* NOCONTEXT */
@@ -6395,11 +6068,7 @@
"
!
-releaseNr
- "{ Pragma: +optSpace }"
-
- "return the revision number.
- Incremented for releases which fix bugs/add features but did not find
+cremented for releases which fix bugs/add features but did not find
their way to the outside world.
ST/X revision Naming is:
@@ -6414,11 +6083,7 @@
"Created: 10.12.1995 / 01:42:19 / cg"
!
-revisionNr
- "{ Pragma: +optSpace }"
-
- "return the revision number.
- Incremented for releases which fix bugs/add features
+ncremented for releases which fix bugs/add features
and represent a stable workable version which got published
to the outside world.
@@ -6435,17 +6100,14 @@
"Modified: / 19.6.1998 / 04:29:10 / cg"
!
-timeStamp
- "return a string useful for timestamping a file.
- The returned string is padded with spaces for a constant
+d string is padded with spaces for a constant
length (to avoid changing a files size in fileOut with unchanged
class)."
^ ('''' , self timeStampString , '''') paddedTo:80 with:(Character space)
!
-timeStamp:aStream
- "write a string useful for timestamping a file onto aStream.
+am.
ST80 compatibility"
aStream nextPutAll:(self timeStamp).
@@ -6453,18 +6115,12 @@
"Created: / 18.6.1998 / 17:22:58 / cg"
!
-timeStampString
- "return a string useful for timestamping a file."
-
- ^ ('From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
+From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
, Date today printString , ' at ' , Time now printString
)
!
-versionDate
- "{ Pragma: +optSpace }"
-
- "return the executables build date - thats the date when the smalltalk
+- thats the date when the smalltalk
executable was built"
%{ /* NOCONTEXT */
@@ -6479,12 +6135,7 @@
"
!
-versionString
- "{ Pragma: +optSpace }"
-
- "return the version string"
-
- ^ (self majorVersionNr printString ,
+^ (self majorVersionNr printString ,
'.',
self minorVersionNr printString ,
'.',
@@ -6495,10 +6146,7 @@
"
!
-vmMajorVersionNr
- "{ Pragma: +optSpace }"
-
- "return the VMs major version number."
+number."
%{
RETURN (__MKSMALLINT(4));
%}.
@@ -6513,5 +6161,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.591 2003-08-14 16:08:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.592 2003-08-18 22:32:25 cg Exp $'
! !