--- a/Smalltalk.st Wed Sep 22 13:52:26 2004 +0200
+++ b/Smalltalk.st Wed Sep 22 14:21:56 2004 +0200
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:5.2.4 on 22-09-2004 at 02:20:57 PM' !
+
"{ Package: 'stx:libbasic' }"
Object subclass:#Smalltalk
@@ -31,29 +33,21 @@
!Smalltalk class methodsFor:'documentation'!
-directories while running
- (and want the running ST/X to look there)
-
-
- [author:]
- Claus Gittinger
-
- [see also:]
- ObjectMemory
+copyright
"
-! !
-
-!Smalltalk class methodsFor:'initialization'!
-
-initGlobalsFromEnvironment
- "setup globals from the shell-environment"
-
- |envString i langString terrString|
-
- StandAlone isNil ifTrue:[
- StandAlone := false.
- ].
- HeadlessOperation idocumentation
+ COPYRIGHT (c) 1988 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
"
This is one of the central classes in the system;
it provides all system-startup, shutdown and maintenance support.
@@ -187,9 +181,11 @@
[see also:]
ObjectMemory
"
-ing.
- terrString := envString
- ] ifFinitGlobalsFromEnvironment
+! !
+
+!Smalltalk class methodsFor:'initialization'!
+
+initGlobalsFromEnvironment
"setup globals from the shell-environment"
|envString i langString terrString|
@@ -252,7 +248,25 @@
"
"Modified: 22.2.1996 / 16:59:12 / cg"
-
+!
+
+initInterrupts
+ "initialize interrupts"
+
+ OperatingSystem enableUserInterrupts.
+ OperatingSystem enableHardSignalInterrupts.
+ OperatingSystem enableCrashSignalInterrupts.
+
+ ObjectMemory userInterruptHandler:self.
+ ObjectMemory signalInterruptHandler:self.
+ ObjectMemory recursionInterruptHandler:self.
+
+ "
+ Smalltalk initInterrupts
+ "
+
+ "Modified: 20.8.1997 / 09:35:49 / stefan"
+!
initStandardStreams
"initialize some well-known streams"
@@ -270,10 +284,6 @@
initStandardTools
"predefine some tools which we will need later
-
-
-initStandardTools
- "predefine some tools which we will need later
- if the view-classes exist,
they will redefine Inspector and Debugger for graphical interfaces"
@@ -281,28 +291,20 @@
Display notNil ifTrue:[
InspectorView notNil ifTrue:[
- Inspector := InspectorView"
-!
-
-initUserPreferences
- "setup other stuff"
-
- LogDoits := false.
- LoadBinaries := false.
- SaveEmergencyImage := (StandAlone ~~ true).
-
- "Modified: / 24.10.1997 / 18:22:47 / cg"
-!
-
-initializeClass:aClass
- "sent from VM via #initializeModules"
-
- Error handle:[:ex |
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
+ Inspector := InspectorView
+ ].
+ DebugView notNil ifTrue:[
+ Debugger := DebugView
].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [wainitSystemPath
+ Display initialize
+ ]
+
+ "
+ Smalltalk initStandardTools
+ "
+!
+
+initSystemPath
"setup path where system files are searched for.
the default path is set to:
.
@@ -370,7 +372,17 @@
"
"Modified: / 24.12.1999 / 00:23:35 / cg"
-
+!
+
+initUserPreferences
+ "setup other stuff"
+
+ LogDoits := false.
+ LoadBinaries := false.
+ SaveEmergencyImage := (StandAlone ~~ true).
+
+ "Modified: / 24.10.1997 / 18:22:47 / cg"
+!
initializeClass:aClass
"sent from VM via #initializeModules"
@@ -379,7 +391,28 @@
ClassesFailedToInitialize isNil ifTrue:[
ClassesFailedToInitialize := IdentitySet new.
].
- ialize') errorPrintCR.
+ 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.
+ Notice: this is not called when an image is restarted"
+
+ self initializeModulesOnce.
+ ClassesFailedToInitialize size > 0 ifTrue:[
+ ('Smalltalk [info]: retry initialization of failed class(es)...') infoPrintCR.
+ ClassesFailedToInitialize := nil.
+ self initializeModulesOnce.
+ ClassesFailedToInitialize size > 0 ifTrue:[
+ ('Smalltalk [error]: class(es) persist to fail during initialize') errorPrintCR.
]
].
!
@@ -400,33 +433,6 @@
initializeSystem
"initialize all other classes; setup dispatcher processes etc.
- initializeModules
- "perform module specific initialization and
- send #initialize to all classes.
- Notice: this is not called when an image is restarted"
-
- self initializeModulesOnce.
- ClassesFailedToInitialize size > 0 ifTrue:[
- ('Smalltalk [info]: retry initialization of failed class(es)...') infoPrintCR.
- ClassesFailedToInitialize := nil.
- self initializeModulesOnce.
- ClassesFailedToInitialize size > 0 ifTrue:[
- ('Smalltalk [error]: class(es) persist to fail during initialize') errorPrintCR.
- ]
- ].
--level initialization
- "/ now, we are certain, that all other classes have been initialized
- "/ (especially: streams and signals can now be used)
- "/
- ObjectMemory changed:#initialized.
-
- "Modified: 8.1.1997 / 19:58:12 / stefan"
- "Modified: 7.9.1997 / 23:34:44 / cg"
-!
-
-isInitialized
- "this reinitializeSystem
- "initialize all other classes; setup dispatcher processes etc.
This one is the very first entry into the smalltalk world,
right after startup, ususally immediately followed by Smalltalk>>start.
Notice:
@@ -533,43 +539,51 @@
"Modified: 8.1.1997 / 19:58:12 / stefan"
"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
+ not working correctly until initialized."
+
+ ^ Initializing not
+!
reinitStandardStreams
"reinitialize some well-known streams.
Tis must be done very early during startup, to allow for
debug and trace messages to be output
- (otherwise, the file-descriptors are invalid)"reinitStandardStreams
- "reinitialize some well-known streams.
- Tis must be done very early during startup, to allow for
- debug and trace messages to be output
(otherwise, the file-descriptors are invalid)"
Stdout reOpen. Stderr reOpen. Stdin reOpen.
! !
-!firstEmptyIndex := sz + 1.
- SpecialObjectArray := newObjects.
- objects := newObjects
- ].
-
- objects at: firstEmptyIndex put: anObject.
- ^ firstEmptyIndex
-
-!
-
-renameClassNamed:oldName as:newName
- self renameClass:(self at:oldName) to:newName
-!
-
-unregisterExternalObject: anObject
- "Unregister the given object in the external objects array.
- Do nothing if it isn't registered."
-
- |objects|
-
- anObject isNil ifTrue:[^ self].
- objects := SpecialObjregisterExternalObject: anObject
+!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
+ newSpace + freeListSpace is returned."
+
+ ObjectMemory scavenge.
+ ^ ObjectMemory freeSpace
+ + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
+
+!
+
+isMorphic
+ ^ false
+!
+
+registerExternalObject: anObject
"Register the given 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
@@ -605,7 +619,28 @@
objects at: firstEmptyIndex put: anObject.
^ firstEmptyIndex
-
+!
+
+renameClassNamed:oldName as:newName
+ self renameClass:(self at:oldName) to:newName
+!
+
+unregisterExternalObject: anObject
+ "Unregister the given object in the external objects array.
+ Do nothing if it isn't registered."
+
+ |objects|
+
+ anObject isNil ifTrue:[^ self].
+ objects := SpecialObjectArray.
+ 1 to: objects size do: [:i |
+ (objects at: i) == anObject ifTrue: [
+ objects at: i put: nil
+ ]
+ ].
+! !
+
+!Smalltalk class methodsFor:'Compatibility-V''Age'!
allClassesImplementing:aSelector
^ self allClasses select:[:cls | cls implements:aSelector].
@@ -619,21 +654,6 @@
indexed == #none ifTrue:[
newClass := superclass
subclass:nameSymbol
- instanceVariabss instanceVariableNames:classInstVars.
- ].
- ^ newClass
- ].
- self shouldImplement.
-! !
-
-!Smalltalk class methodsFor:'accessing'!
-
-associationAtdefineClass:nameSymbol superclass:superclass indexedType:indexed private:private instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category attributes:annotations
- |newClass|
-
- indexed == #none ifTrue:[
- newClass := superclass
- subclass:nameSymbol
instanceVariableNames:instVars
classVariableNames:''
poolDictionaries:''
@@ -645,7 +665,23 @@
^ newClass
].
self shouldImplement.
-
+! !
+
+!Smalltalk class methodsFor:'accessing'!
+
+associationAt:aKey
+ "return a key-value association for aKey.
+ Since ST/X's Smalltalk as no real dictionary, this is
+ simulated here."
+
+ |val|
+
+ val := self at:aKey ifAbsent:nil.
+ val isNil ifTrue:[^ nil].
+ ^ Association key:aKey value:val
+
+ "Created: / 1.11.1997 / 13:27:20 / cg"
+!
associationAt:aKey ifAbsent:exceptionBlock
"return a key-value association for aKey, or the value
@@ -657,7 +693,10 @@
val := self at:aKey ifAbsent:nil.
val isNil ifTrue:[^ exceptionBlock value].
- ^ Associatio
+ ^ Association key:aKey value:val
+
+ "Created: / 18.6.1998 / 17:05:24 / cg"
+!
at:aKey
"retrieve the value stored under aKey, a symbol.
@@ -674,10 +713,6 @@
at:aKey ifAbsent:aBlock
"retrieve the value stored at aKey.
- If the
-
-at:aKey ifAbsent:aBlock
- "retrieve the value stored at aKey.
If there is nothing stored under this key, return the value of
the evaluation of aBlock."
@@ -687,7 +722,10 @@
^ aBlock value
"
- Smalltalk at:#fooBar <- returns ni
+ Smalltalk at:#fooBar <- returns nil
+ Smalltalk at:#fooBar ifAbsent:['sorry'] <- no error
+ "
+!
at:aKey ifPresent:aBlock
"try to retrieve the value stored at aKey.
@@ -700,31 +738,13 @@
^ nil
"
- Smalltalk at:#fooBar ifPresent:[:what | Transcript showCR:what].
' , aValue name , ' as ' , aKey) infoPrintCR.
-"/ ].
-
- aValue name == aKey ifTrue:[
- CachedClasses add:aValue
- ] ifFalse:[
- CachedClasses := nil
- ]
- ].
- ].
- ^ aValue.
-"/
-"/%{ /* NOCONTEXT */
-"/ (void) __GLOBAL_SET(aKey, aValue, (OBJ *)0);
-"/%}.
-"/ CachedClasses := nil.
-"/ ^ aValue
-
- "Modified: 19.4.1996 / 11:31:49 / cg"
-!
-
-includesKey:aKey
- "return true, if the key is known"
-
- at:aKey put:aValue
+ Smalltalk at:#fooBar ifPresent:[:what | Transcript showCR:what].
+ Smalltalk at:#Object ifPresent:[:what | Transcript showCR:what].
+ "
+
+!
+
+at:aKey put:aValue
"store the argument aValue under aKey, a symbol.
Return aValue (sigh)."
@@ -754,7 +774,29 @@
].
^ aValue.
"/
-"/%
+"/%{ /* NOCONTEXT */
+"/ (void) __GLOBAL_SET(aKey, aValue, (OBJ *)0);
+"/%}.
+"/ CachedClasses := nil.
+"/ ^ aValue
+
+ "Modified: 19.4.1996 / 11:31:49 / cg"
+!
+
+includesKey:aKey
+ "return true, if the key is known"
+
+ "/ for debugging - this is a common mistake,
+ "/ to try to access a class by nameString, instead
+ "/ of by symbol.
+
+ "/ aKey class == String ifTrue:[self halt].
+
+%{ /* NOCONTEXT */
+ RETURN ( __GLOBAL_KEYKNOWN(aKey) );
+%}.
+ ^ self primitiveFailed
+!
keyAtValue:anObject
"return the symbol under which anObject is stored - or nil"
@@ -778,16 +820,6 @@
!
removeKey:aKey
- "remove the association stored under the key-argument from the globals dictio reintroduced, a new association will be created and
- the new global now referenced via the new association.
- The old accesses will still see nil, although the globals value is actually non-nil
- (this is questionable).
- To avoid this problem, the #removeClass: method never removed the key."
-
- CachedClasses := nil.
-
-%{ /* NOCONTEXT */
- RETURN ( __GLOBAL_REMOVEremoveKey:aKey
"remove the association stored under the key-argument from the globals dictionary.
WARNING:
this is somewhat dangerous: conceptionally, the association is removed,
@@ -803,23 +835,28 @@
CachedClasses := nil.
-% ]
- ]
- ].
-
- pools do:[:poolDictionary|
- poolDictionary addGlobalsForBinaryStorageTo:globalDictionary
- ]
-
- "Modified: 19.3.1997 / 18:15:25 / cg"
- "Created: 21.3.1997 / 15:40:31 / cg"
-!
-
-storeBinaryDefinitionOf:anObject on:stream manager:manager
- |string|
-
- anObject class == Association ifTrue:[
- string := 'Smalltalk associationAaddGlobalsForBinaryStorageTo:globalDictionary
+%{ /* NOCONTEXT */
+ RETURN ( __GLOBAL_REMOVE(aKey) );
+%}.
+ ^ self primitiveFailed
+
+!
+
+values
+ "return a collection with all values in the Smalltalk dictionary"
+
+ |values|
+
+ values := OrderedCollection new.
+ self do:[:v | values add:v].
+ ^ values
+
+ "Created: 20.6.1997 / 16:58:28 / cg"
+! !
+
+!Smalltalk class methodsFor:'binary storage'!
+
+addGlobalsForBinaryStorageTo:globalDictionary
|pools|
pools := Set new.
@@ -847,9 +884,9 @@
"Modified: 19.3.1997 / 18:15:25 / cg"
"Created: 21.3.1997 / 15:40:31 / cg"
-
-
-sstoreBinaryDefinitionOf:anObject on:stream manager:manager
+!
+
+storeBinaryDefinitionOf:anObject on:stream manager:manager
|string|
anObject class == Association ifTrue:[
@@ -864,7 +901,19 @@
"Modified: 19.3.1997 / 18:49:14 / cg"
! !
-!Smalltalk class
+!Smalltalk class methodsFor:'browsing'!
+
+browseAllCallsOn:aSelectorSymbol
+ "{ Pragma: +optSpace }"
+
+ "startup a browser for all methods sending a particular message"
+
+ UserPreferences systemBrowserClass browseAllCallsOn:aSelectorSymbol
+
+ "
+ Smalltalk browseAllCallsOn:#at:put:
+ "
+!
browseAllSelect:aBlock
"{ Pragma: +optSpace }"
@@ -879,8 +928,20 @@
!
browseChanges
- browseAllSelect:aBlock
- "{ Pragma: +optSpace }
+ "{ Pragma: +optSpace }"
+
+ "startup a changes browser"
+
+ ChangesBrowser notNil ifTrue:[
+ ChangesBrowser open
+ ] ifFalse:[
+ self warn:'no ChangesBrowser built in'
+ ]
+
+ "
+ Smalltalk browseChanges
+ "
+!
browseClass:aClass
"{ Pragma: +optSpace }"
@@ -899,14 +960,13 @@
"startup a browser for all methods implementing a message matching"
- UserPreferences systemBrowserClass browseImplementorsMatching:aSelectorSymbbrowseClass:aClass
- "{ Pragma: +optSpace }
-
-browseImplementorsMatching:aSelectorSymbolOrMatchPattern
- "{ Pragma: +optSpace }"
-
- "startup a browser for all methods implementing a mbrowseImplementorsMatching:aSelectorSymbolOrMatchPattern
- "{ Pragma: +optSpace }
+ UserPreferences systemBrowserClass browseImplementorsMatching:aSelectorSymbolOrMatchPattern
+
+ "
+ Smalltalk browseImplementorsOf:#'at:put:'
+ Smalltalk browseImplementorsMatching:#'at:*'
+ "
+!
browseImplementorsOf:aSelectorSymbol
"{ Pragma: +optSpace }"
@@ -917,8 +977,20 @@
"
Smalltalk browseImplementorsOf:#at:put:
- "
browseImplementorsOf:aSelectorSymbol
- "{ Pragma: +optSpace }
+ "
+!
+
+browseInClass:aClass
+ "{ Pragma: +optSpace }"
+
+ "startup a full browser showing aClass"
+
+ UserPreferences systemBrowserClass openInClass:aClass
+
+ "
+ Smalltalk browseInClass:Array
+ "
+!
browseInClass:aClass selector:selector
"{ Pragma: +optSpace }"
@@ -935,19 +1007,6 @@
!Smalltalk class methodsFor:'class management'!
changeCategoryOf:aClass to:newCategory
- "change a classes category, add a change record,browseInClass:aClass selector:selector
- "{ Pragma: +optSpace }ion with:(aClass -> oldCategory).
- ]
- ].
-
- "
- Smalltalk changeCategoryOf:NewApplication to:#myApplications
- "
-
- "Modified: / 11.2.2000 / 11:36:27 / cg"
-!
-
-defineNameSpace: name private: private imports: imports category:changeCategoryOf:aClass to:newCategory
"change a classes category, add a change record,
send change notifications"
@@ -970,22 +1029,29 @@
"
"Modified: / 11.2.2000 / 11:36:27 / cg"
-lso registered under the name ' , actualName
- , ' - remove that binding too.') infoPrintCR.
- self at:actualName put:nil.
- ].
- ].
-
- ns ~~ Smalltalk ifTrue:[
- ons notNil ifTrue:[
- ClassBuilder
- recompileGlobalAccessorsTo:oldNameSym
- in:ons
- except:nil
- ].
- (ns notNil and:[ns ~~ ons]) ifTrue:[
- ClassBuilder
- recompileGlobalAccessoremoveClass:aClass
+!
+
+defineNameSpace: name private: private imports: imports category: category attributes: annotations
+ NameSpace name:name
+
+!
+
+flushCachedClass:aClass
+ CachedClasses notNil ifTrue:[
+ CachedClasses remove:aClass ifAbsent:[]
+ ]
+!
+
+flushCachedClasses
+ CachedClasses := nil.
+ Class flushSubclassInfo.
+
+ "
+ Smalltalk flushCachedClasses
+ "
+!
+
+removeClass:aClass
"remove the argument, aClass from the smalltalk dictionary;
we have to flush the caches since these methods are now void.
Also, class variables of aClass are removed."
@@ -1105,7 +1171,9 @@
].
"Modified: / 20.6.1998 / 13:26:10 / cg"
-e charenameClass:aClass to:newName
+!
+
+renameClass:aClass to:newName
"rename aClass to newName. Most of the work is in
renaming the classVariables (create & copy over values)
and patching the classes methods to access the new variables."
@@ -1343,7 +1411,26 @@
"Created: / 29.10.1995 / 19:58:32 / cg"
"Modified: / 18.6.1996 / 14:20:50 / stefan"
"Modified: / 11.2.2000 / 01:12:38 / cg"
-
+! !
+
+!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
+ "return a deep copy of the receiver.
+ Redefined to return the receiver - there is only one Smalltalk dictionary"
+
+ ^ self
+
+ "Modified: 18.5.1996 / 12:13:36 / cg"
+!
shallowCopy
"redefined to return self - there is only one Smalltalk dictionary"
@@ -1364,9 +1451,6 @@
!Smalltalk class methodsFor:'debugging ST/X'!
compileTrace:aBoolean
- "dump genera
-
-compileTrace:aBoolean
"dump generated inline code (NOOP if VM was compiled without the trace-debug option)"
%{
extern char __compileTrace__;
@@ -1380,9 +1464,18 @@
!
debugBreakPoint
- "{ Pragma: +optSpacompileTrace:aBoolean
- "dump generated inline code (NOOP if VM was compiled without the trace-debug option)"
+ "{ Pragma: +optSpace }"
+
+ "call the dummy debug function, 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."
%{
+ __PATCHUPCONTEXTS(__context);
+ __debugBreakPoint__();
+%}.
+ ^ self
+!
exitWithCoreDump
"{ Pragma: +optSpace }"
@@ -1407,7 +1500,9 @@
__fatal0(__context, "fatalAbort");
/* NEVER RETURNS */
%}.
-
+ ^ self primitiveFailed
+
+!
fatalAbort:aMessage
"{ Pragma: +optSpace }"
@@ -1435,7 +1530,7 @@
! !
-!Smalltalk class methodsFor:'enumerat
+!Smalltalk class methodsFor:'enumerating'!
allBehaviorsDo:aBlock
"evaluate the argument, aBlock for all classes and metaclasses in the system"
@@ -1456,17 +1551,18 @@
Smalltalk allClassesDo:[:cls | |category|
category := cls category.
category notNil ifTrue:[
-
-
-allClassCategories
- "return a set of all class categories in the system"
-
- |allCategories|
-
- allCategories := Set new.
- Smalltalk allClassesDo:[:cls | |category|
- category := cls category.
- category notNi
+ allCategories add:category.
+ ].
+ ].
+
+ ^ allCategories.
+
+ "
+ Smalltalk allClassCategories
+ "
+
+ "Created: / 17.11.2001 / 12:13:09 / cg"
+!
allClassesAndMetaclassesDo:aBlock
"evaluate the argument, aBlock for all classes and metaclasses in the system."
@@ -1481,7 +1577,12 @@
already add:cls.
].
cls := cls class.
- (already includes:cls) ifFal
+ (already includes:cls) ifFalse:[
+ aBlock value:cls.
+ already add:cls.
+ ].
+ ].
+!
allClassesDo:aBlock
"evaluate the argument, aBlock for all classes in the system."
@@ -1500,16 +1601,17 @@
|coll|
coll := OrderedCollection new.
- self allClassesInCategory:aCategory do:[:aCl
-
-allClassesInCategory:aCategory
- "return a collection of for all classes in aCategory;
- The order of the classes is not defined."
-
- |coll|
-
- coll := OrderedCollection new.
-
+ self allClassesInCategory:aCategory do:[:aClass |
+ coll add:aClass
+ ].
+ ^ coll
+
+ "
+ Smalltalk allClassesInCategory:'Views-Basic'
+ "
+
+ "Modified: 25.4.1996 / 18:06:13 / cg"
+!
allClassesInCategory:aCategory do:aBlock
"evaluate the argument, aBlock for all classes in the aCategory;
@@ -1526,23 +1628,11 @@
]
"
- Smalltalk allClassentCR]
- "
-
- "Modified: / 17.11.2001 / 12:18:15 / cg"
-!
-
-allClassesInOrderDo:aBlock
- "evaluate the argument, aBlock for all classes in the system;
- Evaluation order is by inheritance: superclasses come first."
-
- |already|
-
- already := IdentitySet new.
- self allClassesDo:[:aClass |
- (already includes:aClass) ifFalse:[
- aClass allSuperclasses reverseDo:[:cls |
- (already includes:aClass) ifFalse:allClassesInCategory:aCategory inOrderDo:aBlock
+ Smalltalk allClassesInCategory:'Views-Basic' do:[:aClass | aClass name printCR]
+ "
+!
+
+allClassesInCategory:aCategory inOrderDo:aBlock
"evaluate the argument, aBlock for all classes in aCategory;
superclasses come first - then subclasses"
@@ -1562,8 +1652,9 @@
"
"Modified: / 17.11.2001 / 12:18:15 / cg"
-"
- allClassesInOrderDo:aBlock
+!
+
+allClassesInOrderDo:aBlock
"evaluate the argument, aBlock for all classes in the system;
Evaluation order is by inheritance: superclasses come first."
@@ -1586,7 +1677,30 @@
"
Smalltalk allClassesInOrderDo:[:aClass | aClass name printCR]
"
-
+!
+
+allKeysDo:aBlock
+ "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+
+ ^ self keysDo:aBlock
+!
+
+allMethodCategories
+ "return a set of all method categories in the system"
+
+ |allCategories|
+
+ allCategories := Set new.
+ Smalltalk allClassesDo:[:cls |
+ allCategories addAll:cls categories.
+ ].
+
+ ^ allCategories.
+
+ "
+ Smalltalk allMethodCategories
+ "
+!
associationsDo:aBlock
"evaluate the argument, aBlock for all key/value pairs
@@ -1612,9 +1726,6 @@
!
do:aBlock
- "evaluate the argument, aBlock for all values in the Small
-
-do:aBlock
"evaluate the argument, aBlock for all values in the Smalltalk dictionary"
|work|
@@ -1628,12 +1739,13 @@
]
!
-keysAndValuedo:aBlock
- "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
-
- |work|
-
-%{
+keysAndValuesDo:aBlock
+ "evaluate the two-arg block, aBlock for all keys and values"
+
+ self keysDo:[:aKey |
+ aBlock value:aKey value:(self at:aKey)
+ ]
+!
keysDo:aBlock
"evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
@@ -1649,11 +1761,17 @@
! !
!Smalltalk class methodsFor:'inspecting'!
-
keysDo:aBlock
- "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
- |work|
-
-%{
+
+inspectorClass
+ "{ Pragma: +optSpace }"
+
+ "redefined to launch a DictionaryInspector
+ (instead of the default Inspector)."
+
+ ^ DictionaryInspectorView
+! !
+
+!Smalltalk class methodsFor:'message control'!
silentLoading
"returns the Silentloading class variable."
@@ -1671,27 +1789,26 @@
|prev|
- pr
-
-silentLoading:aBoolean
- "{ Pragma: +optSpace }"
-
- "allows access to the SilesilentLoading:aBoolean
- "{ Pragma: +optSpace }"
-
- "allows access to the Silentloading 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."
-
- |prev|
-
prev := SilentLoading.
SilentLoading := aBoolean.
^ prev
! !
-!
+!Smalltalk class methodsFor:'misc accessing'!
+
+beHeadless:aBoolean
+ "set/clear the headlessOperation flag."
+
+ HeadlessOperation := aBoolean
+!
+
+standAloneApp:aBoolean
+ "set/clear the StandAlone flag."
+
+ StandAlone := aBoolean
+! !
+
+!Smalltalk class methodsFor:'misc stuff'!
addExitBlock:aBlock
"{ Pragma: +optSpace }"
@@ -1701,8 +1818,11 @@
cleanup in stand alone applications."
ExitBlocks isNil ifTrue:[
- ExitBlocks := OrderedColaddExitBlock:aBlock
- "{ Pragma: +optSpace }
+ ExitBlocks := OrderedCollection with:aBlock
+ ] ifFalse:[
+ ExitBlocks add:aBlock
+ ]
+!
addImageStartBlock:aBlock
"{ Pragma: +optSpace }"
@@ -1712,24 +1832,31 @@
These blocks will be executed after an image restart."
ImageStartBlocks isNil ifTrue:[
- ImageStartBlocks := OrderedCollection waddImageStartBlock:aBlock
- "{ Pragma: +optSpace }:46:53 / stefan"
-!
-
-exit
+ ImageStartBlocks := OrderedCollection with:aBlock
+ ] ifFalse:[
+ ImageStartBlocks add:aBlock
+ ]
+
+ "Created: 9.9.1996 / 16:48:20 / stefan"
+!
+
+addStartBlock:aBlock
"{ Pragma: +optSpace }"
- "finish the Smalltalk system"
-
- ObjectMemory changed:#aboutToExit. "/ for ST/X backward compatibility
- ObjectMemory changed:#aboutToQuit. "/ for ST-80 compatibility
- ExitBlocks notNil ifTrue:[
- ExitBlocks do:[:aBlock |
- aBlock value
- ]
- ].
- OperatingSystem eaddStartBlock:aBlock
- "{ Pragma: +optSpace }
+ "add a blocks to be executed 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.
+ Initial processes are usually started here (see smalltalk.rc / private.rc)."
+
+ StartBlocks isNil ifTrue:[
+ StartBlocks := OrderedCollection with:aBlock
+ ] ifFalse:[
+ StartBlocks add:aBlock
+ ]
+
+ "Created: 9.9.1996 / 16:46:53 / stefan"
+!
exit
"{ Pragma: +optSpace }"
@@ -1751,25 +1878,9 @@
"
! !
-!Smalltalk class methodsFor:'queries'!exit
- "{ Pragma: +optSpace }ed: / 23.2.2000 / 10:49:46 / cg"
-!
-
-allClassesAndMetaclasses
- "return an unordered collection of all classes with their metaclasses in the system."
-
- |classes|
-
- classes := IdentitySet new.
- self allClassesDo:[:eachClass |
- classes add:(eachClass theNonMetaclass).
- classes add:(eachClass theMetaclass).
- ].
- ^ classes
-!
-
-allClassesWithAllPrivateClasses
- "return an unordered colleallClasses
+!Smalltalk class methodsFor:'queries'!
+
+allClasses
"return an unordered collection of all classes in the system.
Only globally anchored classes are returned
(i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
@@ -1818,24 +1929,22 @@
"
"Modified: / 23.2.2000 / 10:49:46 / cg"
-sWithAllPrivateClasses
- "
-!
-
-cellAt:aName
- "{ Pragma: +optSpace }"
-
- "return the address of a global cell
- - used internally for compiler only"
-
-%{ /* NOCONTEXT */
- RETURN ( __GLOBAL_GETCELL(aName) );
-%}.
- ^ self primitiveFailed
-
-!
-
-classCategoryCompletion:aPartialCategory
allClassesWithAllPrivateClasses
+!
+
+allClassesAndMetaclasses
+ "return an unordered collection of all classes with their metaclasses in the system."
+
+ |classes|
+
+ classes := IdentitySet new.
+ self allClassesDo:[:eachClass |
+ classes add:(eachClass theNonMetaclass).
+ classes add:(eachClass theMetaclass).
+ ].
+ ^ classes
+!
+
+allClassesWithAllPrivateClasses
"return an unordered collection of all classes in the Smalltalk namespace.
Only globally anchored classes are returned
(i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
@@ -1856,37 +1965,38 @@
"
!
+cellAt:aName
+ "{ Pragma: +optSpace }"
+
+ "return the address of a global cell
+ - used internally for compiler only"
+
+%{ /* NOCONTEXT */
+ RETURN ( __GLOBAL_GETCELL(aName) );
+%}.
+ ^ self primitiveFailed
+
+!
+
+classCategoryCompletion:aPartialCategory
+ "given a partial class category name, return an array consisting of
+ 2 entries: 1st: the best (longest) match
+ 2nd: collection consisting of matching categories"
+
+ ^ DoWhatIMeanSupport classCategoryCompletion:aPartialCategory in:self
+
+ "
+ Smalltalk classCategoryCompletion:'Sys'
+ Smalltalk classCategoryCompletion:'System'
+ Smalltalk classCategoryCompletion:'System-BinaryStorage'
+ "
+!
+
classNamed:aString
"return the class with name aString, or nil if absent.
To get to the metaClass, append ' class' to the string.
To get a nameSpace or private class, prefix the name as required."
- |cclass
- ].
- ].
- ^ nil
-
- "
- Smalltalk classNamed:'Object'
- Smalltalk classNamed:'fooBar'
- Smalltalk classNamed:'true'
- Smalltalk classNamed:'Object class'
- Smalltalk classNamed:'Metaclass'
- Smalltalk classNamed:'Array'
- Smalltalk classNamed:'Array class'
- "
-
- "Created: 24.11.1995 / 17:30:22 / cg"
- "Modified: 24.11.1995 / 17:31:29 / cg"
- "Modified: 19.6.1996 / 14:22:21 / stefan"
-!
-
-classNames
- "return aclassNamed:aString
- "return the class with name aString, or nil if absent.
- 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|
"be careful, to not invent new symbols ..."
@@ -1934,27 +2044,27 @@
"Created: 24.11.1995 / 17:30:22 / cg"
"Modified: 24.11.1995 / 17:31:29 / cg"
"Modified: 19.6.1996 / 14:22:21 / stefan"
-tion:'*rray'
-
- Smalltalk classnameCompletion:'Arr cl'
- Smalltalk classnameCompletion:'*rray cl'
- "
-
- "Created: 24.11.1995 / 17:24:45 / cg"
- "Modified: 3.4.1997 / 18:25:01 / cg"
-!
-
-defaultNameSpace
- "return the default namespace, where new classes are installed,
- if NO special nameSpace handler is present"
-
- |p|
-
- (Project notNil and:[(p := Project current) notNil]) ifTrue:[
- ^ p defaultNameSpace
- ].
-
- ^classnameCompletion:aPartialClassName inEnvironment:anEnvironment
+!
+
+classNames
+ "return a collection of all classNames in the system"
+
+ ^ self allClasses collect:[:aClass | aClass name]
+
+ "
+ Smalltalk classNames
+ "
+!
+
+classnameCompletion:aPartialClassName
+ "given a partial classname, return an array consisting of
+ 2 entries: 1st: the best (longest) match
+ 2nd: collection consisting of matching names"
+
+ ^ DoWhatIMeanSupport classnameCompletion:aPartialClassName inEnvironment:self
+!
+
+classnameCompletion:aPartialClassName inEnvironment:anEnvironment
"given a partial classname, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
@@ -1973,17 +2083,25 @@
"Created: 24.11.1995 / 17:24:45 / cg"
"Modified: 3.4.1997 / 18:25:01 / cg"
-1.1995 / 17:24:45 / cg"
- "Modified: 3.4.1997 / 18:25:01 / cg"
-!
-
-globalnameCompletion:aPartialGlobalName
- "given a partial globalName, return an array consisting of
- 2 entries: 1st: the best (longest) match
- 2nd: collection consisting of matching names"
-
- <resource:#obsolete>
- self obsoleteMethodWarningglobalNameCompletion:aPartialGlobalName
+!
+
+defaultNameSpace
+ "return the default namespace, where new classes are installed,
+ if NO special nameSpace handler is present"
+
+ |p|
+
+ (Project notNil and:[(p := Project current) notNil]) ifTrue:[
+ ^ p defaultNameSpace
+ ].
+
+ ^ self
+
+ "Created: 19.12.1996 / 23:49:25 / cg"
+ "Modified: 2.1.1997 / 20:01:31 / cg"
+!
+
+globalNameCompletion:aPartialGlobalName
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
@@ -1999,7 +2117,9 @@
"Created: 24.11.1995 / 17:24:45 / cg"
"Modified: 3.4.1997 / 18:25:01 / cg"
-etionglobalnameCompletion:aPartialGlobalName
+!
+
+globalnameCompletion:aPartialGlobalName
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
@@ -2017,7 +2137,32 @@
"Created: 24.11.1995 / 17:24:45 / cg"
"Modified: 3.4.1997 / 18:25:01 / cg"
-
+!
+
+hasNamespaces
+ "can be redefined by dummy namespaces/environments, to suppress
+ the namespace display in a browser (PocketSmalltalk)"
+
+ ^ true
+!
+
+includes:something
+ "this should come from Collection.
+ will change the inheritance - Smalltalk is actually a collection"
+
+ self do:[:element | element = something ifTrue:[^ true]].
+ ^ false
+!
+
+isNameSpace
+ ^ true
+
+ "Created: 11.10.1996 / 18:10:43 / cg"
+!
+
+isTopLevelNameSpace
+ ^ true
+!
isTopLevelNamespace
"obsolete - use isTopLevelNameSpace"
@@ -2035,12 +2180,14 @@
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching protocols"
- ^ DoWhatIMeanSuppo
-
-methodProtocolCompletion:aPartialProtocolName
- "given a partial method protocol name, return an array consisting of
- 2 entries: 1st: the best (longest) match
- 2nd: collection c
+ ^ DoWhatIMeanSupport methodProtocolCompletion:aPartialProtocolName in:self
+
+ "
+ Smalltalk methodProtocolCompletion:'doc'
+ Smalltalk methodProtocolCompletion:'docu'
+ Smalltalk methodProtocolCompletion:'documenta'
+ "
+!
numberOfGlobals
"return the number of global variables in the system"
@@ -2060,15 +2207,13 @@
self keysAndValuesDo:[:key :val |
aCollection do:[:anObject |
(key == anObject) ifTrue:[^ true].
- (val == anObject ) if
-
-referencesAny:aCollection
- "redefined, since the references are only kept in the VM's symbol table"
-
- self keysAndValuesDo:[:key :val |
- aCollection do:[:anObject |
- (key == anObject) ifTrue:[^ true].
-
+ (val == anObject ) ifTrue:[^ true].
+ ]
+ ].
+ ^ super referencesAny:aCollection
+
+ "Created: / 2.2.1998 / 16:01:20 / cg"
+!
referencesDerivedInstanceOf:aClass
"redefined, since the references are only kept in the VM's symbol table"
@@ -2081,9 +2226,6 @@
!
referencesInstanceOf:aClass
- "redefined, s
-
-referencesInstanceOf:aClass
"redefined, since the references are only kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
@@ -2093,7 +2235,6 @@
^ super referencesInstanceOf:aClass
!
-
referencesObject:anObject
"redefined, since the references are only kept in the VM's symbol table"
@@ -2103,17 +2244,10 @@
].
^ super referencesObject:anObject
- "Ml.
-
- "Modified: / 9.7.1999 / 01:18:07 / cg"
-!
-
-selectorCompletion:aPartialSymbolName
- "given a partial selector, return an array consisting of
- 2 entries: 1st: the longest match
- 2nd: collection consisting of matching implemented selectors"
-
- ^ DoWhatIMeanSupport selectoresolveName:nameIn inClass:aClass
+ "Modified: / 3.2.1998 / 14:22:46 / cg"
+!
+
+resolveName:nameIn inClass:aClass
"resolve aName as if compiled within aClass;
i.e. if it has a private class with this name, return it;
if aName is known within the classes namespace, return that.
@@ -2149,7 +2283,30 @@
^ self at:sym ifAbsent:nil.
"Modified: / 9.7.1999 / 01:18:07 / cg"
- 7.6.1996 / 08:44:33 / stefan"
+!
+
+selectorCompletion:aPartialSymbolName
+ "given a partial selector, return an array consisting of
+ 2 entries: 1st: the longest match
+ 2nd: collection consisting of matching implemented selectors"
+
+ ^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:self
+!
+
+selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
+ "given a partial selector, return an array consisting of
+ 2 entries: 1st: the longest match
+ 2nd: collection consisting of matching implemented selectors"
+
+ ^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
+
+ "
+ Smalltalk selectorCompletion:'at:p'
+ Smalltalk selectorCompletion:'nextP'
+ Smalltalk selectorCompletion:'nextp'
+ "
+
+ "Modified: / 7.6.1996 / 08:44:33 / stefan"
"Modified: / 14.6.1998 / 15:54:03 / cg"
! !
@@ -2167,22 +2324,17 @@
^ self versionString
"
- Smalltalk dialectReleaseVersionselectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
- "given a partial selector, return an array consisting of
- 2 entries: 1st: the longest match
- 2nd: collection consisting of matching implemented selectors"
-
- ^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
-
- "
- Smalltalk selectorCompletion:'at:p'
- Smalltalk selectorCompletion:'nextP'
- Smalltalk selectorCompletion:'nextp'
- "
-
- "Modified: / 7.6.1996 / 08:44:33 / stefan"
- "Modified: / 14.6.1998 / 15:54:03 / cg"
-
+ Smalltalk dialectReleaseVersion
+ "
+!
+
+isDolphinSmalltalk
+ "return false here - this may be useful to write portable
+ applications - add #isDolphinSmalltalk to your dolphin,
+ returning true there."
+
+ ^ false
+!
isSmalltalkMT
"return false here - this may be useful to write portable
@@ -2201,9 +2353,6 @@
!
isSmalltalkX
- "return true here - this m
-
-isSmalltalkX
"return true here - this may be useful to write portable
applications - add #isSmalltalkX to your other smalltalks,
returning false there."
@@ -2217,7 +2366,7 @@
returning true there."
^ false
-
+!
isVisualAge
"return false here - this may be useful to write portable
@@ -2230,7 +2379,12 @@
isVisualWorks
"return false here - this may be useful to write portable
applications - add #isVisualWorks to your visualWorks,
- returning true there.
+ returning true there."
+
+ ^ false
+! !
+
+!Smalltalk class methodsFor:'startup'!
displayInitializationDone
"inform the restart, that the display has been initialized"
@@ -2245,19 +2399,6 @@
|process imageName thisIsARestart|
imageName := ObjectMemory imageName.
- thisdisplayInitializationDone
- "inform the restart, that the display has been initialized"
-
- CallbackSignal raiseRequest.
-!
-
-mainStartup:graphicalMode
- "common start/restart action, if there is a Display, initialize it
- and start dispatching; otherwise go into a read-eval-print loop."
-
- |process imageName thisIsARestart|
-
- imageName := ObjectMemory imageName.
thisIsARestart := imageName notNil.
"
@@ -2859,7 +3000,21 @@
"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."
+
+ ^ 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"
+
+ ^ HeadlessOperation
+!
isStandAloneApp
"return true, if this is a standAlone application
@@ -2876,14 +3031,11 @@
startupClass
"return the class, that will get the start message when smalltalk
- starts aisStandAloneApp
- "return true, if this is a standAlone application
- (in contrast to a full smalltalk system)."
-
- ^ StandAlone
-!
-
-
+ 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 }"
@@ -2892,8 +3044,16 @@
starts. Setting those before saving a snapshot, will make the saved
image come up executing your application (instead of the normal mainloop)"
- StartupClstartupClass:aClass selector:aSymbol arguments:anArrayOrNil
- "{ Pragma: +optSpace }
+ StartupClass := aClass.
+ StartupSelector := aSymbol.
+ StartupArguments := anArrayOrNil
+!
+
+startupSelector
+ "return the selector, that will be sent to StartupClass"
+
+ ^ StartupSelector
+!
wasStartedFromImage
^ ImageRestartTime notNil
@@ -2923,7 +3083,12 @@
Language := aLanguageSymbol.
self changed:#Language
-
+ "
+ Smalltalk language:#de
+ "
+
+ "Modified: 26.4.1996 / 17:13:34 / cg"
+!
languageTerritory
"return the language territory setting"
@@ -2951,9 +3116,6 @@
!
setLanguage:aLanguageSymbol
- "set the language
-
-setLanguage:aLanguageSymbol
"set the language withotu change notifications"
Language := aLanguageSymbol.
@@ -2966,16 +3128,6 @@
"compress the sources file, and 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 othe new source file,
- "
- fileName := (ObjectMemory nameForSources).
- 'src.tmp' asFilename renameTo:fileName.
-
- "good - now go over all changed methods, and ccompressSources
- "{ Pragma: +optSpace }"
-
- "compress the sources file, and 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,
and a mix of in-memory strings and one-for-all sourceFile for
@@ -3039,7 +3191,9 @@
"
"Modified: 16.1.1997 / 01:25:58 / cg"
- generateSingleSourceFile
+!
+
+generateSingleSourceFile
"{ Pragma: +optSpace }"
"generate the sources file, and remove all method source strings
@@ -3093,26 +3247,23 @@
"Modified: 16.1.1997 / 01:25:58 / cg"
"Created: 17.10.1997 / 13:00:56 / cg"
-ackage change
- package ~= cls package ifTrue:[
- cls package:package asSymbol.
- ].
- cat ~= cls category ifTrue:[
- cls category:cat.
- ].
- ].
-
- "Created: / 5.11.1998 / 15:10:25 / cg"
-!
-
-installAutoloadedClasses
- "read the standard abbreviation file; install all classes found there as
- autoloaded. This takes some time ..."
-
- |dirsConsulted p|
-
- "/ new scheme: look for a directory called 'packages'
- "/ ainstallAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:numClassInstVarsOrNil
+!
+
+installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil
+ "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"
+
+ 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
@@ -3151,7 +3302,9 @@
].
"Created: / 5.11.1998 / 15:10:25 / cg"
-dedClinstallAutoloadedClasses
+!
+
+installAutoloadedClasses
"read the standard abbreviation file; install all classes found there as
autoloaded. This takes some time ..."
@@ -3189,7 +3342,9 @@
"Created: / 14.2.1997 / 17:32:57 / cg"
"Modified: / 13.12.1999 / 11:56:50 / cg"
- on:FinstallAutoloadedClassesFrom:anAbbrevFilePath
+!
+
+installAutoloadedClassesFrom:anAbbrevFilePath
"read the given abbreviation file; install all classes found there as
autoloaded. This takes some time ..."
@@ -3215,7 +3370,9 @@
"
"Modified: / 5.11.1998 / 15:10:51 / cg"
-y:catinstallAutoloadedClassesFromStream:anAbbrevFileStream
+!
+
+installAutoloadedClassesFromStream:anAbbrevFileStream
"read the given abbreviation file;
install all classes found there as autoloaded, and also update the
abbreviation (className-to-fileName mapping) table.
@@ -3281,7 +3438,14 @@
]
]
]
-
+!
+
+loadBinaries
+ "return true, if binaries should be loaded into the system,
+ false if this should be suppressed. The default is false (for now)."
+
+ ^ LoadBinaries
+!
loadBinaries:aBoolean
"{ Pragma: +optSpace }"
@@ -3289,8 +3453,16 @@
"turn on/off loading of binary objects"
aBoolean ifTrue:[
- (ObjectFileLoader notNil and:[ObjectFileLoader canLoloadBinaries:aBoolean
- "{ Pragma: +optSpace }
+ (ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
+ LoadBinaries := true.
+ ^ self
+ ].
+ 'Smalltalk [info]: this system does not support binary loading' infoPrintCR.
+ ].
+ LoadBinaries := false
+
+ "Modified: 10.1.1997 / 15:11:00 / cg"
+!
logDoits
"return true if doits should go into the changes file
@@ -3309,7 +3481,38 @@
logDoits:aBoolean
"{ Pragma: +optSpace }"
- "turn on/off loggin7 / 01:25:58 / cg"
+ "turn on/off logging of doits in the changes file.
+ By default, this is off, since it can blow up the
+ changes file enormously ...
+ "
+
+ LogDoits := aBoolean
+
+!
+
+makeBytecodeMethods
+ "{ Pragma: +optSpace }"
+
+ "walk over all methods and make each a bytecode method
+ iff it does not contain primitive C code.
+ Experimental and not yet used."
+
+ Method allSubInstancesDo:[:aMethod |
+ |newMethod|
+
+ aMethod hasPrimitiveCode ifFalse:[
+ newMethod := aMethod asByteCodeMethod.
+ newMethod ~~ aMethod ifTrue:[
+ aMethod becomeSameAs:newMethod
+ ]
+ ].
+ ].
+
+ "
+ Smalltalk makeBytecodeMethods
+ "
+
+ "Modified: 16.1.1997 / 01:25:58 / cg"
"Created: 17.10.1997 / 13:52:19 / cg"
!
@@ -3318,38 +3521,6 @@
and install autoloaded classes.
If a file called NOAUTOLOAD is found, no classes there and below are installed as autoloaded
(however, the directories are searched for packages)
- If a file called NmakeBytecodeMethods
- "{ Pragma: +optSpace }ruct:aFilename.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath.
- ]
- ]
- ].
- ].
-
- "
- Smalltalk installAutoloadedClasses
- "
-!
-
-replaceReferencesTo:anObject with:newRef
- |toAdd|
-
- toAdd := OrderedCollection new.
- self keysAndValuesDo:[:key :val |
- (key == anObject) ifTrue:[
- self shouldImplement.
- ].
- recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted maxLevels: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
- (however, the directories are searched for packages)
If a file called NOPACKAGES is found, no further searching is done in that directory or below."
|abbrevStream dir noAutoloadHere dirName pkgName directoryContents|
@@ -3449,18 +3620,26 @@
"
Smalltalk installAutoloadedClasses
"
-reated
- like window destroy from the windowManager."
-
- SaveEmergencyImage := aBoolean
-
- "Modified: / 24.10.1997 / 18:22:26 / cg"
-!
-
-systemOrganization
- "for partial ST80 compatibility;
- In ST80, Smalltalk organization returns a systemOrganizer, which
- keeps track of class-categories, while all classessaveEmergencyImage:aBoolean
+!
+
+replaceReferencesTo:anObject with:newRef
+ |toAdd|
+
+ toAdd := OrderedCollection new.
+ self keysAndValuesDo:[:key :val |
+ (key == anObject) ifTrue:[
+ self shouldImplement.
+ ].
+ (val == anObject ) ifTrue:[
+ toAdd add:(key -> newRef)
+ ].
+ ].
+ toAdd do:[:each |
+ self at:(each key) put:(each value)
+ ].
+!
+
+saveEmergencyImage:aBoolean
"set/clear the flag which controls if ST/X should save an
emergency image in case of a broken display connection.
The default is true.
@@ -3474,7 +3653,9 @@
SaveEmergencyImage := aBoolean
"Modified: / 24.10.1997 / 18:22:26 / cg"
-on insystemOrganization
+!
+
+systemOrganization
"for partial ST80 compatibility;
In ST80, Smalltalk organization returns a systemOrganizer, which
keeps track of class-categories, while all classes return a classOrganizer
@@ -3488,9 +3669,10 @@
"Created: / 20.6.1998 / 12:24:02 / cg"
"Modified: / 20.6.1998 / 12:41:34 / cg"
-cTacToe.cls'
- Smalltalk fileIn:'binary/TicTacToe.so'
- "
+! !
+
+!Smalltalk class methodsFor:'system management-fileIn'!
+
fileIn:aFileName
"read in the named file - look for it in some standard places;
return true if ok, false if failed.
@@ -3509,19 +3691,22 @@
"
"Created: 28.10.1995 / 17:06:28 / cg"
-eIn:aFileName lazy:lazy silent:nil logged:false
-
- "
- Smalltalk fileIn:'source/TicTacToe.st' lazy:true
- "
-
- "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;
- return true if ok, false if failed.
- If lazy is true, no cofileIn:aFileName lazy:lazy
+!
+
+fileIn:aFileName inPackage:aPackageID
+ "read in the named file in a packages directory."
+
+ |dir|
+
+ dir := self getPackageDirectoryForPackage:aPackageID.
+ dir isNil ifTrue:[^ false].
+
+ dir := dir asFilename.
+ ^ (self fileIn:(dir construct:aFileName))
+ or:[ self fileIn:((dir construct:'source') construct:aFileName) ]
+!
+
+fileIn:aFileName lazy:lazy
"read in the 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
@@ -3537,7 +3722,9 @@
"
"Created: 28.10.1995 / 17:06:36 / cg"
- If fileIn:aFileName lazy:lazy silent:silent
+!
+
+fileIn:aFileName lazy:lazy silent:silent
"read in the 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
@@ -3551,7 +3738,9 @@
^ self fileIn:aFileName lazy:lazy silent:silent logged:false
"Created: 28.10.1995 / 17:06:41 / cg"
-chPatfileIn:aFileNameOrString lazy:lazy silent:silent logged:logged
+!
+
+fileIn:aFileNameOrString lazy:lazy silent:silent logged:logged
"read in the 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
@@ -3634,7 +3823,19 @@
"
"Modified: / 16.2.1999 / 10:03:26 / cg"
-
+!
+
+fileIn:aFileName logged:logged
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ The argument logged controls, if the changefile is to be updated."
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:logged
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' logged:false
+ "
+!
fileInChanges
"read in the last changes file - bringing the system to the state it
@@ -3646,7 +3847,12 @@
"
do NOT update the changes file now ...
"
-
+ self fileIn:ChangeFileName logged:false
+
+ "
+ Smalltalk fileInChanges
+ "
+!
fileInClass:aClassName
"find a source/object file for aClassName and -if found - load it.
@@ -3661,23 +3867,10 @@
lazy:false
silent:nil
- oader loadClass:aClassName fromObjectFile:path) notNil.
- ok ifTrue:[
- SilentLoading ifFalse:[
- Transcript show:' loaded ' , aClassName , ' from ' ; showCR:aFileName.
- ]
- ].
- ^ ok
-
- "
- Smalltalk fileInClass:'AbstractPath' fromObject:'../../goodies/Paths/AbstrPath.so'
- Smalltalk fileInClass:'ClockView' fromObject:'../../libwidg3/libwidg3.so'
- "
-
- "Modified: 10.9.1996 / 20:43:52 / cg"
-!
-
-fileInClass:aClassNfileInClass:aClassName fromObject:aFileName
+ "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
- look for it in some standard places.
Only install the named class from this object file.
@@ -3705,7 +3898,23 @@
"
"Modified: 10.9.1996 / 20:43:52 / cg"
-
+!
+
+fileInClass:aClassName initialize:doInit
+ "find a source/object 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."
+
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:false
+ silent:nil
+
+ "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.
@@ -3720,22 +3929,9 @@
lazy:loadLazy
silent:nil
- "Modified: / 9ed lazyly. beSilent tells if the compiler
- should not send notes to the transcript; it can be true, false or nil, where
- nil uses the value from SilentLoading."
-
- ^ self
- fileInClass:aClassName
- package:nil
- initialize:doInit
- lazy:loadLazy
- silent:beSilent
-
- "Modified: / 9.1.1998 / 14:42:28 / cg"
-!
-
-fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
- "find a source/object file for aClassName and -if found - load it.
+ "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.
Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
@@ -3754,7 +3950,9 @@
silent:beSilent
"Modified: / 9.1.1998 / 14:42:28 / cg"
- fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
+!
+
+fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
"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
@@ -4087,7 +4285,9 @@
"Created: / 9.1.1998 / 14:40:32 / cg"
"Modified: / 5.6.1999 / 14:53:01 / cg"
-lassLfileInClassLibrary:aClassLibraryName
+!
+
+fileInClassLibrary:aClassLibraryName
"find an object file 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.
@@ -4116,7 +4316,9 @@
"
"Modified: 8.1.1997 / 17:58:56 / cg"
-yBrowfileInClassLibrary:aClassLibraryName inPackage:packageID
+!
+
+fileInClassLibrary:aClassLibraryName inPackage:packageID
"find an object file 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.
@@ -4145,13 +4347,13 @@
"
"Modified: 8.1.1997 / 17:58:56 / cg"
-st' asFilename readStream) lazy:true silent:true
- "
-
- "Modified: 5.11.1996 / 20:03:35 / cg"
-!
-
-isClafileInStream:streamArg lazy:lazy silent:silent logged:logged addPath:morePath
+!
+
+fileInStream:streamArg
+ ^ self fileInStream:streamArg lazy:nil silent:nil logged:false addPath:nil
+!
+
+fileInStream:streamArg lazy:lazy silent:silent logged:logged addPath:morePath
"read sourceCode from aStream;
return true if ok, false if failed.
If lazy is true, no code is generated for methods, instead stubs
@@ -4215,24 +4417,30 @@
"
"Modified: 5.11.1996 / 20:03:35 / cg"
-nClassLibrary:name
-
- "
- Smalltalk loadClassLibraryIfAbsent:'libbasic'
- Smalltalk loadClassLibraryIfAbsent:'libwidg3'
- "
-
- "Modified: 31.10.1996 / 16:57:24 / cg"
-!
-
-secureFileIn:aFileName
- "read in the named file, looking for it at standard places.
- Catch any error during fileIn. Return true if ok, false if failed"
-
- |retVal|
-
- retVal := false.
- (SignalSet with:AbortOperationloadClassLibraryIfAbsent:name
+!
+
+isClassLibraryLoaded:name
+ "return true, if a particular class library is already loaded"
+
+ ObjectMemory
+ binaryModuleInfo
+ do:[:entry |
+ entry type == #classLibrary ifTrue:[
+ entry libraryName = name ifTrue:[
+ ^ true "/ already loaded
+ ]
+ ].
+ ].
+
+ ^ false
+
+ "
+ Smalltalk isClassLibraryLoaded:'libbasic'
+ Smalltalk isClassLibraryLoaded:'libwidg3'
+ "
+!
+
+loadClassLibraryIfAbsent:name
"dynamically load a classLibrary, if not already loaded
and the system supports dynamic loading.
Return true, if the library is loaded, false if not.
@@ -4250,7 +4458,20 @@
"
"Modified: 31.10.1996 / 16:57:24 / cg"
-
+!
+
+secureFileIn:aFileName
+ "read in the named file, looking for it at standard places.
+ Catch any error during fileIn. Return true if ok, false if failed"
+
+ |retVal|
+
+ retVal := false.
+ (SignalSet with:AbortOperationRequest with:TerminateProcessRequest)
+ handle:[:ex | ex return ]
+ do:[ retVal := self fileIn:aFileName ].
+ ^ retVal
+!
silentFileIn:aFilename
"same as fileIn:, but do not output 'compiled...'-messages on Transcript.
@@ -4268,8 +4489,6 @@
!Smalltalk class methodsFor:'system management-files'!
-bitmapFileStreamFor:aF
-
bitmapFileStreamFor:aFileName
"search aFileName in some standard places;
return a readonly fileStream or nil if not found.
@@ -4278,7 +4497,12 @@
|aString|
- aString := self getBitmapFileNa
+ aString := self getBitmapFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
+ ].
+ ^ nil
+!
bitmapFromFileNamed:aFileName forClass:aClass
"search aFileName in some standard places:
@@ -4293,8 +4517,6 @@
"
!
-bitmapFromFileNamed:aFileName inPac
-
bitmapFromFileNamed:aFileName inPackage:aPackage
"search aFileName in some standard places:
first in the redefinable bitmaps path,
@@ -4305,23 +4527,11 @@
"
Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
- sNameForFile:'DrawObj.st'
- Smalltalk classNameForFile:'ArrColl.st'
- Smalltalk classNameForFile:'ArrColl.chg'
- "
-
- "Modified: 11.12.1995 / 14:51:10 / cg"
-!
-
-constructPathFor:aDirectoryName
- "search for aDirectory in SystemPath;
- return a collection of pathes which include that directory."
-
- ^ self realSystemPath select:[:dirName |
- |fullPath|
-
- fullPath := dirName asFilename construct:aDirectoryName.
- "classNameForFile:aFileName
+ Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ "
+!
+
+classNameForFile:aFileName
"return the className which corresponds to an abbreviated fileName,
or nil if no special translation applies. The given filename arg may
include a '.st' suffix (but no other)."
@@ -4343,7 +4553,20 @@
"
"Modified: 11.12.1995 / 14:51:10 / cg"
-
+!
+
+constructPathFor:aDirectoryName
+ "search for aDirectory in SystemPath;
+ return a collection of pathes which include that directory."
+
+ ^ self realSystemPath select:[:dirName |
+ |fullPath|
+
+ fullPath := dirName asFilename construct:aDirectoryName.
+ "/ fullPath exists and:[fullPath isDirectory and:[fullPath isReadable]]
+ fullPath isDirectory and:[fullPath isReadable]
+ ].
+!
fileInFileStreamFor:aFileName
"search aFileName in some standard places;
@@ -4359,13 +4582,7 @@
^ nil
!
-fileNameForClass:aClassOrClassNam Smalltalk fileNameForClass:#Complex
- Smalltalk fileNameForClass:'SmallInteger'
- Smalltalk fileNameForClass:'UnixOperatingSystem'
- Smalltalk fileNameForClass:'Launcher'
- Smalltalk fileNameForClass:'SomeUnknownClass'
- Smalltalk fileNameForClass:OSI::FTAMOperation
- Smalltalk fileNameForClass:'OSI::fileNameForClass:aClassOrClassName
+fileNameForClass:aClassOrClassName
"return a filename for aClassOrClassName"
|cls nm1 nm2|
@@ -4407,7 +4624,38 @@
"
"Modified: / 5.11.2001 / 16:49:17 / cg"
-:= nil
+!
+
+filenameAbbreviations
+ "return a dictionary containing the classname-to-filename
+ mappings. (needed for sys5.3 users, where filenames are limited
+ to 14 chars)"
+
+ CachedAbbreviations isNil ifTrue:[
+ self readAbbreviations
+ ].
+ ^ CachedAbbreviations
+
+ "flush with:
+
+ CachedAbbreviations := nil
+ "
+ "
+ Smalltalk filenameAbbreviations
+ "
+!
+
+flushPathCaches
+ "{ Pragma: +optSpace }"
+
+ "forget pathCaches - these are 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
+ (for example, if you created a private resource directory)"
+
+ RealSystemPath := ResourcePath := SourcePath :=
+ BitmapPath := BinaryPath := FileInPath := nil
"
Smalltalk flushPathCaches
@@ -4423,18 +4671,6 @@
BinaryPath := self constructPathFor:BinaryDirName
].
- ^ self searchPath:BinaryPath for:aflushPathCaches
- "{ Pragma: +optSpace }
-
-getBinaryFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'binary' in SystemPath);
- return the absolute filename or nil if none is found."
-
- BinaryPath isNil ifTrue:[
- BinaryPath := self constructPathFor:BinaryDirName
- ].
-
^ self searchPath:BinaryPath for:aFileName in:BinaryDirName
"Modified: 18.7.1996 / 15:53:49 / cg"
@@ -4442,24 +4678,6 @@
getBitmapFileName:aFileName
"search aFileName in some standard places
- (subdirectories named 'bi realSystemPath for:aFileName in:nil
- ].
- ^ f
-
- "
- Smalltalk getBitmapFileName:'SBrowser.xbm'
- "
-
- "Modified: 18.7.1996 / 15:53:55 / cg"
-!
-
-getFileInFileName:aFileName
- "search aFileName in some standard places
- (subdirectories named 'fileIn' in SystemPath);
- return the absolute filename or nil if none is found."
-
- FileInPath isNil ifTrugetBitmapFileName:aFileName
- "search aFileName in some standard places
(subdirectories named 'bitmaps' in SystemPath);
return the absolute filename or nil if none is found."
@@ -4482,21 +4700,23 @@
"
"Modified: 18.7.1996 / 15:53:55 / cg"
-1.
- packageDir := '../../' , packageDir.
- packageDir := packageDir asFilename.
- (packageDir exists and:[packageDir isDirectory]) ifTrue:[^ packageDir].
- ].
- ^ nil
-
- "
- Smalltalk getPackageDirectoryForPackage:(Array package)
- Smalltalk getPackageDirectoryForPackage:'stx:goodies/bitmaps'
- Smalltalk getPackageDirectoryForPackage:'stx:libview'
- "
-!
-
-getPackgetPackageDirectoryForPackage:aPackageID
+!
+
+getFileInFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'fileIn' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ FileInPath isNil ifTrue:[
+ FileInPath := self constructPathFor:FileInDirName
+ ].
+
+ ^ self searchPath:FileInPath for:aFileName in:FileInDirName
+
+ "Modified: 18.7.1996 / 15:53:59 / cg"
+!
+
+getPackageDirectoryForPackage:aPackageID
"search for a particular package; return its directory, or nil"
|packageDir|
@@ -4523,7 +4743,9 @@
Smalltalk getPackageDirectoryForPackage:'stx:goodies/bitmaps'
Smalltalk getPackageDirectoryForPackage:'stx:libview'
"
-:'stxgetPackageFileName:aFileName
+!
+
+getPackageFileName:aFileName
"search aFileName in some standard places
(packagePath and subdirectories named 'packages' in SystemPath);
return the absolute filename or nil if none is found."
@@ -4556,7 +4778,9 @@
Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
Smalltalk getPackageFileName:'stx/libview/source.zip'
"
-earchgetResourceFileName:aFileName
+!
+
+getResourceFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'resource' in SystemPath);
return the absolute filename or nil if none is found."
@@ -4580,25 +4804,27 @@
"
"Modified: 18.7.1996 / 15:54:03 / cg"
-ilename construct:'styles') construct:aFileName.
- f exists ifTrue:[
- ^ f pathName
- ].
- ].
- ].
- ^ nil
-
- "
- Smalltalk getResourceFileName:'SystemBrowser.rs' forPackage:'stx:libtool'
- Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'
- "
-!
-
-getSourceFileName:aFileName
+!
+
+getResourceFileName:aFileName forClass:aClassOrNil
"search aFileName in some standard places
- (subdirectories named 'source' in SystemPath);
- return the absolute filename or nil if none is found.
- This is ugetResourceFileName:aFileName forPackage:aPackageIDOrNil
+ (subdirectories named 'resource' in SystemPath);
+ and in aClasses package directory.
+ Return the absolute filename or nil if none is found."
+
+ |pkgOrNil|
+
+ aClassOrNil notNil ifTrue:[
+ pkgOrNil := aClassOrNil package.
+ ].
+ ^ self getResourceFileName:aFileName forPackage:pkgOrNil.
+
+ "
+ Smalltalk getResourceFileName:'SystemBrowser.rs' forClass:SystemBrowser
+ "
+!
+
+getResourceFileName:aFileName forPackage:aPackageIDOrNil
"search aFileName in some standard places
(subdirectories named 'resource' in SystemPath);
and in a packages directory.
@@ -4645,7 +4871,9 @@
Smalltalk getResourceFileName:'SystemBrowser.rs' forPackage:'stx:libtool'
Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'
"
-SourcgetSourceFileName:aFileName
+!
+
+getSourceFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'source' in SystemPath);
return the absolute filename or nil if none is found.
@@ -4674,7 +4902,9 @@
"
"Modified: 18.7.1996 / 15:54:07 / cg"
-itmapgetSystemFileName:aFileNameOrString
+!
+
+getSystemFileName:aFileNameOrString
"search aFileNameOrString in some standard places;
return the absolute filename or nil if none is found.
see comment in Smalltalk>>initSystemPath.
@@ -4718,9 +4948,9 @@
"
"Modified: / 6.5.1999 / 10:40:37 / cg"
-
-!
-
imageFromFileNamed:aFileName forClass:aClass
+!
+
+imageFromFileNamed:aFileName forClass:aClass
"search aFileName in some standard places:
first in the redefinable bitmaps path, then in the classes
own package directory if existing.
@@ -4754,8 +4984,9 @@
"
Smalltalk imageFromFileNamed:'SmalltalkX.xbm' forClass:View
"
-
- imageFromFileNamed:aFileName inPackage:aPackage
+!
+
+imageFromFileNamed:aFileName inPackage:aPackage
"search aFileName in some standard places:
first in the redefinable bitmaps path, then in the
package directory if existing.
@@ -4787,8 +5018,9 @@
Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
"
-.
- libraryFileNameOfClass:aClassOrClassName
+!
+
+libraryFileNameOfClass:aClassOrClassName
"for a given class, return the name of a classLibrary which contains
binary code for it.
Read the libinfo file 'liblist.stc' (which is created during the compilation process)
@@ -4845,7 +5077,22 @@
"
"Modified: 6.11.1995 / 15:41:39 / cg"
-
+!
+
+packagePath
+ "return a collection of additional directorynames, where smalltalk
+ looks for package directories.
+ Notice, that directories named 'packages' under the systemPath are
+ always consulted - even if not in the packagePath"
+
+ ^ PackagePath
+
+ "
+ Smalltalk packagePath
+ Smalltalk packagePath addLast:'/opt/smalltalk'
+ Smalltalk packagePath addFirst:'/usr/local/otherPackages'
+ "
+!
packagePath:aPath
"set the packagePath;
@@ -4858,7 +5105,8 @@
"
Smalltalk packagePath:#( '.' '/opt/stx' '/opt/smalltalk' '/usr/local/otherPackages')
-
+ "
+!
projectDirectoryForClass:aClass
"given a class, return the path to its package directory;
@@ -4878,19 +5126,6 @@
!
projectDirectoryForPackage:aPackage
- "given a packageID, retur: with:$/).
- ].
- ^ prjDir
-
- "
- Smalltalk projectDirectoryForPackage:'stx:libbasic'
- Smalltalk projectDirectoryForPackage:'exept:smartcard'
- "
-!
-
-readAbbreviations
- "read classname to filename mappings from include/abbrev.stc.
- sigh - all for those poor sys5.3 or MSDOS people with short filenames ..projectDirectoryForPackage:aPackage
"given a packageID, return the path to its package directory;
nil if not found."
@@ -4911,7 +5146,9 @@
Smalltalk projectDirectoryForPackage:'stx:libbasic'
Smalltalk projectDirectoryForPackage:'exept:smartcard'
"
-.stc'readAbbreviations
+!
+
+readAbbreviations
"read classname to filename mappings from include/abbrev.stc.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
@@ -4965,7 +5202,9 @@
"
"Modified: / 10.12.1999 / 17:48:53 / cg"
- readAbbreviationsFromStream:aStream
+!
+
+readAbbreviationsFromStream:aStream
"read classname to filename mappings from aStream.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
@@ -5005,7 +5244,9 @@
].
"Modified: / 13.12.1999 / 11:54:17 / cg"
-alSysrealSystemPath
+!
+
+realSystemPath
"return the realSystemPath - thats the directorynames from
SystemPath which exist and are readable"
@@ -5049,14 +5290,12 @@
].
].
^ RealSystemPath
-s:maxLevels-1
- ]
- ].
- ].
-!
-
-resourceFileStreamFor:aFileName
- "search aFileName in some standard places;
+!
+
+recursiveReadAllAbbreviationsFrom:aDirectory
+ self recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:15
+!
+
recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:maxLevels
"read all abbreviations from and under aDirectory."
@@ -5099,32 +5338,32 @@
]
].
].
-
+!
+
+resourceFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ 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
package-resource directory.
Return a readonly fileStream or nil if not found.
- Searches in subdirectories named 'resource' in) construct:aFileName.
- ] ifFalse:[
- realName := dir construct:aFileName.
- ].
- (realName isReadable) ifTrue:[
- ^ realName name
- ]
- ].
- ].
-
- ^ nil.
-
- "Modified: / 29.4.1999 / 15:06:43 / cg"
-!
-
-setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
- |classNameSymbol oldAbbrev cls abbrevs|
-
- CachedAbbreviations isNil ifTrue:[
- CachedAbbreviations := IdentityDicsearchPath:aPath for:aFileName in:aDirName
+ Searches in subdirectories named 'resource' in SystemPath"
+
+ |aString|
+
+ aString := self getResourceFileName:aFileName forClass:aClassOrNil.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
+ ].
+ ^ nil
+!
+
+searchPath:aPath for:aFileName in:aDirName
"search aPath for a subdirectory named aDirectory with a file
named aFileName"
@@ -5157,7 +5396,9 @@
^ nil.
"Modified: / 29.4.1999 / 15:06:43 / cg"
- setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
+!
+
+setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
|classNameSymbol oldAbbrev cls abbrevs|
CachedAbbreviations isNil ifTrue:[
@@ -5203,7 +5444,9 @@
].
abbrevs at:classNameSymbol put:aFileNameString.
]
- "sourceDirectoryNameOfClass:aClassOrClassName
+!
+
+sourceDirectoryNameOfClass:aClassOrClassName
"for a given class, return the 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.
@@ -5258,7 +5501,21 @@
"Created: 6.11.1995 / 15:43:30 / cg"
"Modified: 9.12.1995 / 23:54:14 / cg"
"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.
+ Searches in subdirectories named 'source' in SystemPath"
+
+ |aString|
+
+ aString := self getSourceFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
+ ].
+ ^ nil
+!
systemFileStreamFor:aFileName
"search aFileName in some standard places;
@@ -5274,8 +5531,6 @@
^ nil
!
-syst
-
systemPath
"return a collection of directorynames, where smalltalk
looks for system files
@@ -5286,7 +5541,9 @@
"
Smalltalk systemPath
- Smalltalk systemPath addLast:'someOtherDirectory
+ Smalltalk systemPath addLast:'someOtherDirectoryPath'
+ "
+!
systemPath:aPath
"set the collection of directorynames, where smalltalk
@@ -5299,7 +5556,15 @@
"
Smalltalk systemPath
- Smalltalk sy
+ Smalltalk systemPath:(Smalltalk systemPath copy addLast:'someOtherDirectoryPath')
+ "
+! !
+
+!Smalltalk class methodsFor:'system management-packages'!
+
+knownPackages
+ ^ KnownPackages ? #()
+!
loadExtensionsForPackage:aPackageId
|packageDirName|
@@ -5321,18 +5586,30 @@
f := packageDir construct:'extensions.st'.
f exists ifTrue:[
f fileIn.
-
-
-loadExtensionsFromDirectory:packageDirOrString
- |packageDir f|
-
- packageDir := packageDirOrString asFilename.
-
- f := packageDir construct:'extensions.st'.
- f exists ifTrue:[
- f fileIn.
SilentLoading ifFalse:[
- Transcript showCR:('loaded extensions: ' , f pathN "
+ Transcript showCR:('loaded extensions: ' , f pathName).
+ ].
+ ^ true
+ ].
+ ^ false
+!
+
+loadPackage:aPackageIdOrPackage
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+ (aPackageIdOrPackage isSymbol
+ or:[aPackageIdOrPackage isString]) ifTrue:[
+ ^ self loadPackageWithId:aPackageIdOrPackage asAutoloaded:false
+ ].
+ self shouldImplement.
+
+ "
+ Smalltalk loadPackage:'stx:libbasic'
+ Smalltalk loadPackage:'stx:goodies/persistency'
+ Smalltalk loadPackage:'cg:cparser'
+ Smalltalk loadPackage:'cg:rose'
+ "
!
loadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
@@ -5343,33 +5620,6 @@
|p t new anyFail|
"/ problem: dependencies.
- "/ solution: repery.
- p package:packageId.
- t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
- p repositoryModule:(t first).
- p repositoryDirectory:(packageId copyFrom:t first size + 2).
- p isLoaded:true.
-
- new ifTrue:[Project addLoadedProject:p].
- ^ anyFail not
-
-!
-
-loadPackage:packageId fromClassLibrary:aFilename
- "load a package from a compiled classLib.
- Experimental."
-
- |p t new|
-
- (self fileIn:aFilename) ifFalse:[
- (self fileInClassLibrary:aFileloadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
- "load all source files found in aDirectory and treat them like
- a package. Allows for initial import of alien ST-code as a new package.
- Experimental."
-
- |p t new anyFail|
-
- "/ problem: dependencies.
"/ solution: repeat twice, so that superclasses are present the second time
Class packageQuerySignal answer:packageId asSymbol do:[
@@ -5411,7 +5661,9 @@
new ifTrue:[Project addLoadedProject:p].
^ anyFail not
- t loadPackage:packageId fromClassLibrary:aFilename
+!
+
+loadPackage:packageId fromClassLibrary:aFilename
"load a package from a compiled classLib.
Experimental."
@@ -5437,7 +5689,9 @@
new ifTrue:[Project addLoadedProject:p].
^ true
-ge:paloadPackage:packageId fromLoadAllFile:aFilename
+!
+
+loadPackage:packageId fromLoadAllFile:aFilename
"load a package from a loadAll - loader script.
Experimental."
@@ -5464,7 +5718,9 @@
new ifTrue:[Project addLoadedProject:p].
^ true
- addLloadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded
+!
+
+loadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded
"load a package from a .prj spec.
Experimental."
@@ -5517,13 +5773,17 @@
fromProjectFile:'../../../exept/osi/asn1/asn1.prj'
asAutoloaded:false
"
- eachClass package = aPackageId ifTrue:[ eachClass autoload].
- ].
- ].
-
- self loadExtensionsFromDirectory:packageDir.
- SilentLoading ifFalse:[
- Transcript loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded
+!
+
+loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded
+ "load a package from a .zip delivery file.
+ Experimental."
+
+ "/ not yet implemented ...
+ ^ false
+!
+
+loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded
|abbrevFile packageDir|
packageDir := self packageDirectoryForPackageId:aPackageId.
@@ -5547,20 +5807,25 @@
Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
].
^ true
-alltalk loadPackageWithId:'stx:libbasic'
+!
+
+loadPackageWithId:aPackageId
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+
+ ^ self loadPackageWithId:aPackageId asAutoloaded:false
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
Smalltalk loadPackageWithId:'stx:goodies/persistency'
- Smalltalk loadPackageWithId:'exept:ctypes'
- "
-!
-
-loadPackageWithId:aPackageId fromDirectory:packageDirOrString asAutoloaded:doLoadAsAutoloaded
- |f packageDir packageName shLibName|
-
- packageDir := packageDirOrString asFilename.
- packageName := packageDir baseName.
-
- "/ .prj ?
- f := (packageDir construct:packageName)loadPackageWithId:aPackageId asAutoloaded:doLoadAsAutoloaded
+ Smalltalk loadPackageWithId:'cg:cparser'
+ Smalltalk loadPackageWithId:'cg:rose'
+ Smalltalk loadPackageWithId:'detemobil:smc'
+ "
+!
+
+loadPackageWithId:aPackageId asAutoloaded:doLoadAsAutoloaded
"make certain, that some particular package is loaded into the system.
Experimental."
@@ -5595,7 +5860,9 @@
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
-Id:'eloadPackageWithId:aPackageId fromDirectory:packageDirOrString asAutoloaded:doLoadAsAutoloaded
+!
+
+loadPackageWithId:aPackageId fromDirectory:packageDirOrString asAutoloaded:doLoadAsAutoloaded
|f packageDir packageName shLibName|
packageDir := packageDirOrString asFilename.
@@ -5691,7 +5958,9 @@
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
-alltapackageDirectoryForPackageId:aPackageId
+!
+
+packageDirectoryForPackageId:aPackageId
|packageDirName packageDir|
packageDirName := aPackageId copyReplaceAll:$: with:$/.
@@ -5710,7 +5979,19 @@
Smalltalk packageDirectoryForPackageId:'stx:goodies/persistency'
Smalltalk packageDirectoryForPackageId:'exept:ctypes'
"
-
+! !
+
+!Smalltalk class methodsFor:'system management-undeclared variables'!
+
+clearUndeclaredVariables
+ "remove all undeclared variables"
+
+ (Smalltalk at:#Undeclared) do:[:eachKey |
+ Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
+ ].
+ (Smalltalk at:#Undeclared) removeAll.
+ Smalltalk removeKey:#Undeclared.
+!
undeclaredPrefix
"the prefix used for undeclared variables"
@@ -5728,15 +6009,17 @@
"for developers only: return the configuration, with which
this smalltalk was compiled."
-%undeclaredPrefix
- "the prefix used for undeclared variables"
-
- ^ 'Undeclared:::'
-
- "Created: / 31.10.1997 / 01:13:10 / cg"
-! !
-
-!Smalltalk class
+%{ /* NOCONTEXT */
+ extern char *__getConfigurationString();
+
+ RETURN (__MKSTRING(__getConfigurationString() COMMA_SND));
+%}.
+ ^ 'unknownOS/unknownCONF:unknownPACK'
+
+ "
+ Smalltalk configuration
+ "
+!
copyrightString
"{ Pragma: +optSpace }"
@@ -5760,23 +6043,6 @@
distributorString
"{ Pragma: +optSpace }"
- "return a string describing thecopyrightString
- "{ Pragma: +optSpace }"
-
- "return a copyright string"
-
-%{
-
-distributorString
- "{ Pragma: +optSpace }"
-
- "return a string describing the distributor of this software"
-
-%{ /* NOCONTEXT */
-#ifndef __getDistributorString
- extern OBJ __getDistributorStridistributorString
- "{ Pragma: +optSpace }"
-
"return a string describing the distributor of this software"
%{ /* NOCONTEXT */
@@ -5785,14 +6051,15 @@
#endif
RETURN (__getDistributorString());
-%}lltalk expirationTime
- "
-!
-
-fullVersionString
- "{ Pragma: +optSpace }"
-
- expirationTime
+%}.
+ ^ 'eXept Software AG, Germany'
+
+ "
+ Smalltalk distributorString
+ "
+!
+
+expirationTime
"{ Pragma: +optSpace }"
"for developers only: return the time when the system will expire.
@@ -5805,28 +6072,33 @@
extern unsigned int __getExpirationTime();
exp = __MKUINT(__getExpirationTime());
-%}ith:(self versionString)
- with:(self versionDate)
-
- "
- Smalltalk language:#us.
- Smalltalk hello
-
- Smalltalk language:#de.
- Smalltalk hello
-
- Smalltalk language:#no.
- Smalltalk hello
-
- Transcript showCR:(Smalltalk hello)
- Stdout showCR:(Smalltalk hello)
- "
-
- "Modified: 18.5.1996 / 14:25:13 / cg"
-!
-
-imageRestartTime
- "return a timestamp for the moment when this image was restarted.hello
+%}.
+ exp == 0 ifTrue:[
+ ^ nil
+ ].
+ ^ Timestamp new fromOSTime:(exp * 1000). "OSTime is ms since 1970"
+
+ "
+ Smalltalk expirationTime
+ "
+!
+
+fullVersionString
+ "{ Pragma: +optSpace }"
+
+ "return a full version string"
+
+ ^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
+
+ "
+ Smalltalk fullVersionString
+ "
+
+ "Created: / 27.10.1997 / 17:03:09 / cg"
+ "Modified: / 27.10.1997 / 17:04:02 / cg"
+!
+
+hello
"{ Pragma: +optSpace }"
"return a greeting string"
@@ -5877,7 +6149,30 @@
"
"Modified: 18.5.1996 / 14:25:13 / cg"
-
+!
+
+imageRestartTime
+ "return a timestamp for the moment when this image was restarted.
+ If we do not execute from an image (i.e. fresh start), return nil."
+
+ ^ ImageRestartTime
+
+ "
+ Smalltalk imageStartTime
+ Smalltalk imageRestartTime
+ "
+
+ "Created: 13.12.1995 / 17:44:20 / cg"
+ "Modified: 6.3.1996 / 11:56:35 / cg"
+!
+
+imageSaveTime
+ "{ Pragma: +optSpace }"
+
+ "return a timestamp for the moment when this image was saved"
+
+ ^ ObjectMemory imageSaveTime
+!
imageStartTime
"{ Pragma: +optSpace }"
@@ -5900,22 +6195,6 @@
"{ Pragma: +optSpace }"
"return the major version number.
- This is only incremented f
-
-majorVersionNr
- "{ Pragma: +optSpace }"
-
- "return the major version number.
- This is only incremented for very fundamental changes,
- which make old object files totally incompatible
- (for example, if the layout/representation of fundamental
- classes changes).
-
- ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>majorVersionNr
- "{ Pragma: +optSpace }"
-
- "return the major version number.
This is only incremented for very fundamental changes,
which make old object files totally incompatible
(for example, if the layout/representation of fundamental
@@ -5944,7 +6223,7 @@
ST/X revision Naming is:
<major>.<minor>.<revision>.<release>"
- ^ 3
+ ^ 2
"
Smalltalk minorVersionNr
@@ -5954,7 +6233,22 @@
!
releaseIdentification
- "{ Pragma: +optSpace }
+ "{ Pragma: +optSpace }"
+
+ "for developers only: return the release
+ (to further identify the version in case of errors)"
+
+%{ /* NOCONTEXT */
+ extern OBJ __getRel();
+
+ RETURN (__getRel());
+%}.
+ ^ 'ST/X_experimental'
+
+ "
+ Smalltalk releaseIdentification
+ "
+!
releaseNr
"{ Pragma: +optSpace }"
@@ -5964,14 +6258,6 @@
their way to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
releaseNr
- "{ Pragma: +optSpace }"
-
- "return the revision number.
- Incremented for releases which fix bugs/add features but did not find
- their way to the outside world.
-
- ST/X revision Naming is:
<major>.<minor>.<revision>.<release>"
^ 1
@@ -5984,7 +6270,25 @@
!
revisionNr
- "{ Pragma: +optSpace }
+ "{ Pragma: +optSpace }"
+
+ "return the revision number.
+ Incremented for releases which fix bugs/add features
+ and represent a stable workable version which got published
+ to the outside world.
+
+ ST/X revision Naming is:
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 4
+
+ "
+ Smalltalk revisionNr
+ Smalltalk hello
+ "
+
+ "Modified: / 19.6.1998 / 04:29:10 / cg"
+!
timeStamp
"return a string useful for timestamping a file.
@@ -5997,7 +6301,12 @@
timeStamp:aStream
"write a string useful for timestamping a file onto aStream.
-
+ ST80 compatibility"
+
+ aStream nextPutAll:(self timeStamp).
+
+ "Created: / 18.6.1998 / 17:22:58 / cg"
+!
timeStampString
"return a string useful for timestamping a file."
@@ -6015,12 +6324,6 @@
"{ Pragma: +optSpace }"
"return the executables build date - thats the date when the smalltalk
- executable was bu
-
-versionDate
- "{ Pragma: +optSpace }"
-
- "return the executables build date - thats the date when the smalltalk
executable was built"
%{ /* NOCONTEXT */
@@ -6031,13 +6334,25 @@
^ 'today'
"
- Smalltalk versionDate versionDate
+ Smalltalk versionDate
+ "
+!
+
+versionString
"{ Pragma: +optSpace }"
- "return the executables build date - thats the date when the smalltalk
- executable was built"
-
-%{
+ "return the version string"
+
+ ^ (self majorVersionNr printString ,
+ '.',
+ self minorVersionNr printString ,
+ '.',
+ self revisionNr printString)
+
+ "
+ Smalltalk versionString
+ "
+!
vmMajorVersionNr
"{ Pragma: +optSpace }"
@@ -6057,29 +6372,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.655 2004-09-21 20:53:43 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.656 2004-09-22 12:21:56 cg Exp $'
! !
- '.',
- self revisionNr printString)
-
- "
- Smalltalk versionString
- "
-!
-
-vmMajorVersionNr
- "{ Pragma: +optSpace }
-
-version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.655 2004-09-21 20:53:43 ca Exp $'
-! !
- vmMajorVersionNr
- "
-
-! !
-
-!Smalltalk class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.655 2004-09-21 20:53:43 ca Exp $'
-! !