--- a/Smalltalk.st Wed Oct 11 13:32:44 2006 +0200
+++ b/Smalltalk.st Wed Oct 11 13:36:45 2006 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -37,7 +37,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -67,147 +67,147 @@
[Instance variables:]
- none - all handling is done in the VM
+ none - all handling is done in the VM
[Class variables:]
- StartBlocks <Collection> 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
- (such as the Launcher) are usually started here.
- These blocks are added by smalltalk.rc/private.rc etc.
- via #addStartBlock during early initialization.
-
- ImageStartBlocks
- <Collection> blocks to be executed in a separate process after
- everything has been initialized. These blocks will be
- executed after an image restart.
- These blocks are usually added by smalltalk_r.rc etc.
-
- ExitBlocks <Collection> blocks to evaluate before system is
- left. Not currently used (GNU-ST compatibility).
-
- SystemPath <Collection> path to search for system files (sources, bitmaps etc)
- Set to a default here, but typically changed from some
- startup.rc file
-
- PackagePath <Collection> path to search for package.
- This is going to replace the above systemPath, and a classes
- resources will eventually searched in its package directory.
- This list defines the path, where packages are searched for,
- initially this is something like /opt/smalltalk/packages.
- Set to a default here, but typically changed from some
- startup.rc file
-
- StartupClass <Class> class and selector, where the system starts up
- StartupSelector <Symbol> (right after VM initialization)
- StartupArguments <Array> If an image is saved while those being nonNil,
- the image will come up there.
- Allows for customized images to be generated from a standard ST/X.
- StandAlone programs also set those during initialization.
-
- CommandLine <String> Unix (OS-) command line
-
- CommandName <String> the command (i.e. argv[0])
-
- CommandLineArguments <Array> Unix (OS-) command line arguments broken into words
- CommandName has been stripped off.
- (initially set by the VM)
-
- SilentLoading <Boolean> suppresses messages during fileIn and in compiler
- (can be set to true from a customized main.c)
-
- Initializing <Boolean> true while (re-)initializing
- Controls the behavior of certain error
- reporters (for example: suppress dialogBoxes)
- while the system is not yet fit for full operation.
-
- StandAlone <Boolean> true, if this is a standalone app;
- if true the process scheduler watches for
- which processes are still running, and
- exits ST/X, when the last non-background
- and non-system process exits.
- Can be set in an application-specific startup script,
- or, for standAlone programs, by C-code during initialization.
-
- HeadlessOperation if true, a non-existing Display connection
- <Boolean> will NOT lead to an error-exit during startup.
- Default is false.
- Can be set in an application-specific startup script,
- or, for standAlone programs, by C-code during initialization.
-
- LogDoits <Boolean> if true, doits are also logged in the changes
- file. Default is false, since the changes file
- may become huge if every tiny doIt is saved there ...
-
- LoadBinaries <Boolean> if true, we attempt to load classes rom a binary
- file, if present. If false, this is always suppressed.
-
- SaveEmergencyImage <Boolean> if true (the default), an emergency image
- is saved, if the main Display looses its
- connection. This is useful if you have a
- flaky display connection (serial line)
- and want to have your stuff saved automatically
- in case of a broken connection.
+ StartBlocks <Collection> 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
+ (such as the Launcher) are usually started here.
+ These blocks are added by smalltalk.rc/private.rc etc.
+ via #addStartBlock during early initialization.
+
+ ImageStartBlocks
+ <Collection> blocks to be executed in a separate process after
+ everything has been initialized. These blocks will be
+ executed after an image restart.
+ These blocks are usually added by smalltalk_r.rc etc.
+
+ ExitBlocks <Collection> blocks to evaluate before system is
+ left. Not currently used (GNU-ST compatibility).
+
+ SystemPath <Collection> path to search for system files (sources, bitmaps etc)
+ Set to a default here, but typically changed from some
+ startup.rc file
+
+ PackagePath <Collection> path to search for package.
+ This is going to replace the above systemPath, and a classes
+ resources will eventually searched in its package directory.
+ This list defines the path, where packages are searched for,
+ initially this is something like /opt/smalltalk/packages.
+ Set to a default here, but typically changed from some
+ startup.rc file
+
+ StartupClass <Class> class and selector, where the system starts up
+ StartupSelector <Symbol> (right after VM initialization)
+ StartupArguments <Array> If an image is saved while those being nonNil,
+ the image will come up there.
+ Allows for customized images to be generated from a standard ST/X.
+ StandAlone programs also set those during initialization.
+
+ CommandLine <String> Unix (OS-) command line
+
+ CommandName <String> the command (i.e. argv[0])
+
+ CommandLineArguments <Array> Unix (OS-) command line arguments broken into words
+ CommandName has been stripped off.
+ (initially set by the VM)
+
+ SilentLoading <Boolean> suppresses messages during fileIn and in compiler
+ (can be set to true from a customized main.c)
+
+ Initializing <Boolean> true while (re-)initializing
+ Controls the behavior of certain error
+ reporters (for example: suppress dialogBoxes)
+ while the system is not yet fit for full operation.
+
+ StandAlone <Boolean> true, if this is a standalone app;
+ if true the process scheduler watches for
+ which processes are still running, and
+ exits ST/X, when the last non-background
+ and non-system process exits.
+ Can be set in an application-specific startup script,
+ or, for standAlone programs, by C-code during initialization.
+
+ HeadlessOperation if true, a non-existing Display connection
+ <Boolean> will NOT lead to an error-exit during startup.
+ Default is false.
+ Can be set in an application-specific startup script,
+ or, for standAlone programs, by C-code during initialization.
+
+ LogDoits <Boolean> if true, doits are also logged in the changes
+ file. Default is false, since the changes file
+ may become huge if every tiny doIt is saved there ...
+
+ LoadBinaries <Boolean> if true, we attempt to load classes rom a binary
+ file, if present. If false, this is always suppressed.
+
+ SaveEmergencyImage <Boolean> if true (the default), an emergency image
+ is saved, if the main Display looses its
+ connection. This is useful if you have a
+ flaky display connection (serial line)
+ and want to have your stuff saved automatically
+ in case of a broken connection.
strictly private classVariables (helpers):
- CachedClasses <Collection> known classes (cached for faster class enumeration)
-
- CachedAbbreviations
- <Dictionary> className to filename mappings
-
- RealSystemPath <Collection> cached collection of directories along the path
- which really exist. Caching avoids long checks
- for existing directories on broken NFS volumes.
-
- SourcePath <Collection> cached names of really existing directories
- These are remembered, as in NFS systems,
- ResourcePath the time to lookup files may become long
- BinaryPath (especially, if some directories are on machines
- FileInPath which are not up ...).
- Therefore, the set of really
- existing directories is cached when the SystemPath
- is walked the first time.
- A consequence is that you have to invoke
- flushSystemPath, when you create any of those
- directories while running
- (and want the running ST/X to look there)
+ CachedClasses <Collection> known classes (cached for faster class enumeration)
+
+ CachedAbbreviations
+ <Dictionary> className to filename mappings
+
+ RealSystemPath <Collection> cached collection of directories along the path
+ which really exist. Caching avoids long checks
+ for existing directories on broken NFS volumes.
+
+ SourcePath <Collection> cached names of really existing directories
+ These are remembered, as in NFS systems,
+ ResourcePath the time to lookup files may become long
+ BinaryPath (especially, if some directories are on machines
+ FileInPath which are not up ...).
+ Therefore, the set of really
+ existing directories is cached when the SystemPath
+ is walked the first time.
+ A consequence is that you have to invoke
+ flushSystemPath, when you create any of those
+ directories while running
+ (and want the running ST/X to look there)
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- ObjectMemory
+ ObjectMemory
"
!
readme_resources
"
What is a resource file:
- resource files contain language transformation and sometimes
- UI-look specifics such as icons etc.
+ resource files contain language transformation and sometimes
+ UI-look specifics such as icons etc.
Where are resources stored in the image:
- Resource files are only read on demand (i.e. when needed) and only read once
- i.e. they are cached in the image).
- The cached data is held in a per-class class-instVar named 'ClassResources'.
- With only a few exceptions, the only classes which need resources are the GUI
- classes under the SimpleView hierarchy.
+ Resource files are only read on demand (i.e. when needed) and only read once
+ i.e. they are cached in the image).
+ The cached data is held in a per-class class-instVar named 'ClassResources'.
+ With only a few exceptions, the only classes which need resources are the GUI
+ classes under the SimpleView hierarchy.
How does the system find resources:
- The idea is that the system-provided resource files can be overwritten
- by the user or an application configuration.
- This works via a hierarchy of directories where resources are searched for,
- with the systems standard resource-files being at the end of that chain.
-
- When searching for a resource file for class X, the following files are searched
- in order:
- {ResourcePath} / resources / X.rs
- {SystemPath} / (CLASSES-PACKAGE-PATH) / X.rs
- {ResourcePath} / (CLASSES-PACKAGE-PATH) / X.rs
+ The idea is that the system-provided resource files can be overwritten
+ by the user or an application configuration.
+ This works via a hierarchy of directories where resources are searched for,
+ with the systems standard resource-files being at the end of that chain.
+
+ When searching for a resource file for class X, the following files are searched
+ in order:
+ {ResourcePath} / resources / X.rs
+ {SystemPath} / (CLASSES-PACKAGE-PATH) / X.rs
+ {ResourcePath} / (CLASSES-PACKAGE-PATH) / X.rs
"
! !
@@ -219,20 +219,20 @@
|envString i langString terrString|
StandAlone isNil ifTrue:[
- StandAlone := false.
+ StandAlone := false.
].
HeadlessOperation isNil ifTrue:[
- HeadlessOperation := false.
+ HeadlessOperation := false.
].
"
extract Language and LanguageTerritory from LANG variable.
valid are for example:
- en_en / en
- en_us
- en_gb
- de_de / de
- de_at (for Austria)
+ en_en / en
+ en_us
+ en_gb
+ de_de / de
+ de_at (for Austria)
"
Language := #en.
@@ -240,35 +240,35 @@
"Format of LANG is: language[_territory][.codeset][@modifier]
- language ISO-639 Language code
- territory ISO-3166 Contry code"
+ language ISO-639 Language code
+ territory ISO-3166 Contry code"
envString := OperatingSystem getLanguage.
envString size > 0 ifTrue:[
- i := envString indexOf:$@.
- (i ~~ 0) ifTrue:[
- envString := envString copyTo:(i - 1).
- LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- ] ifFalse:[
- LanguageModifier := nil.
- ].
- i := envString indexOf:$..
- (i ~~ 0) ifTrue:[
- envString := envString copyTo:(i - 1).
- LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol
- ] ifFalse:[
- LanguageCodeset := #'iso8859-1'.
- ].
- i := envString indexOf:$_.
- (i == 0) ifTrue:[
- langString := envString.
- terrString := envString
- ] ifFalse:[
- langString := envString copyTo:(i - 1).
- terrString := envString copyFrom:(i + 1)
- ].
- Language := langString asLowercase asSymbol.
- LanguageTerritory := terrString asLowercase asSymbol
+ i := envString indexOf:$@.
+ (i ~~ 0) ifTrue:[
+ envString := envString copyTo:(i - 1).
+ LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
+ ] ifFalse:[
+ LanguageModifier := nil.
+ ].
+ i := envString indexOf:$..
+ (i ~~ 0) ifTrue:[
+ envString := envString copyTo:(i - 1).
+ LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol
+ ] ifFalse:[
+ LanguageCodeset := #'iso8859-1'.
+ ].
+ i := envString indexOf:$_.
+ (i == 0) ifTrue:[
+ langString := envString.
+ terrString := envString
+ ] ifFalse:[
+ langString := envString copyTo:(i - 1).
+ terrString := envString copyFrom:(i + 1)
+ ].
+ Language := langString asLowercase asSymbol.
+ LanguageTerritory := terrString asLowercase asSymbol
].
"
@@ -318,13 +318,13 @@
"redefine debug-tools, if view-classes exist"
Display notNil ifTrue:[
- InspectorView notNil ifTrue:[
- Inspector := InspectorView
- ].
- DebugView notNil ifTrue:[
- Debugger := DebugView
- ].
- Display initialize
+ InspectorView notNil ifTrue:[
+ Inspector := InspectorView
+ ].
+ DebugView notNil ifTrue:[
+ Debugger := DebugView
+ ].
+ Display initialize
]
"
@@ -335,66 +335,66 @@
initSystemPath
"setup path where system files are searched for.
the default path is set to:
- .
- <directory of exe> (WIN32 only)
- $HOME (if defined)
- $HOME/.smalltalk (if defined & existing)
- $SMALLTALK_LIBDIR (if defined & existing)
- $STX_LIBDIR (if defined & existing)
- $STX_TOPDIR (if defined & existing)
- REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\<CurrentVersion>\LibDir') (WIN32 only)
- REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\LibDir') (WIN32 only)
- <standard places>
+ .
+ <directory of exe> (WIN32 only)
+ $HOME (if defined)
+ $HOME/.smalltalk (if defined & existing)
+ $SMALLTALK_LIBDIR (if defined & existing)
+ $STX_LIBDIR (if defined & existing)
+ $STX_TOPDIR (if defined & existing)
+ REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\<CurrentVersion>\LibDir') (WIN32 only)
+ REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\LibDir') (WIN32 only)
+ <standard places>
standard places (unix):
- /opt/smalltalk/<release> (if existing)
- /opt/smalltalk (if existing)
- /usr/local/lib/smalltalk (if existing)
- /usr/lib/smalltalk (if existing)
- /lib/smalltalk (if existing)
+ /opt/smalltalk/<release> (if existing)
+ /opt/smalltalk (if existing)
+ /usr/local/lib/smalltalk (if existing)
+ /usr/lib/smalltalk (if existing)
+ /lib/smalltalk (if existing)
win32:
- \programs\exept\smalltalk (if existing)
- \programs\smalltalk (if existing)
- \smalltalk (if existing)
+ \programs\exept\smalltalk (if existing)
+ \programs\smalltalk (if existing)
+ \smalltalk (if existing)
vms:
- $stx:lib (if existing)
- $stx:root (if existing)
+ $stx:lib (if existing)
+ $stx:root (if existing)
of course, it is possible to add entries from the 'smalltalk.rc'
startup file; add expressions such as:
- Smalltalk systemPath addFirst:'/foo/bar/baz'.
- or:
- Smalltalk systemPath addLast:'/fee/foe/foo'.
+ Smalltalk systemPath addFirst:'/foo/bar/baz'.
+ or:
+ Smalltalk systemPath addLast:'/fee/foe/foo'.
However, smalltalk.rc itself must be found along the above path.
"
ChangeFileName := 'changes'.
OperatingSystem isVMSlike ifTrue:[
- BitmapDirName := 'bitmaps.dir'.
- BinaryDirName := 'binary.dir'.
- SourceDirName := 'source.dir'.
- ResourceDirName := 'resources.dir'.
- FileInDirName := 'filein.dir'.
- PackageDirName := 'packages.dir'.
+ BitmapDirName := 'bitmaps.dir'.
+ BinaryDirName := 'binary.dir'.
+ SourceDirName := 'source.dir'.
+ ResourceDirName := 'resources.dir'.
+ FileInDirName := 'filein.dir'.
+ PackageDirName := 'packages.dir'.
] ifFalse:[
- BitmapDirName := 'bitmaps'.
- BinaryDirName := 'binary'.
- SourceDirName := 'source'.
- ResourceDirName := 'resources'.
- FileInDirName := 'fileIn'.
- PackageDirName := 'packages'.
+ BitmapDirName := 'bitmaps'.
+ BinaryDirName := 'binary'.
+ SourceDirName := 'source'.
+ ResourceDirName := 'resources'.
+ FileInDirName := 'fileIn'.
+ PackageDirName := 'packages'.
].
SystemPath isNil ifTrue:[
- SystemPath := OperatingSystem defaultSystemPath.
- self flushPathCaches
+ SystemPath := OperatingSystem defaultSystemPath.
+ self flushPathCaches
].
PackagePath isNil ifTrue:[
- PackagePath := OperatingSystem defaultPackagePath.
+ PackagePath := OperatingSystem defaultPackagePath.
].
"
@@ -419,16 +419,16 @@
"sent from VM via #initializeModules"
Error handle:[:ex |
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
- ].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- (Smalltalk commandLineArguments includes:'--debug') ifTrue:[
- ex reject
- ].
+ ClassesFailedToInitialize isNil ifTrue:[
+ ClassesFailedToInitialize := IdentitySet new.
+ ].
+ 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
+ aClass initialize
].
!
@@ -439,12 +439,12 @@
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.
- ]
+ ('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.
+ ]
].
!
@@ -466,9 +466,9 @@
"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:
- this is not called when an image is restarted; in this
- case the show starts in Smalltalk>>restart."
+ Notice:
+ this is not called when an image is restarted; in this
+ case the show starts in Smalltalk>>restart."
|idx|
@@ -479,7 +479,7 @@
AbstractOperatingSystem initializeConcreteClass.
CommandLineArguments isNil ifTrue:[
- CommandLineArguments := #('stx').
+ CommandLineArguments := #('stx').
].
CommandLine := CommandLineArguments copy.
CommandLineArguments := CommandLineArguments asOrderedCollection.
@@ -490,25 +490,25 @@
DebuggingStandAlone := false.
StandAlone ifTrue:[
- InfoPrinting := false.
- ObjectMemory infoPrinting:false.
-
- idx := CommandLineArguments indexOf:'--debug'.
- idx ~~ 0 ifTrue:[
- DebuggingStandAlone := true.
- ].
- DebuggingStandAlone ifTrue:[
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- ].
+ InfoPrinting := false.
+ ObjectMemory infoPrinting:false.
+
+ idx := CommandLineArguments indexOf:'--debug'.
+ idx ~~ 0 ifTrue:[
+ DebuggingStandAlone := true.
+ ].
+ DebuggingStandAlone ifTrue:[
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ ].
] ifFalse:[
- "/
- "/ define low-level debugging tools - graphical classes are not prepared yet
- "/ to handle things.
- "/ This will bring us into the MiniDebugger when an error occurs during startup.
- "/
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
+ "/
+ "/ define low-level debugging tools - graphical classes are not prepared yet
+ "/ to handle things.
+ "/ This will bring us into the MiniDebugger when an error occurs during startup.
+ "/
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
].
"/
@@ -540,12 +540,12 @@
Compiler := ByteCodeCompiler.
Compiler isNil ifTrue:[
- "
- ByteCodeCompiler is not in the system (i.e. has not been linked in)
- this allows at least immediate evaluations for runtime systems without compiler
- NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
- "
- Compiler := Parser
+ "
+ ByteCodeCompiler is not in the system (i.e. has not been linked in)
+ this allows at least immediate evaluations for runtime systems without compiler
+ NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
+ "
+ Compiler := Parser
].
"/
@@ -608,7 +608,7 @@
newSpace + freeListSpace is returned."
ObjectMemory scavenge.
- ^ ObjectMemory freeSpace
+ ^ ObjectMemory freeSpace
+ (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
!
@@ -627,27 +627,27 @@
objects := SpecialObjectArray.
objects isNil ifTrue:[
- objects := Array new:5.
+ 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
- ]
+ 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
+ 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.
@@ -660,7 +660,7 @@
!
unregisterExternalObject: anObject
- "Unregister the given object in the external objects array.
+ "Unregister the given object in the external objects array.
Do nothing if it isn't registered."
|objects|
@@ -668,9 +668,9 @@
anObject isNil ifTrue:[^ self].
objects := SpecialObjectArray.
1 to: objects size do: [:i |
- (objects at: i) == anObject ifTrue: [
- objects at: i put: nil
- ]
+ (objects at: i) == anObject ifTrue: [
+ objects at: i put: nil
+ ]
].
! !
@@ -691,10 +691,10 @@
declarePoolDictionary:poolDictionaryName
SharedPool subclass:(poolDictionaryName asSymbol)
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:nil
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:nil
! !
!Smalltalk class methodsFor:'Compatibility-VW5.4'!
@@ -703,17 +703,17 @@
|newClass|
indexed == #none ifTrue:[
- newClass := superclass
- subclass:nameSymbol
- instanceVariableNames:instVars
- classVariableNames:''
- poolDictionaries:''
- category:category
- inEnvironment:self.
- classInstVars size > 0 ifTrue:[
- newClass class instanceVariableNames:classInstVars.
- ].
- ^ newClass
+ newClass := superclass
+ subclass:nameSymbol
+ instanceVariableNames:instVars
+ classVariableNames:''
+ poolDictionaries:''
+ category:category
+ inEnvironment:self.
+ classInstVars size > 0 ifTrue:[
+ newClass class instanceVariableNames:classInstVars.
+ ].
+ ^ newClass
].
self shouldImplement.
! !
@@ -750,8 +750,8 @@
!
at:aKey
- "retrieve the value stored under aKey, a symbol.
- Return nil if not present
+ "retrieve the value stored under aKey, a symbol.
+ Return nil if not present
(this will be changed to trigger an error - better use #at:ifAbsent:)"
aKey class == String ifTrue:[self error:'expected symbol'].
@@ -768,7 +768,7 @@
the evaluation of aBlock."
(self includesKey:aKey) ifTrue:[
- ^ self at:aKey
+ ^ self at:aKey
].
^ aBlock value
@@ -784,7 +784,7 @@
Otherwise, evaluate aBlock, passing the retrieved value as argument."
(self includesKey:aKey) ifTrue:[
- ^ aBlock value:(self at:aKey)
+ ^ aBlock value:(self at:aKey)
].
^ nil
@@ -805,23 +805,23 @@
oldValue = __GLOBAL_SET(aKey, aValue, (OBJ *)0);
%}.
CachedClasses notNil ifTrue:[
- oldValue isBehavior ifTrue:[
- oldValue name == aKey ifTrue:[
- CachedClasses remove:oldValue ifAbsent:[]
- ]
- ].
- aValue isBehavior ifTrue:[
+ oldValue isBehavior ifTrue:[
+ oldValue name == aKey ifTrue:[
+ CachedClasses remove:oldValue ifAbsent:[]
+ ]
+ ].
+ aValue isBehavior ifTrue:[
"/ aValue isMeta ifTrue:[
"/ "/ this should not happen
"/ ('SMALLTALK: store a Metaclass: ' , aValue name , ' as ' , aKey) infoPrintCR.
"/ ].
- aValue name == aKey ifTrue:[
- CachedClasses add:aValue
- ] ifFalse:[
- CachedClasses := nil
- ]
- ].
+ aValue name == aKey ifTrue:[
+ CachedClasses add:aValue
+ ] ifFalse:[
+ CachedClasses := nil
+ ]
+ ].
].
^ aValue.
"/
@@ -853,7 +853,7 @@
"return the symbol under which anObject is stored - or nil"
self keysDo:[:aKey |
- (self at:aKey) == anObject ifTrue:[^ aKey]
+ (self at:aKey) == anObject ifTrue:[^ aKey]
].
^ nil
@@ -872,17 +872,17 @@
removeKey:aKey
"remove the association stored under the key-argument from the globals dictionary.
- WARNING:
- this is somewhat dangerous: conceptionally, the association is removed,
- to which machine & byte compiled code refers if it accesses a global.
- If there are still global accesses in some literalArray or from machine-compiled code,
- it continues to reference the globals value via that obsolete association and gets a nil
- value. (which is correct)
- However, if that global is later 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."
+ WARNING:
+ this is somewhat dangerous: conceptionally, the association is removed,
+ to which machine & byte compiled code refers if it accesses a global.
+ If there are still global accesses in some literalArray or from machine-compiled code,
+ it continues to reference the globals value via that obsolete association and gets a nil
+ value. (which is correct)
+ However, if that global is later 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.
@@ -915,7 +915,7 @@
UserPreferences systemBrowserClass browseAllCallsOn:aSelectorSymbol
"
- Smalltalk browseAllCallsOn:#at:put:
+ Smalltalk browseAllCallsOn:#at:put:
"
!
@@ -937,9 +937,9 @@
"startup a changes browser"
ChangesBrowser notNil ifTrue:[
- ChangesBrowser open
+ ChangesBrowser open
] ifFalse:[
- self warn:'no ChangesBrowser built in'
+ self warn:'no ChangesBrowser built in'
]
"
@@ -955,7 +955,7 @@
UserPreferences systemBrowserClass browseClass:aClass
"
- Smalltalk browseClass:Array
+ Smalltalk browseClass:Array
"
!
@@ -967,8 +967,8 @@
UserPreferences systemBrowserClass browseImplementorsMatching:aSelectorSymbolOrMatchPattern
"
- Smalltalk browseImplementorsOf:#'at:put:'
- Smalltalk browseImplementorsMatching:#'at:*'
+ Smalltalk browseImplementorsOf:#'at:put:'
+ Smalltalk browseImplementorsMatching:#'at:*'
"
!
@@ -980,7 +980,7 @@
UserPreferences systemBrowserClass browseImplementorsOf:aSelectorSymbol
"
- Smalltalk browseImplementorsOf:#at:put:
+ Smalltalk browseImplementorsOf:#at:put:
"
!
@@ -992,7 +992,7 @@
UserPreferences systemBrowserClass openInClass:aClass
"
- Smalltalk browseInClass:Array
+ Smalltalk browseInClass:Array
"
!
@@ -1018,14 +1018,14 @@
oldCategory := aClass category.
oldCategory ~= newCategory ifTrue:[
- aClass category:(newCategory withoutSeparators asSymbol).
-
- "notify change of category"
- ns := aClass environment ? self.
- ns changed:#organization with:(aClass -> oldCategory).
- ns ~~ self ifTrue:[
- self changed:#organization with:(aClass -> oldCategory).
- ]
+ aClass category:(newCategory withoutSeparators asSymbol).
+
+ "notify change of category"
+ ns := aClass environment ? self.
+ ns changed:#organization with:(aClass -> oldCategory).
+ ns ~~ self ifTrue:[
+ self changed:#organization with:(aClass -> oldCategory).
+ ]
].
"
@@ -1042,7 +1042,7 @@
flushCachedClass:aClass
CachedClasses notNil ifTrue:[
- CachedClasses remove:aClass ifAbsent:[]
+ CachedClasses remove:aClass ifAbsent:[]
]
!
@@ -1067,31 +1067,31 @@
oldName := aClass name.
sym := oldNameSym := oldName asSymbol.
((self at:oldNameSym) == aClass) ifFalse:[
- "check other name ..."
- (self includes:aClass) ifFalse:[
- 'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
- ^ self
- ].
- "
- the class has changed its name - without telling me ...
- what should be done in this case ?
- "
- 'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
- ' has changed its name' errorPrintCR.
-
- "/
- "/ might be an alias (i.e. removing a compatibility name)
- "/
- actualName := self keyAtValue:aClass.
- ('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
- sym := actualName asSymbol.
- oldName := actualName asString.
- wrongName := true.
+ "check other name ..."
+ (self includes:aClass) ifFalse:[
+ 'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
+ ^ self
+ ].
+ "
+ the class has changed its name - without telling me ...
+ what should be done in this case ?
+ "
+ 'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
+ ' has changed its name' errorPrintCR.
+
+ "/
+ "/ might be an alias (i.e. removing a compatibility name)
+ "/
+ actualName := self keyAtValue:aClass.
+ ('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
+ sym := actualName asSymbol.
+ oldName := actualName asString.
+ wrongName := true.
].
ns := aClass nameSpace.
aClass topOwningClass notNil ifTrue:[
- ons := aClass topOwningClass nameSpace
+ ons := aClass topOwningClass nameSpace
].
self at:sym put:nil. "nil it out for compiled accesses"
@@ -1100,25 +1100,25 @@
"/ see comment in removeKey: on why we dont remove it here
"/
"/ self removeKey:sym. "/ remove key - this actually fails, if there are
- "/ still compiled code references."
+ "/ still compiled code references."
"remove private classes"
aClass privateClassesSorted do:[:somePrivateClass |
- aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
+ aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
].
"remove class variables"
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- cSym := (sym , ':' , name) asSymbol.
- self at:cSym asSymbol put:nil.
-
- "/
- "/ see comment in removeKey: on why we dont remove it here
- "/
- "/ self removeKey:cSym
+ cSym := (sym , ':' , name) asSymbol.
+ self at:cSym asSymbol put:nil.
+
+ "/
+ "/ see comment in removeKey: on why we dont remove it here
+ "/
+ "/ self removeKey:cSym
].
@@ -1147,31 +1147,31 @@
Class flushSubclassInfo.
wrongName == true ifTrue:[
- "/
- "/ an alias (i.e. removing a compatibility name)
- "/
- "/ check if there are more refs to it ...
- [self includes:aClass] whileTrue:[
- actualName := self keyAtValue:aClass.
- ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
- , ' - remove that binding too.') infoPrintCR.
- self at:actualName put:nil.
- ].
+ "/
+ "/ an alias (i.e. removing a compatibility name)
+ "/
+ "/ check if there are more refs to it ...
+ [self includes:aClass] whileTrue:[
+ actualName := self keyAtValue:aClass.
+ ('Smalltalk [info]: ' , aClass name , ' is also 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
- recompileGlobalAccessorsTo:oldNameSym
- in:ns
- except:nil
- ].
+ ons notNil ifTrue:[
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldNameSym
+ in:ons
+ except:nil
+ ].
+ (ns notNil and:[ns ~~ ons]) ifTrue:[
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldNameSym
+ in:ns
+ except:nil
+ ].
].
"Modified: / 20.6.1998 / 13:26:10 / cg"
@@ -1192,24 +1192,24 @@
i2 := 1.
ns := self.
[i2 ~~ 0] whileTrue:[
- i2 := newName indexOfSubCollection:'::' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- nm := newName copyFrom:i1 to:i2-1.
- ns isNameSpace ifTrue:[
- subns := ns at:nm asSymbol ifAbsent:nil.
- subns isNil ifTrue:[
- self error:'Nonexisting namespace: ',nm.
- ^ nil.
- ].
- ] ifFalse:[
- subns := ns privateClassesAt:nm asSymbol.
- subns isNil ifTrue:[
- self error:'Cannot create a namespace below a class'
- ]
- ].
- ns := subns.
- i1 := i2 + 2.
- ].
+ i2 := newName indexOfSubCollection:'::' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ nm := newName copyFrom:i1 to:i2-1.
+ ns isNameSpace ifTrue:[
+ subns := ns at:nm asSymbol ifAbsent:nil.
+ subns isNil ifTrue:[
+ self error:'Nonexisting namespace: ',nm.
+ ^ nil.
+ ].
+ ] ifFalse:[
+ subns := ns privateClassesAt:nm asSymbol.
+ subns isNil ifTrue:[
+ self error:'Cannot create a namespace below a class'
+ ]
+ ].
+ ns := subns.
+ i1 := i2 + 2.
+ ].
].
oldName := aClass name.
@@ -1220,8 +1220,8 @@
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -1230,42 +1230,42 @@
"/ change the owning class
ns isNameSpace ifFalse:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:ns.
- ] ifFalse:[
- "/ sigh - must make a PrivateMetaclass from Metaclass
- oldMetaclass := aClass class.
- newMetaclass := PrivateMetaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
- newMetaclass setOwningClass:ns.
-
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:ns.
+ ] ifFalse:[
+ "/ sigh - must make a PrivateMetaclass from Metaclass
+ oldMetaclass := aClass class.
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+ newMetaclass setOwningClass:ns.
+
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
] ifTrue:[
- aClass isPrivate ifTrue:[
- newCategory := aClass topOwningClass category.
-
- "/ sigh - must make a Metaclass from PrivateMetaclass
- oldMetaclass := aClass class.
-
- newMetaclass := Metaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
-
- aClass category:newCategory.
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ newCategory := aClass topOwningClass category.
+
+ "/ sigh - must make a Metaclass from PrivateMetaclass
+ oldMetaclass := aClass class.
+
+ newMetaclass := Metaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+
+ aClass category:newCategory.
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
].
aClass setName:newSym.
@@ -1285,32 +1285,32 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
- aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1333,85 +1333,85 @@
newNameSpace := aClass topNameSpace.
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- Class withoutUpdatingChangesDo:[
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
-
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ "/ must rename privateClasses as well
+ Class withoutUpdatingChangesDo:[
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
"/ ClassBuilder
-"/ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
-"/ in:newNameSpace
+"/ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
+"/ in:newNameSpace
"/ except:nil.
- ]
- ]
+ ]
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
] ifFalse:[
- "/ all references to a global with my new name in my owning class
- "/ must now be redirected to myself.
-
- aClass isPrivate ifTrue:[
- newBaseName := aClass nameWithoutNameSpacePrefix.
- newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
- ]
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
].
aClass changed:#definition.
"/ because of the change of my superclasses name ...
aClass allSubclassesDo:[:subClass |
- subClass changed:#definition.
+ subClass changed:#definition.
].
"/ because of the change of my superclasses name ...
aClass subclassesDo:[:subClass |
- subClass addChangeRecordForClass:subClass.
+ subClass addChangeRecordForClass:subClass.
].
self changed:#definition.
Smalltalk changed:#classRename with:(Array with:aClass with:oldName).
@@ -1477,7 +1477,7 @@
"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."
+ it will be removed without notice."
%{
__PATCHUPCONTEXTS(__context);
__debugBreakPoint__();
@@ -1522,9 +1522,9 @@
char *msg;
if (__isString(aMessage))
- msg = (char *) __stringVal(aMessage);
+ msg = (char *) __stringVal(aMessage);
else
- msg = "fatalAbort";
+ msg = "fatalAbort";
__fatal0(__context, msg);
/* NEVER RETURNS */
@@ -1557,10 +1557,10 @@
allCategories := Set new.
Smalltalk allClassesDo:[:cls | |category|
- category := cls category.
- category notNil ifTrue:[
- allCategories add:category.
- ].
+ category := cls category.
+ category notNil ifTrue:[
+ allCategories add:category.
+ ].
].
^ allCategories.
@@ -1579,16 +1579,16 @@
already := IdentitySet new:NumberOfClassesHint*3.
self allClassesDo:[:eachClass | |cls|
- cls := eachClass theNonMetaclass.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
- ].
- cls := cls class.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
- ].
+ cls := eachClass theNonMetaclass.
+ (already includes:cls) ifFalse:[
+ aBlock value:cls.
+ already add:cls.
+ ].
+ cls := cls class.
+ (already includes:cls) ifFalse:[
+ aBlock value:cls.
+ already add:cls.
+ ].
].
!
@@ -1603,20 +1603,20 @@
!
allClassesForWhich:filter
- "return a collection with all classes in the system,
+ "return a collection with all classes in the system,
for which filter evaluates to true."
|collectedClasses|
collectedClasses := OrderedCollection new.
self allClassesForWhich:filter do:[:cls |
- collectedClasses add:cls
+ collectedClasses add:cls
].
^ collectedClasses
"
- Smalltalk
- allClassesForWhich:[:cls | cls name startsWith:'Po']
+ Smalltalk
+ allClassesForWhich:[:cls | cls name startsWith:'Po']
"
"Created: / 10-08-2006 / 12:11:31 / cg"
@@ -1626,13 +1626,13 @@
"evaluate the argument, aBlock for all classes in the system, for which filter evaluates to true."
self allClassesDo:[:cls |
- (filter value:cls) ifTrue:[ aBlock value:cls ].
- ].
-
- "
- Smalltalk
- allClassesForWhich:[:cls | cls name startsWith:'Po']
- do:[:aClass | Transcript showCR:aClass name]
+ (filter value:cls) ifTrue:[ aBlock value:cls ].
+ ].
+
+ "
+ Smalltalk
+ allClassesForWhich:[:cls | cls name startsWith:'Po']
+ do:[:aClass | Transcript showCR:aClass name]
"
!
@@ -1654,7 +1654,7 @@
The order of the classes is not defined."
aCategory notNil ifTrue:[
- self allClassesForWhich:[:cls | cls category = aCategory] do:aBlock
+ self allClassesForWhich:[:cls | cls category = aCategory] do:aBlock
]
"
@@ -1671,12 +1671,12 @@
|classes|
aCategory notNil ifTrue:[
- classes := OrderedCollection new.
- self allClassesInCategory:aCategory do:[:aClass |
- classes add:aClass
- ].
- classes topologicalSort:[:a :b | b isSubclassOf:a].
- classes do:aBlock
+ classes := OrderedCollection new.
+ self allClassesInCategory:aCategory do:[:aClass |
+ classes add:aClass
+ ].
+ classes topologicalSort:[:a :b | b isSubclassOf:a].
+ classes do:aBlock
]
"
@@ -1694,16 +1694,16 @@
already := IdentitySet new:NumberOfClassesHint.
self allClassesDo:[:eachClass |
- (already includes:eachClass) ifFalse:[
- eachClass allSuperclasses reverseDo:[:eachSuperClass |
- (already includes:eachSuperClass) ifFalse:[
- already add:eachSuperClass.
- aBlock value:eachSuperClass.
- ].
- ].
- already add:eachClass.
- aBlock value:eachClass.
- ]
+ (already includes:eachClass) ifFalse:[
+ eachClass allSuperclasses reverseDo:[:eachSuperClass |
+ (already includes:eachSuperClass) ifFalse:[
+ already add:eachSuperClass.
+ aBlock value:eachSuperClass.
+ ].
+ ].
+ already add:eachClass.
+ aBlock value:eachClass.
+ ]
].
"
@@ -1718,7 +1718,7 @@
^ self allClassesForWhich:[:cls | cls package = aPackageID]
"
- Smalltalk allClassesInPackage:'bosch:dapasx'
+ Smalltalk allClassesInPackage:'bosch:dapasx'
"
"Created: / 10-08-2006 / 12:14:10 / cg"
@@ -1732,7 +1732,7 @@
^ self allClassesForWhich:[:cls | cls package = aPackageID] do:aBlock
"
- Smalltalk allClassesInPackage:'bosch:dapasx' do:[:aClass | Transcript showCR:aClass]
+ Smalltalk allClassesInPackage:'bosch:dapasx' do:[:aClass | Transcript showCR:aClass]
"
"Created: / 09-08-2006 / 17:14:17 / fm"
@@ -1751,7 +1751,7 @@
allCategories := Set new.
Smalltalk allClassesDo:[:cls |
- allCategories addAll:cls categories.
+ allCategories addAll:cls categories.
].
^ allCategories.
@@ -1763,18 +1763,18 @@
allMethodsDo:aBlock
Smalltalk allClassesDo:[:eachClass |
- eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- aBlock value:mthd
- ]
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ aBlock value:mthd
+ ]
].
!
associationsDo:aBlock
- "evaluate the argument, aBlock for all key/value pairs
+ "evaluate the argument, aBlock for all key/value pairs
in the Smalltalk dictionary"
self keysDo:[:aKey |
- aBlock value:(aKey -> (self at:aKey))
+ aBlock value:(aKey -> (self at:aKey))
]
"Smalltalk associationsDo:[:assoc | assoc printCR]"
@@ -1802,7 +1802,7 @@
RETURN (self);
%}.
self keysDo:[:aKey |
- aBlock value:(self at:aKey)
+ aBlock value:(self at:aKey)
]
!
@@ -1810,7 +1810,7 @@
"evaluate the two-arg block, aBlock for all keys and values"
self keysDo:[:aKey |
- aBlock value:aKey value:(self at:aKey)
+ aBlock value:aKey value:(self at:aKey)
]
!
@@ -1819,16 +1819,16 @@
collected := OrderedCollection new.
self keysAndValuesDo:[:eachKey :eachValue |
- (selectBlockWith2Args value:eachKey value:eachValue) ifTrue:[
- collected add:(collectBlockWith2Args value:eachKey value:eachValue)
- ].
+ (selectBlockWith2Args value:eachKey value:eachValue) ifTrue:[
+ collected add:(collectBlockWith2Args value:eachKey value:eachValue)
+ ].
].
^ collected
"
- Smalltalk
- keysAndValuesSelect:[:nm :val | (nm startsWith:'Ab') and:[val notNil]]
- thenCollect:[:nm :val | nm]
+ Smalltalk
+ keysAndValuesSelect:[:nm :val | (nm startsWith:'Ab') and:[val notNil]]
+ thenCollect:[:nm :val | nm]
"
!
@@ -1841,7 +1841,7 @@
RETURN (self);
%}.
self basicKeys do:[:aKey |
- aBlock value:aKey
+ aBlock value:aKey
]
! !
@@ -1893,9 +1893,9 @@
cleanup in stand alone applications."
ExitBlocks isNil ifTrue:[
- ExitBlocks := OrderedCollection with:aBlock
+ ExitBlocks := OrderedCollection with:aBlock
] ifFalse:[
- ExitBlocks add:aBlock
+ ExitBlocks add:aBlock
]
!
@@ -1903,13 +1903,13 @@
"{ Pragma: +optSpace }"
"add a blocks to be executed in a separate process after
- everything has been initialized.
+ everything has been initialized.
These blocks will be executed after an image restart."
ImageStartBlocks isNil ifTrue:[
- ImageStartBlocks := OrderedCollection with:aBlock
+ ImageStartBlocks := OrderedCollection with:aBlock
] ifFalse:[
- ImageStartBlocks add:aBlock
+ ImageStartBlocks add:aBlock
]
"Created: 9.9.1996 / 16:48:20 / stefan"
@@ -1921,13 +1921,13 @@
"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.
+ executed after an image restart.
Initial processes are usually started here (see smalltalk.rc / private.rc)."
StartBlocks isNil ifTrue:[
- StartBlocks := OrderedCollection with:aBlock
+ StartBlocks := OrderedCollection with:aBlock
] ifFalse:[
- StartBlocks add:aBlock
+ StartBlocks add:aBlock
]
"Created: 9.9.1996 / 16:46:53 / stefan"
@@ -1954,9 +1954,9 @@
ObjectMemory changed:#aboutToExit. "/ for ST/X backward compatibility
ObjectMemory changed:#aboutToQuit. "/ for ST-80 compatibility
ExitBlocks notNil ifTrue:[
- ExitBlocks do:[:aBlock |
- aBlock value
- ]
+ ExitBlocks do:[:aBlock |
+ aBlock value
+ ]
].
OperatingSystem exit:statusInteger
"not reached"
@@ -1970,7 +1970,7 @@
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|
@@ -1983,27 +1983,27 @@
"/ If that happens, we restart the set-building here
"/
[(classes := CachedClasses) isNil] whileTrue:[
- CachedClasses := classes := IdentitySet new:NumberOfClassesHint.
- self keysAndValuesDo:[:eachName :eachGlobal |
- (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
- "/ sigh - would like to skip over aliases
- "/ but this cannot be done simply by comparing
- "/ the classes name against the store-key
- "/ i.e. cannot do:
- "/ anObject name == sym ifTrue:[
- "/ classes add:anObject
- "/ ]
- "/ because that would lead to ignore all java
- "/ classes, which are stored under a different
- "/ key.
-
- (eachGlobal name == eachName
- or:[eachGlobal isJavaClass]) ifTrue:[
- classes add:eachGlobal
- ].
- ]
- ].
- NumberOfClassesHint := classes size.
+ CachedClasses := classes := IdentitySet new:NumberOfClassesHint.
+ self keysAndValuesDo:[:eachName :eachGlobal |
+ (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
+ "/ sigh - would like to skip over aliases
+ "/ but this cannot be done simply by comparing
+ "/ the classes name against the store-key
+ "/ i.e. cannot do:
+ "/ anObject name == sym ifTrue:[
+ "/ classes add:anObject
+ "/ ]
+ "/ because that would lead to ignore all java
+ "/ classes, which are stored under a different
+ "/ key.
+
+ (eachGlobal name == eachName
+ or:[eachGlobal isJavaClass]) ifTrue:[
+ classes add:eachGlobal
+ ].
+ ]
+ ].
+ NumberOfClassesHint := classes size.
].
^ classes
@@ -2026,25 +2026,25 @@
classes := IdentitySet new:NumberOfClassesHint*2.
self allClassesDo:[:eachClass |
- classes add:(eachClass theNonMetaclass).
- classes add:(eachClass theMetaclass).
+ 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
+ Only globally anchored classes are returned
(i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
- ^ self allClasses select:[:aClass |
- |owner|
-
- (aClass isNameSpace not or:[aClass == Smalltalk])
- and:[
- owner := aClass topOwningClass.
- (owner ? aClass) nameSpace == Smalltalk
- ]
+ ^ self allClasses select:[:aClass |
+ |owner|
+
+ (aClass isNameSpace not or:[aClass == Smalltalk])
+ and:[
+ owner := aClass topOwningClass.
+ (owner ? aClass) nameSpace == Smalltalk
+ ]
]
"
@@ -2057,18 +2057,18 @@
implementors := OrderedCollection new.
self allClassesDo:[:cls |
- (cls includesSelector:aSelector) ifTrue:[
- implementors add:cls.
- ].
- (cls class includesSelector:aSelector) ifTrue:[
- implementors add:cls class.
- ].
+ (cls includesSelector:aSelector) ifTrue:[
+ implementors add:cls.
+ ].
+ (cls class includesSelector:aSelector) ifTrue:[
+ implementors add:cls class.
+ ].
].
^ implementors
"
- Smalltalk allImplementorsOf:#isNil
- (Smalltalk allImplementorsOf:#add:) size
+ Smalltalk allImplementorsOf:#isNil
+ (Smalltalk allImplementorsOf:#add:) size
"
!
@@ -2077,24 +2077,24 @@
allProjects := Set new.
self allClassesDo:[:eachClass |
- |cls pkg|
-
- cls := eachClass theNonMetaclass.
-
- pkg := cls package.
- pkg "withoutSeparators" size > 0 ifTrue:[
- allProjects add:pkg.
- ] ifFalse:[
- "/ for now, nameSpaces are not in any package;
- "/ this might change. Then, 0-sized packages are
- "/ illegal, and the following should be enabled.
- "/ self halt
- ].
- cls isJavaClass ifFalse:[
- cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- allProjects add:mthd package asSymbol.
- ].
- ].
+ |cls pkg|
+
+ cls := eachClass theNonMetaclass.
+
+ pkg := cls package.
+ pkg "withoutSeparators" size > 0 ifTrue:[
+ allProjects add:pkg.
+ ] ifFalse:[
+ "/ for now, nameSpaces are not in any package;
+ "/ this might change. Then, 0-sized packages are
+ "/ illegal, and the following should be enabled.
+ "/ self halt
+ ].
+ cls isJavaClass ifFalse:[
+ cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ allProjects add:mthd package asSymbol.
+ ].
+ ].
].
allProjects := allProjects asOrderedCollection sort.
^ allProjects
@@ -2120,14 +2120,14 @@
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"
+ 2nd: collection consisting of matching categories"
^ DoWhatIMeanSupport classCategoryCompletion:aPartialCategory inEnvironment:self
"
- Smalltalk classCategoryCompletion:'Sys'
- Smalltalk classCategoryCompletion:'System'
- Smalltalk classCategoryCompletion:'System-BinaryStorage'
+ Smalltalk classCategoryCompletion:'Sys'
+ Smalltalk classCategoryCompletion:'System'
+ Smalltalk classCategoryCompletion:'System-BinaryStorage'
"
"Modified: / 10-08-2006 / 13:06:34 / cg"
@@ -2146,56 +2146,56 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
- cls := self at:sym ifAbsent:nil.
- cls isBehavior ifTrue:[^ cls].
+ cls := self at:sym ifAbsent:nil.
+ cls isBehavior ifTrue:[^ cls].
].
(aString endsWith:' class') ifTrue:[
- nonMeta := self classNamed:(aString copyWithoutLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
+ nonMeta := self classNamed:(aString copyWithoutLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
].
"no success yet. Try if this is a private classes of an autoloaded class"
cls isNil ifTrue:[
- idx := aString indexOfSubCollection:'::'.
- idx ~~ 0 ifTrue:[
- prefix := aString copyTo:idx-1.
- rest := aString copyFrom:idx+2.
- namespace := self at:prefix asSymbolIfInterned ifAbsent:nil.
- "namespace may be the owner of a private class.
- NameSpaces and Behaviors have the same protocol"
- [namespace isBehavior] whileTrue:[
- idx := rest indexOfSubCollection:'::'.
- idx ~~ 0 ifTrue:[
- prefix := rest copyTo:idx-1.
- rest := rest copyFrom:idx+2.
- "this does an implicit autoload if required"
- namespace := namespace privateClassesAt:prefix.
- ] ifFalse:[
- namespace isLoaded ifTrue:[
- cls := namespace privateClassesAt:rest.
- cls isBehavior ifTrue:[^ cls].
- ].
- namespace := nil. "force exit of loop"
- ].
- ].
- ].
+ idx := aString indexOfSubCollection:'::'.
+ idx ~~ 0 ifTrue:[
+ prefix := aString copyTo:idx-1.
+ rest := aString copyFrom:idx+2.
+ namespace := self at:prefix asSymbolIfInterned ifAbsent:nil.
+ "namespace may be the owner of a private class.
+ NameSpaces and Behaviors have the same protocol"
+ [namespace isBehavior] whileTrue:[
+ idx := rest indexOfSubCollection:'::'.
+ idx ~~ 0 ifTrue:[
+ prefix := rest copyTo:idx-1.
+ rest := rest copyFrom:idx+2.
+ "this does an implicit autoload if required"
+ namespace := namespace privateClassesAt:prefix.
+ ] ifFalse:[
+ namespace isLoaded ifTrue:[
+ cls := namespace privateClassesAt:rest.
+ cls isBehavior ifTrue:[^ cls].
+ ].
+ namespace := nil. "force exit of loop"
+ ].
+ ].
+ ].
].
^ nil
"
- Smalltalk classNamed:'Object'
- Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
- Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
- Smalltalk classNamed:'Authentication::BasicAuthenticator'
- Smalltalk classNamed:'fooBar'
- Smalltalk classNamed:'true'
- Smalltalk classNamed:'Object class'
- Smalltalk classNamed:'Metaclass'
- Smalltalk classNamed:'Array'
+ Smalltalk classNamed:'Object'
+ Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
+ Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
+ Smalltalk classNamed:'Authentication::BasicAuthenticator'
+ Smalltalk classNamed:'fooBar'
+ Smalltalk classNamed:'true'
+ Smalltalk classNamed:'Object class'
+ Smalltalk classNamed:'Metaclass'
+ Smalltalk classNamed:'Array'
Smalltalk classNamed:'Array class'
"
@@ -2217,7 +2217,7 @@
classnameCompletion:aPartialClassName
"given a partial classname, return an array consisting of
2 entries: 1st: the best (longest) match
- 2nd: collection consisting of matching names"
+ 2nd: collection consisting of matching names"
^ DoWhatIMeanSupport classnameCompletion:aPartialClassName inEnvironment:self
!
@@ -2225,18 +2225,18 @@
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"
+ 2nd: collection consisting of matching names"
^ DoWhatIMeanSupport classnameCompletion:aPartialClassName inEnvironment:anEnvironment
"
- Smalltalk classnameCompletion:'Arr'
- Smalltalk classnameCompletion:'Arra'
- Smalltalk classnameCompletion:'arra'
- Smalltalk classnameCompletion:'*rray'
-
- Smalltalk classnameCompletion:'Arr cl'
- Smalltalk classnameCompletion:'*rray cl'
+ Smalltalk classnameCompletion:'Arr'
+ Smalltalk classnameCompletion:'Arra'
+ Smalltalk classnameCompletion:'arra'
+ Smalltalk classnameCompletion:'*rray'
+
+ Smalltalk classnameCompletion:'Arr cl'
+ Smalltalk classnameCompletion:'*rray cl'
"
"Created: 24.11.1995 / 17:24:45 / cg"
@@ -2256,15 +2256,15 @@
globalNameCompletion:aPartialGlobalName
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
- 2nd: collection consisting of matching names"
+ 2nd: collection consisting of matching names"
^ DoWhatIMeanSupport globalNameCompletion:aPartialGlobalName inEnvironment:self
"
- Smalltalk globalnameCompletion:'Arr'
- Smalltalk globalnameCompletion:'Arra'
- Smalltalk globalnameCompletion:'arra'
- Smalltalk globalnameCompletion:'*rray'
+ Smalltalk globalnameCompletion:'Arr'
+ Smalltalk globalnameCompletion:'Arra'
+ Smalltalk globalnameCompletion:'arra'
+ Smalltalk globalnameCompletion:'*rray'
"
"Created: / 24-11-1995 / 17:24:45 / cg"
@@ -2274,17 +2274,17 @@
globalnameCompletion:aPartialGlobalName
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
- 2nd: collection consisting of matching names"
+ 2nd: collection consisting of matching names"
<resource:#obsolete>
self obsoleteMethodWarning:'use #globalNameCompletion:'.
^ DoWhatIMeanSupport globalNameCompletion:aPartialGlobalName inEnvironment:self
"
- Smalltalk globalnameCompletion:'Arr'
- Smalltalk globalnameCompletion:'Arra'
- Smalltalk globalnameCompletion:'arra'
- Smalltalk globalnameCompletion:'*rray'
+ Smalltalk globalnameCompletion:'Arr'
+ Smalltalk globalnameCompletion:'Arra'
+ Smalltalk globalnameCompletion:'arra'
+ Smalltalk globalnameCompletion:'*rray'
"
"Created: / 24-11-1995 / 17:24:45 / cg"
@@ -2348,19 +2348,19 @@
i := aKey lastIndexOf:$:.
i ~~ 0 ifTrue:[
- i > 1 ifTrue:[
- (aKey at:(i-1)) == $: ifFalse:[
- ^ true.
- ].
- ].
+ i > 1 ifTrue:[
+ (aKey at:(i-1)) == $: ifFalse:[
+ ^ true.
+ ].
+ ].
].
^ false.
"
- self keyIsClassVariableNameKey:'foo::bar'
- self keyIsClassVariableNameKey:'foo:bar'
- self keyIsClassVariableNameKey:':bar'
- self keyIsClassVariableNameKey:'::bar'
+ self keyIsClassVariableNameKey:'foo::bar'
+ self keyIsClassVariableNameKey:'foo:bar'
+ self keyIsClassVariableNameKey:':bar'
+ self keyIsClassVariableNameKey:'::bar'
"
!
@@ -2374,43 +2374,43 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
- cls := self at:sym ifAbsent:nil.
- cls isBehavior ifTrue:[^ cls].
+ cls := self at:sym ifAbsent:nil.
+ cls isBehavior ifTrue:[^ cls].
].
(aString endsWith:' class') ifTrue:[
- nonMeta := self loadedClassNamed:(aString copyWithoutLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
+ nonMeta := self loadedClassNamed:(aString copyWithoutLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
].
^ nil
"
- Smalltalk loadedClassNamed:'Object'
- Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
- Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
- Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator'
- Smalltalk loadedClassNamed:'fooBar'
- Smalltalk loadedClassNamed:'true'
- Smalltalk loadedClassNamed:'Object class'
- Smalltalk loadedClassNamed:'Metaclass'
- Smalltalk loadedClassNamed:'Array'
+ Smalltalk loadedClassNamed:'Object'
+ Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
+ Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
+ Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator'
+ Smalltalk loadedClassNamed:'fooBar'
+ Smalltalk loadedClassNamed:'true'
+ Smalltalk loadedClassNamed:'Object class'
+ Smalltalk loadedClassNamed:'Metaclass'
+ Smalltalk loadedClassNamed:'Array'
Smalltalk loadedClassNamed:'Array class'
"
!
methodProtocolCompletion:aPartialProtocolName
"given a partial method protocol name, return an array consisting of
- 2 entries: 1st: the best (longest) match
- 2nd: collection consisting of matching protocols"
+ 2 entries: 1st: the best (longest) match
+ 2nd: collection consisting of matching protocols"
^ DoWhatIMeanSupport methodProtocolCompletion:aPartialProtocolName inEnvironment:self
"
- Smalltalk methodProtocolCompletion:'doc'
- Smalltalk methodProtocolCompletion:'docu'
- Smalltalk methodProtocolCompletion:'documenta'
+ Smalltalk methodProtocolCompletion:'doc'
+ Smalltalk methodProtocolCompletion:'docu'
+ Smalltalk methodProtocolCompletion:'documenta'
"
"Modified: / 10-08-2006 / 13:05:20 / cg"
@@ -2432,10 +2432,10 @@
"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].
- ]
+ aCollection do:[:anObject |
+ (key == anObject) ifTrue:[^ true].
+ (val == anObject ) ifTrue:[^ true].
+ ]
].
^ super referencesAny:aCollection
@@ -2446,8 +2446,8 @@
"redefined, since the references are only kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
- (key isKindOf:aClass) ifTrue:[^ true].
- (val isKindOf:aClass) ifTrue:[^ true].
+ (key isKindOf:aClass) ifTrue:[^ true].
+ (val isKindOf:aClass) ifTrue:[^ true].
].
^ super referencesDerivedInstanceOf:aClass
!
@@ -2456,8 +2456,8 @@
"redefined, since the references are only kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
- (key isMemberOf:aClass) ifTrue:[^ true].
- (val isMemberOf:aClass) ifTrue:[^ true].
+ (key isMemberOf:aClass) ifTrue:[^ true].
+ (val isMemberOf:aClass) ifTrue:[^ true].
].
^ super referencesInstanceOf:aClass
!
@@ -2466,8 +2466,8 @@
"redefined, since the references are only kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
- (key == anObject) ifTrue:[^ true].
- (val == anObject ) ifTrue:[^ true].
+ (key == anObject) ifTrue:[^ true].
+ (val == anObject ) ifTrue:[^ true].
].
^ super referencesObject:anObject
@@ -2489,8 +2489,8 @@
aName := nameIn.
(aName startsWith:'Smalltalk::') ifTrue:[
- aName := aName copyFrom:12.
- ^ self at:(aName asSymbol) ifAbsent:nil.
+ aName := aName copyFrom:12.
+ ^ self at:(aName asSymbol) ifAbsent:nil.
].
sym := aName asSymbol.
@@ -2500,12 +2500,12 @@
ns := aClass nameSpace.
(ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
- ns isNameSpace ifTrue:[
- cls := ns at:sym ifAbsent:nil.
- ] ifFalse:[
- cls := ns privateClassesAt:sym
- ].
- cls notNil ifTrue:[^ cls].
+ ns isNameSpace ifTrue:[
+ cls := ns at:sym ifAbsent:nil.
+ ] ifFalse:[
+ cls := ns privateClassesAt:sym
+ ].
+ cls notNil ifTrue:[^ cls].
].
^ self at:sym ifAbsent:nil.
@@ -2515,7 +2515,7 @@
selectorCompletion:aPartialSymbolName
"given a partial selector, return an array consisting of
2 entries: 1st: the longest match
- 2nd: collection consisting of matching implemented selectors"
+ 2nd: collection consisting of matching implemented selectors"
^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:self
!
@@ -2523,14 +2523,14 @@
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"
+ 2nd: collection consisting of matching implemented selectors"
^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
"
- Smalltalk selectorCompletion:'at:p'
- Smalltalk selectorCompletion:'nextP'
- Smalltalk selectorCompletion:'nextp'
+ Smalltalk selectorCompletion:'at:p'
+ Smalltalk selectorCompletion:'nextP'
+ Smalltalk selectorCompletion:'nextp'
"
"Modified: / 7.6.1996 / 08:44:33 / stefan"
@@ -2623,10 +2623,10 @@
idx := CommandLineArguments indexOf:'--browserParameters:'.
idx ~~ 0 ifTrue:[
- params := Dictionary new.
- (CommandLineArguments copyFrom:idx+1) pairWiseDo:[:key :value |
- params at:key put:value.
- ].
+ params := Dictionary new.
+ (CommandLineArguments copyFrom:idx+1) pairWiseDo:[:key :value |
+ params at:key put:value.
+ ].
].
'browserWindow is: ' errorPrint. windowID errorPrintCR.
@@ -2634,9 +2634,9 @@
'Display is: ' errorPrint. Display errorPrintCR.
process := [
- PluginSupport
- startInBrowserWithWindowID:windowID
- parameters:params.
+ PluginSupport
+ startInBrowserWithWindowID:windowID
+ parameters:params.
] newProcess.
process priority:(Processor userSchedulingPriority).
process name:'browser start handler'.
@@ -2664,25 +2664,25 @@
thisIsARestart := imageName notNil.
"
- if there is a display, start its event dispatcher
+ if there is a display, start its event dispatcher
"
Display notNil ifTrue:[
- Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
- SaveEmergencyImage == true ifTrue:[
- 'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
- ObjectMemory primSnapShotOn:'crash.img'.
- ].
- 'Display [warning]: broken display connection - exit.' infoPrintCR.
- self exit.
- ].
- Display startDispatch.
+ Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
+ SaveEmergencyImage == true ifTrue:[
+ 'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
+ ObjectMemory primSnapShotOn:'crash.img'.
+ ].
+ 'Display [warning]: broken display connection - exit.' infoPrintCR.
+ self exit.
+ ].
+ Display startDispatch.
].
idx := CommandLineArguments indexOf:'--browserWindow:'.
IsPlugin := (idx ~~ 0).
IsPlugin ifTrue:[
- self browserWindowStartup.
- "/ not reached
+ self browserWindowStartup.
+ "/ not reached
].
Initializing := false.
@@ -2693,50 +2693,50 @@
"/ Therefore, it is now done by an extra user-process.
process := [
- StartBlocks notNil ifTrue:[
- StartBlocks do:[:aBlock|
- aBlock value
- ].
- StartBlocks := nil.
- ].
- ImageStartBlocks notNil ifTrue:[
- ImageStartBlocks do:[:aBlock|
- aBlock value
- ].
- ].
- StandAlone ifFalse:[
- (SilentLoading == true) ifFalse:[ "i.e. undefined counts as false"
- thisIsARestart ifTrue:[
- Transcript cr.
- Transcript showCR:('Smalltalk restarted from:'
- , imageName
- , ' (saved '
- , ObjectMemory imageSaveTime printString
- , ')' ).
- ] ifFalse:[
- Transcript showCR:(self hello).
- Transcript showCR:(self copyrightString).
- Transcript cr.
- ].
- Transcript cr.
- ].
-
- DemoMode==true ifTrue:[
- Transcript showCR:'*** Restricted use: ***'.
- Transcript showCR:'*** This program may be used for education only. ***'.
- Transcript showCR:'*** Please read the files COPYRIGHT and LICENSE ***'.
- Transcript showCR:'*** for more details. ***'.
- Transcript cr.
- ].
- ].
-
- thisIsARestart ifTrue:[
- "/
- "/ the final late notification - users can now assume that
- "/ views, forms etc. have been recreated.
-
- ObjectMemory changed:#returnFromSnapshot.
- ]
+ StartBlocks notNil ifTrue:[
+ StartBlocks do:[:aBlock|
+ aBlock value
+ ].
+ StartBlocks := nil.
+ ].
+ ImageStartBlocks notNil ifTrue:[
+ ImageStartBlocks do:[:aBlock|
+ aBlock value
+ ].
+ ].
+ StandAlone ifFalse:[
+ (SilentLoading == true) ifFalse:[ "i.e. undefined counts as false"
+ thisIsARestart ifTrue:[
+ Transcript cr.
+ Transcript showCR:('Smalltalk restarted from:'
+ , imageName
+ , ' (saved '
+ , ObjectMemory imageSaveTime printString
+ , ')' ).
+ ] ifFalse:[
+ Transcript showCR:(self hello).
+ Transcript showCR:(self copyrightString).
+ Transcript cr.
+ ].
+ Transcript cr.
+ ].
+
+ DemoMode==true ifTrue:[
+ Transcript showCR:'*** Restricted use: ***'.
+ Transcript showCR:'*** This program may be used for education only. ***'.
+ Transcript showCR:'*** Please read the files COPYRIGHT and LICENSE ***'.
+ Transcript showCR:'*** for more details. ***'.
+ Transcript cr.
+ ].
+ ].
+
+ thisIsARestart ifTrue:[
+ "/
+ "/ the final late notification - users can now assume that
+ "/ views, forms etc. have been recreated.
+
+ ObjectMemory changed:#returnFromSnapshot.
+ ]
] newProcess.
@@ -2751,74 +2751,74 @@
"/ message.
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
- "
- allow more customization by reading an image specific rc-file
- "
- thisIsARestart ifTrue:[
- (imageName asFilename hasSuffix:'img') ifTrue:[
- imageName := imageName copyWithoutLast:4
- ].
- self fileIn:(imageName , '.rc')
- ].
+ "
+ allow more customization by reading an image specific rc-file
+ "
+ thisIsARestart ifTrue:[
+ (imageName asFilename hasSuffix:'img') ifTrue:[
+ imageName := imageName copyWithoutLast:4
+ ].
+ self fileIn:(imageName , '.rc')
+ ].
"/ Display notNil ifTrue:[
"/ Display exitOnLastClose:true.
"/ ].
"/ Processor exitWhenNoMoreUserProcesses:true.
- process := [
- StandAlone ifTrue:[
- AbortOperationRequest handle:[:ex |
- 'Smalltalk [info]: aborted - exit.' infoPrintCR.
- OperatingSystem exit:1
- ] do:[
- StartupClass perform:StartupSelector withArguments:StartupArguments.
- ]
- ] ifFalse:[
- StartupClass perform:StartupSelector withArguments:StartupArguments.
- ].
-
- "/
- "/ non-GUI apps exit after the startup;
- "/ assume that GUI apps have created & opened some view ...
- "/
- Display isNil ifTrue:[
- 'Smalltalk [info]: no Display - exit.' infoPrintCR.
- Smalltalk exit.
- ].
- "/
- "/ GUI apps exit after the last user process has finished
- "/
- Display exitOnLastClose:true.
- Processor exitWhenNoMoreUserProcesses:true.
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
- process := true. "do not refer to process"
+ process := [
+ StandAlone ifTrue:[
+ AbortOperationRequest handle:[:ex |
+ 'Smalltalk [info]: aborted - exit.' infoPrintCR.
+ OperatingSystem exit:1
+ ] do:[
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
+ ]
+ ] ifFalse:[
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
+ ].
+
+ "/
+ "/ non-GUI apps exit after the startup;
+ "/ assume that GUI apps have created & opened some view ...
+ "/
+ Display isNil ifTrue:[
+ 'Smalltalk [info]: no Display - exit.' infoPrintCR.
+ Smalltalk exit.
+ ].
+ "/
+ "/ GUI apps exit after the last user process has finished
+ "/
+ Display exitOnLastClose:true.
+ Processor exitWhenNoMoreUserProcesses:true.
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+ process := true. "do not refer to process"
].
StandAlone ifTrue:[
- Display notNil ifTrue:[
- FlyByHelp notNil ifTrue:[
- FlyByHelp start
- ].
- ].
+ Display notNil ifTrue:[
+ FlyByHelp notNil ifTrue:[
+ FlyByHelp start
+ ].
+ ].
].
"
if view-classes exist, start dispatching;
otherwise go into a read-eval-print loop
"
- ((Display notNil and:[graphicalMode])
+ ((Display notNil and:[graphicalMode])
or:[process notNil
or:[HeadlessOperation]]) ifTrue:[
- Processor dispatchLoop.
+ Processor dispatchLoop.
] ifFalse:[
- StandAlone ifFalse:[
- self readEvalPrint
- ]
+ StandAlone ifFalse:[
+ self readEvalPrint
+ ]
].
"done - the last process finished"
@@ -2841,20 +2841,20 @@
'ST- ' print.
Stdin skipSeparators.
Stdin atEnd ifFalse:[
- text := Stdin nextChunk.
- [text notNil] whileTrue:[
- AbortAllOperationRequest handle:[:ex |
- 'evaluation aborted' printCR
- ] do:[
- Compiler isNil ifTrue:[
- 'No evaluator class available (Compiler == nil)' printCR.
- ^ self
- ].
- (Compiler evaluate:text) printCR.
- ].
- 'ST- ' print.
- text := Stdin nextChunk
- ].
+ text := Stdin nextChunk.
+ [text notNil] whileTrue:[
+ AbortAllOperationRequest handle:[:ex |
+ 'evaluation aborted' printCR
+ ] do:[
+ Compiler isNil ifTrue:[
+ 'No evaluator class available (Compiler == nil)' printCR.
+ ^ self
+ ].
+ (Compiler evaluate:text) printCR.
+ ].
+ 'ST- ' print.
+ text := Stdin nextChunk
+ ].
].
'' printCR
!
@@ -2867,15 +2867,15 @@
#earlySystemInstallation is sent for ST80 compatibility
#earlyRestart is send first, nothing has been setup yet.
- (should be used to flush all device dependent entries)
+ (should be used to flush all device dependent entries)
#restarted is send right after.
- (should be used to recreate external resources (fds, bitmaps etc)
+ (should be used to recreate external resources (fds, bitmaps etc)
#returnFromSnapshot is sent last
- (should be used to restart processes, reOpen Streams which cannot
- be automatically be reopened (i.e. Sockets, Pipes) and so on.
- (Notice that positionable fileStreams are already reopened and repositioned)
+ (should be used to restart processes, reOpen Streams which cannot
+ be automatically be reopened (i.e. Sockets, Pipes) and so on.
+ (Notice that positionable fileStreams are already reopened and repositioned)
"
|deb insp transcript idx|
@@ -2899,12 +2899,12 @@
idx := CommandLineArguments indexOf:'-q'.
idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--silent'.
+ idx := CommandLineArguments indexOf:'--silent'.
].
idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
].
"/
@@ -2927,19 +2927,19 @@
self reinitStandardStreams.
"/
- "/ redirect Transcript to Stderr during startup
-
- transcript := Transcript.
+ "/ redirect Transcript to Stderr during startup
+
+ transcript := Transcript.
Transcript := Stderr.
"/
- "/ temporary switch back to dumb interface -
+ "/ temporary switch back to dumb interface -
"/ to handle errors while view-stuff is not yet reinitialized
insp := Inspector.
deb := Debugger.
deb notNil ifTrue:[
- deb reinitialize
+ deb reinitialize
].
Inspector := MiniInspector.
Debugger := MiniDebugger.
@@ -2952,7 +2952,7 @@
"/ ObjectFileLoader; therefore, must reload before doing any notifications.
ObjectFileLoader notNil ifTrue:[
- ObjectFileLoader reloadAllRememberedObjectFiles.
+ ObjectFileLoader reloadAllRememberedObjectFiles.
].
"/
@@ -2961,9 +2961,9 @@
"/ a display during early startup.
Screen notNil ifTrue:[
- Screen allScreens do:[:aDisplay |
- aDisplay invalidateConnection
- ].
+ Screen allScreens do:[:aDisplay |
+ aDisplay invalidateConnection
+ ].
].
ObjectMemory changed:#earlySystemInstallation.
@@ -2979,7 +2979,7 @@
"/ (mostly view/GC/color & font stuff)
ObjectMemory
- changed:#earlyRestart; changed:#restarted.
+ changed:#earlyRestart; changed:#restarted.
"/
"/ start catching SIGINT and SIGQUIT
@@ -2992,78 +2992,78 @@
idx := CommandLineArguments indexOf:'--faststart'.
idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--fastStart'.
+ idx := CommandLineArguments indexOf:'--fastStart'.
].
idx ~~ 0 ifTrue:[
- CommandLineArguments removeAtIndex:idx.
+ CommandLineArguments removeAtIndex:idx.
] ifFalse:[
- CallbackSignal := QuerySignal new.
- [
- Class withoutUpdatingChangesDo:[
- (self fileIn:(self commandName , '_r.rc')) ifFalse:[
- "no _r.rc file where executable is; try default smalltalk_r.rc"
- self fileIn:'smalltalk_r.rc'
- ].
- ]
- ] on:CallbackSignal do:[:ex|
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
- ex proceed.
- ].
- CallbackSignal := nil.
+ CallbackSignal := QuerySignal new.
+ [
+ Class withoutUpdatingChangesDo:[
+ (self fileIn:(self commandName , '_r.rc')) ifFalse:[
+ "no _r.rc file where executable is; try default smalltalk_r.rc"
+ self fileIn:'smalltalk_r.rc'
+ ].
+ ]
+ ] on:CallbackSignal do:[:ex|
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
+ ex proceed.
+ ].
+ CallbackSignal := nil.
].
"/ reinitialization (restart) of Display is normally performed
"/ in the restart script. If this has not been run for some reason,
"/ do in now.
Initializing ifTrue:[
- Display notNil ifTrue:[
- [
- Display reinitializeFor:Screen defaultDisplayName.
- ] on:Screen deviceOpenErrorSignal do:[
- 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
- Screen defaultDisplayName errorPrintCR.
- OperatingSystem exit:1.
- ].
- ].
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
+ Display notNil ifTrue:[
+ [
+ Display reinitializeFor:Screen defaultDisplayName.
+ ] on:Screen deviceOpenErrorSignal do:[
+ 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
+ Screen defaultDisplayName errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ].
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
].
Screen notNil ifTrue:[
- "clean up leftover screens (and views) that haven't been reopened.
- Operate on a copy, since brokenConnection removes us from AllScreens"
- Screen allScreens copy do:[:eachDisplay |
- eachDisplay isOpen ifFalse:[
- 'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
- eachDisplay errorPrintCR.
- eachDisplay cleanupAfterDispatch; brokenConnection.
- ]
- ].
- ].
-
- deb := insp := transcript := nil. "avoid dangling refs"
+ "clean up leftover screens (and views) that haven't been reopened.
+ Operate on a copy, since brokenConnection removes us from AllScreens"
+ Screen allScreens copy do:[:eachDisplay |
+ eachDisplay isOpen ifFalse:[
+ 'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
+ eachDisplay errorPrintCR.
+ eachDisplay cleanupAfterDispatch; brokenConnection.
+ ]
+ ].
+ ].
+
+ deb := insp := transcript := nil. "avoid dangling refs"
self mainStartup:true
"Modified: / 7.6.1998 / 02:48:00 / cg"
@@ -3083,184 +3083,184 @@
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |myName defaultRC prevCatchSetting|
-
- "/
- "/ look for any '-q', '-e' or '-f' command line arguments
- "/ and handle them;
- "/ read startup and patches file
- "/
- idx := CommandLineArguments indexOf:'-q'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--silent'.
- ].
- idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
- ].
-
- StandAlone ifFalse:[
- "/ look for a '-e filename' or '--execute filename' argument
- "/ this will force fileIn of filename only, no standard startup.
-
- idx := CommandLineArguments indexOf:'-e'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--execute'.
- ].
- idx ~~ 0 ifTrue:[
- arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- arg = '-' ifTrue:[
- self fileInStream:Stdin
- lazy:nil
- silent:nil
- logged:false
- addPath:nil
- ] ifFalse:[
- self fileIn:arg.
- ].
- self exit
- ].
-
- "/ look for a '-E expr' or '--eval expr' argument
- "/ this will force evaluation of expr only, no standard startup
- idx := CommandLineArguments indexOf:'-E'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--eval'.
- ].
- idx ~~ 0 ifTrue:[
- arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- self
- fileInStream:arg readStream
- lazy:nil
- silent:nil
- logged:false
- addPath:nil.
-
- self exit
- ].
- ].
-
- "look for a '-f filename' or '--file filename' argument
- this will force evaluation of filename instead of smalltalk.rc"
+ |myName defaultRC prevCatchSetting|
+
+ "/
+ "/ look for any '-q', '-e' or '-f' command line arguments
+ "/ and handle them;
+ "/ read startup and patches file
+ "/
+ idx := CommandLineArguments indexOf:'-q'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--silent'.
+ ].
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ ].
+
+ StandAlone ifFalse:[
+ "/ look for a '-e filename' or '--execute filename' argument
+ "/ this will force fileIn of filename only, no standard startup.
+
+ idx := CommandLineArguments indexOf:'-e'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--execute'.
+ ].
+ idx ~~ 0 ifTrue:[
+ arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ arg = '-' ifTrue:[
+ self fileInStream:Stdin
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil
+ ] ifFalse:[
+ self fileIn:arg.
+ ].
+ self exit
+ ].
+
+ "/ look for a '-E expr' or '--eval expr' argument
+ "/ this will force evaluation of expr only, no standard startup
+ idx := CommandLineArguments indexOf:'-E'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--eval'.
+ ].
+ idx ~~ 0 ifTrue:[
+ arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ self
+ fileInStream:arg readStream
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil.
+
+ self exit
+ ].
+ ].
+
+ "look for a '-f filename' or '--file filename' argument
+ this will force evaluation of filename instead of smalltalk.rc"
"/ "If there is only one argument, which does not start with a '-',
"/ this is the same as -f filename"
-"/ (CommandLineArguments size == 1
+"/ (CommandLineArguments size == 1
"/ and:[(CommandLineArguments first startsWith:$-) not]) ifTrue:[
"/ myName := CommandLineArguments removeFirst.
"/ ].
- myName isNil ifTrue:[
- idx := CommandLineArguments indexOf:'-f'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--file'.
- ].
- idx ~~ 0 ifTrue:[
- myName := CommandLineArguments at:idx+1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- ].
- ].
- myName notNil ifTrue:[
- CommandName := myName.
- (self secureFileIn:myName) ifFalse:[
- ('Smalltalk [error]: startup file ', myName, ' not found.') errorPrintCR.
- OperatingSystem exit:1.
- ].
- ] ifFalse:[
- "/ look for <command>.rc
- "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
-
- didReadRCFile := false.
-
- myName := self commandName asFilename withSuffix:'rc'.
- (didReadRCFile := self secureFileIn:myName) ifFalse:[
- StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc'
- ] ifTrue:[
- defaultRC := 'stxapp.rc'
- ].
-
- didReadRCFile := self secureFileIn:defaultRC.
- didReadRCFile ifFalse:[
- StandAlone ifFalse:[
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ]
- ]
- ].
-
- "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
- "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
- "/ ('Display is %1' bindWith:Display) printCR.
- "/ ('Screen is %1' bindWith:Screen) printCR.
-
- didReadRCFile ifFalse:[
- "/
- "/ No RC file found;
- "/ Setup more default stuff
- "/
- StandAlone ifFalse:[
- "/ its a smalltalk - proceed in interpreter.
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ] ifTrue:[
- "/ its an application - try harder
-
- Screen notNil ifTrue:[
- [
- Screen openDefaultDisplay:nil.
- ] on:Screen deviceOpenErrorSignal do:[:ex|
- ('Smalltalk [error]: No Display connection to: ', ex parameter printString) errorPrintCR.
- 'Smalltalk [info]: Either set the DISPLAY environment variable,' infoPrintCR.
- 'Smalltalk [info]: or start smalltalk with a -display argument.' infoPrintCR.
- HeadlessOperation == true ifFalse:[
- OperatingSystem exit:1.
- ].
- ].
-
- Display notNil ifTrue:[
- (self secureFileIn:'display.rc') ifFalse:[
- "/ 'Smalltalk [warning]: no display.rc found; screen setting might be wrong.' errorPrintCR.
- (self secureFileIn:'keyboard.rc') ifFalse:[
- "/ 'Smalltalk [warning]: no keyboard.rc found; shortkey setting might be wrong.' errorPrintCR.
- ]
- ]
- ].
- ]
- ].
-
- "/ setup more defaults...
- ObjectMemory startBackgroundCollectorAt:5.
- ObjectMemory startBackgroundFinalizationAt:5.
- self addStartBlock:[
- Processor startTimeSlicing.
- Processor supportDynamicPriorities:true.
- ObjectMemory backgroundCollectProcess priorityRange:(4 to:9).
- ObjectMemory backgroundFinalizationProcess priorityRange:(4 to:9).
- ].
- ].
- ].
+ myName isNil ifTrue:[
+ idx := CommandLineArguments indexOf:'-f'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--file'.
+ ].
+ idx ~~ 0 ifTrue:[
+ myName := CommandLineArguments at:idx+1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ ].
+ ].
+ myName notNil ifTrue:[
+ CommandName := myName.
+ (self secureFileIn:myName) ifFalse:[
+ ('Smalltalk [error]: startup file ', myName, ' not found.') errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ] ifFalse:[
+ "/ look for <command>.rc
+ "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
+
+ didReadRCFile := false.
+
+ myName := self commandName asFilename withSuffix:'rc'.
+ (didReadRCFile := self secureFileIn:myName) ifFalse:[
+ StandAlone ifFalse:[
+ defaultRC := 'smalltalk.rc'
+ ] ifTrue:[
+ defaultRC := 'stxapp.rc'
+ ].
+
+ didReadRCFile := self secureFileIn:defaultRC.
+ didReadRCFile ifFalse:[
+ StandAlone ifFalse:[
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ]
+ ]
+ ].
+
+ "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
+ "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
+ "/ ('Display is %1' bindWith:Display) printCR.
+ "/ ('Screen is %1' bindWith:Screen) printCR.
+
+ didReadRCFile ifFalse:[
+ "/
+ "/ No RC file found;
+ "/ Setup more default stuff
+ "/
+ StandAlone ifFalse:[
+ "/ its a smalltalk - proceed in interpreter.
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ] ifTrue:[
+ "/ its an application - try harder
+
+ Screen notNil ifTrue:[
+ [
+ Screen openDefaultDisplay:nil.
+ ] on:Screen deviceOpenErrorSignal do:[:ex|
+ ('Smalltalk [error]: No Display connection to: ', ex parameter printString) errorPrintCR.
+ 'Smalltalk [info]: Either set the DISPLAY environment variable,' infoPrintCR.
+ 'Smalltalk [info]: or start smalltalk with a -display argument.' infoPrintCR.
+ HeadlessOperation == true ifFalse:[
+ OperatingSystem exit:1.
+ ].
+ ].
+
+ Display notNil ifTrue:[
+ (self secureFileIn:'display.rc') ifFalse:[
+ "/ 'Smalltalk [warning]: no display.rc found; screen setting might be wrong.' errorPrintCR.
+ (self secureFileIn:'keyboard.rc') ifFalse:[
+ "/ 'Smalltalk [warning]: no keyboard.rc found; shortkey setting might be wrong.' errorPrintCR.
+ ]
+ ]
+ ].
+ ]
+ ].
+
+ "/ setup more defaults...
+ ObjectMemory startBackgroundCollectorAt:5.
+ ObjectMemory startBackgroundFinalizationAt:5.
+ self addStartBlock:[
+ Processor startTimeSlicing.
+ Processor supportDynamicPriorities:true.
+ ObjectMemory backgroundCollectProcess priorityRange:(4 to:9).
+ ObjectMemory backgroundFinalizationProcess priorityRange:(4 to:9).
+ ].
+ ].
+ ].
].
StandAlone ifFalse:[
- "
- enable the graphical debugger/inspector
- (they could have been (re)defined as autoloaded in the patches file)
- "
- self initStandardTools.
+ "
+ enable the graphical debugger/inspector
+ (they could have been (re)defined as autoloaded in the patches file)
+ "
+ self initStandardTools.
].
(Display isNil or:[HeadlessOperation]) ifTrue:[
- graphicalMode := false.
+ graphicalMode := false.
].
self mainStartup:graphicalMode
@@ -3276,7 +3276,7 @@
^ CommandLine
"
- Smalltalk commandLine
+ Smalltalk commandLine
"
"Created: 19.7.1996 / 11:09:06 / cg"
@@ -3290,7 +3290,7 @@
args := self commandLineArguments.
index := args indexOf:aString.
(index between:1 and:(args size - 1)) ifTrue:[
- ^ args at:index+1
+ ^ args at:index+1
].
^ nil.
@@ -3313,7 +3313,7 @@
!
commandName
- "return the excutables name - this is normally 'stx',
+ "return the excutables name - this is normally 'stx',
but can be something else for standAlone apps."
^ CommandName.
@@ -3332,7 +3332,7 @@
^ HasNoConsole ? false
"
- Smalltalk hasNoConsole
+ Smalltalk hasNoConsole
"
!
@@ -3343,7 +3343,7 @@
^ HeadlessOperation ? false
"
- Smalltalk isHeadless
+ Smalltalk isHeadless
"
!
@@ -3354,7 +3354,7 @@
^ IsPlugin ? false
"
- Smalltalk isPlugin
+ Smalltalk isPlugin
"
!
@@ -3365,7 +3365,7 @@
^ IsSharedLibraryComponent ? false
"
- Smalltalk isSharedLibraryComponent
+ Smalltalk isSharedLibraryComponent
"
"Created: / 10-08-2006 / 13:09:34 / cg"
@@ -3378,11 +3378,11 @@
and NOT a sharedLibrary component (i.e. a dll in another app)."
^ self isPlugin not
- and:[ self isSharedLibraryComponent not
+ and:[ self isSharedLibraryComponent not
and:[ self isStandAloneApp not ]]
"
- Smalltalk isSmalltalkDevelopmentSystem
+ Smalltalk isSmalltalkDevelopmentSystem
"
"Created: / 10-08-2006 / 13:12:49 / cg"
@@ -3396,33 +3396,33 @@
^ StandAlone ? false
"
- Smalltalk isStandAloneApp
+ Smalltalk isStandAloneApp
"
!
startupArguments
"return the arguments passed to StartupClass when stx gets started.
- Usually these are nil,
+ Usually these are nil,
but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
a simple way to configure and create stand-alone applications"
^ StartupArguments
"
- Smalltalk startupArguments
+ Smalltalk startupArguments
"
!
startupClass
"return the class, that will get the start message when smalltalk
- starts and its non-nil. Usually this is nil,
+ starts and its non-nil. Usually this is nil,
but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
a simple way to configure and create stand-alone applications"
^ StartupClass
"
- Smalltalk startupClass
+ Smalltalk startupClass
"
!
@@ -3440,19 +3440,19 @@
startupSelector
"return the selector, that will be sent to StartupClass.
- Usually this is nil,
+ Usually this is nil,
but saving an image with a non-nil StartupClass/StartupSelector allows for
a simple way to configure and create stand-alone applications"
^ StartupSelector
"
- Smalltalk startupSelector
+ Smalltalk startupSelector
"
!
wasStartedFromImage
- "return true, if this smalltalk was started from an image,
+ "return true, if this smalltalk was started from an image,
as opposed to a fresh and clean startup"
^ ImageRestartTime notNil
@@ -3508,7 +3508,7 @@
Time now
Smalltalk languageTerritory:#de.
- Time now
+ Time now
"
"Modified: 26.4.1996 / 17:12:39 / cg"
@@ -3546,26 +3546,26 @@
table := IdentityDictionary new:100.
Method allSubInstancesDo:[:aMethod |
- source := nil.
- aMethod sourcePosition notNil ifTrue:[
- aMethod sourceFilename = 'st.src' ifTrue:[
- source := aMethod source.
- ]
- ] ifFalse:[
- source := aMethod source
- ].
-
- source notNil ifTrue:[
- pos := newStream position1Based.
- newStream nextChunkPut:source.
-
- "
- dont change the methods info - maybe some write error
- occurs later, in that case we abort and leave everything
- untouched.
- "
- table at:aMethod put:pos
- ]
+ source := nil.
+ aMethod sourcePosition notNil ifTrue:[
+ aMethod sourceFilename = 'st.src' ifTrue:[
+ source := aMethod source.
+ ]
+ ] ifFalse:[
+ source := aMethod source
+ ].
+
+ source notNil ifTrue:[
+ pos := newStream position1Based.
+ newStream nextChunkPut:source.
+
+ "
+ dont change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
].
newStream close.
@@ -3580,7 +3580,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -3598,7 +3598,7 @@
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
- only 3 files (executable, image and sourceFile) need to be
+ only 3 files (executable, image and sourceFile) need to be
transported."
|newStream table source pos fileName|
@@ -3608,18 +3608,18 @@
table := IdentityDictionary new:100.
Method allSubInstancesDo:[:aMethod |
- source := aMethod source.
- source notNil ifTrue:[
- pos := newStream position1Based.
- newStream nextChunkPut:source.
-
- "
- dont change the methods info - maybe some write error
- occurs later, in that case we abort and leave everything
- untouched.
- "
- table at:aMethod put:pos
- ]
+ source := aMethod source.
+ source notNil ifTrue:[
+ pos := newStream position1Based.
+ newStream nextChunkPut:source.
+
+ "
+ dont change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
].
newStream close.
@@ -3634,7 +3634,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -3646,18 +3646,18 @@
"Created: 17.10.1997 / 13:00:56 / cg"
!
-installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil
+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.
+ ^ self
+ installAutoloadedClassNamed:clsName
+ category:cat
+ package:package
+ revision:revisionOrNil
+ numClassInstVars:nil.
!
installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:numClassInstVarsOrNil
@@ -3672,30 +3672,30 @@
"/ install if not already compiled-in
(cls := self at:clsSym) isNil ifTrue:[
- Autoload subclass:clsSym
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:cat
- inEnvironment:Smalltalk.
-
- cls := self at:clsSym.
- cls isNil ifTrue:[
- ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
- ] ifFalse:[
- cls package:package asSymbol.
- revisionOrNil notNil ifTrue:[
- cls setBinaryRevision:revisionOrNil
- ]
- ]
+ Autoload subclass:clsSym
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:cat
+ inEnvironment:Smalltalk.
+
+ cls := self at:clsSym.
+ cls isNil ifTrue:[
+ ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
+ ] ifFalse:[
+ cls package:package asSymbol.
+ revisionOrNil notNil ifTrue:[
+ cls setBinaryRevision:revisionOrNil
+ ]
+ ]
] ifFalse:[
- "/ class already present - however, check for category/package change
- package ~= cls package ifTrue:[
- cls package:package asSymbol.
- ].
- cat ~= cls category ifTrue:[
- cls category:cat.
- ].
+ "/ class already present - however, check for category/package change
+ package ~= cls package ifTrue:[
+ cls package:package asSymbol.
+ ].
+ cat ~= cls category ifTrue:[
+ cls category:cat.
+ ].
].
^ cls.
@@ -3714,26 +3714,26 @@
"/ along the package-path
(p := self packagePath) do:[:aPath |
- (dirsConsulted includes:aPath) ifFalse:[
- ('Smalltalk [info]: installing autoloaded classes found under ''' , aPath ,'''') infoPrintCR.
- self
- recursiveInstallAutoloadedClassesFrom:aPath
- rememberIn:dirsConsulted
- maxLevels:15
- noAutoload:false
- packageTop:aPath.
- ]
+ (dirsConsulted includes:aPath) ifFalse:[
+ ('Smalltalk [info]: installing autoloaded classes found under ''' , aPath ,'''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:aPath
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:aPath.
+ ]
].
p size == 0 ifTrue:[
- '../../../stx' asFilename exists ifTrue:[
- ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
- self
- recursiveInstallAutoloadedClassesFrom:'../../..'
- rememberIn:dirsConsulted
- maxLevels:15
- noAutoload:false
- packageTop:'../../..'.
- ].
+ '../../../stx' asFilename exists ifTrue:[
+ ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:'../../..'
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:'../../..'.
+ ].
].
"
@@ -3754,15 +3754,15 @@
f isNil ifTrue:[f := self getPackageFileName:anAbbrevFilePath].
f notNil ifTrue:[
- f := f asFilename.
- f isDirectory ifTrue:[
- f := f construct:'abbrev.stc'
- ].
- [
- s := f readStream.
- self installAutoloadedClassesFromStream:s.
- s close.
- ] on:FileStream openErrorSignal do:[:ex| "do nothing"].
+ f := f asFilename.
+ f isDirectory ifTrue:[
+ f := f construct:'abbrev.stc'
+ ].
+ [
+ s := f readStream.
+ self installAutoloadedClassesFromStream:s.
+ s close.
+ ] on:FileStream openErrorSignal do:[:ex| "do nothing"].
]
"
@@ -3773,7 +3773,7 @@
!
installAutoloadedClassesFromStream:anAbbrevFileStream
- "read the given abbreviation file;
+ "read the given abbreviation file;
install all classes found there as autoloaded, and also update the
abbreviation (className-to-fileName mapping) table.
This takes some time ..."
@@ -3781,76 +3781,76 @@
|s2 l abbrevFileName info clsName cls abbrev package cat numClassInstVars words w|
anAbbrevFileStream isFileStream ifTrue:[
- abbrevFileName := anAbbrevFileStream pathName.
- info := 'declared from: ', abbrevFileName.
+ abbrevFileName := anAbbrevFileStream pathName.
+ info := 'declared from: ', abbrevFileName.
].
KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
+ KnownPackages := Set new.
].
"/ yes, create any required nameSpace, without asking user.
Class createNameSpaceQuerySignal answer:true do:[
- [anAbbrevFileStream atEnd] whileFalse:[
- l := anAbbrevFileStream nextLine withoutSeparators.
- l notEmpty ifTrue:[
- "/ must do it manually, caring for quoted strings.
+ [anAbbrevFileStream atEnd] whileFalse:[
+ l := anAbbrevFileStream nextLine withoutSeparators.
+ l notEmpty ifTrue:[
+ "/ must do it manually, caring for quoted strings.
"/ words := line asCollectionOfWords.
- words := OrderedCollection new.
- s2 := l readStream.
- [s2 atEnd] whileFalse:[
- s2 skipSeparators.
- s2 peek == $' ifTrue:[
- s2 next.
- w := s2 upTo:$'.
- s2 skipSeparators.
- ] ifFalse:[
- w := s2 upToSeparator
- ].
- words add:w
- ].
- words size < 3 ifTrue:[
- 'Smalltalk [warning]: bad abbrev entry' errorPrint.
- anAbbrevFileStream isFileStream ifTrue:[
- ' (in ''' errorPrint.
- anAbbrevFileStream pathName errorPrint.
- ''')' errorPrint
- ].
- ': ' errorPrint. l errorPrintCR
- ] ifFalse:[
- clsName := (words at:1) asSymbol.
- 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].
+ words := OrderedCollection new.
+ s2 := l readStream.
+ [s2 atEnd] whileFalse:[
+ s2 skipSeparators.
+ s2 peek == $' ifTrue:[
+ s2 next.
+ w := s2 upTo:$'.
+ s2 skipSeparators.
+ ] ifFalse:[
+ w := s2 upToSeparator
+ ].
+ words add:w
+ ].
+ words size < 3 ifTrue:[
+ 'Smalltalk [warning]: bad abbrev entry' errorPrint.
+ anAbbrevFileStream isFileStream ifTrue:[
+ ' (in ''' errorPrint.
+ anAbbrevFileStream pathName errorPrint.
+ ''')' errorPrint
+ ].
+ ': ' errorPrint. l errorPrintCR
+ ] ifFalse:[
+ clsName := (words at:1) asSymbol.
+ 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:[
- cat := 'autoloaded'
- ].
-
- "/ on the fly, update the abbreviations
- self setFilename:abbrev forClass:clsName package:package.
-
- "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
-
- cls := self
- installAutoloadedClassNamed:clsName
- category:cat
- package:package
- revision:nil
- numClassInstVars:numClassInstVars.
+ (cat size == 0) ifTrue:[
+ cat := 'autoloaded'
+ ].
+
+ "/ on the fly, update the abbreviations
+ self setFilename:abbrev forClass:clsName package:package.
+
+ "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
+
+ cls := self
+ installAutoloadedClassNamed:clsName
+ category:cat
+ package:package
+ revision:nil
+ numClassInstVars:numClassInstVars.
"/ info notNil ifTrue:[
"/ cls setComment:info.
"/ ].
- ]
- ]
- ]
+ ]
+ ]
+ ]
]
!
@@ -3867,11 +3867,11 @@
"turn on/off loading of binary objects"
aBoolean ifTrue:[
- (ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
- LoadBinaries := true.
- ^ self
- ].
- 'Smalltalk [info]: this system does not support binary loading' infoPrintCR.
+ (ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
+ LoadBinaries := true.
+ ^ self
+ ].
+ 'Smalltalk [info]: this system does not support binary loading' infoPrintCR.
].
LoadBinaries := false
@@ -3896,7 +3896,7 @@
"{ Pragma: +optSpace }"
"turn on/off logging of doits in the changes file.
- By default, this is off, since it can blow up the
+ By default, this is off, since it can blow up the
changes file enormously ...
"
@@ -3912,14 +3912,14 @@
Experimental and not yet used."
Method allSubInstancesDo:[:aMethod |
- |newMethod|
-
- aMethod hasPrimitiveCode ifFalse:[
- newMethod := aMethod asByteCodeMethod.
- newMethod ~~ aMethod ifTrue:[
- aMethod becomeSameAs:newMethod
- ]
- ].
+ |newMethod|
+
+ aMethod hasPrimitiveCode ifFalse:[
+ newMethod := aMethod asByteCodeMethod.
+ newMethod ~~ aMethod ifTrue:[
+ aMethod becomeSameAs:newMethod
+ ]
+ ].
].
"
@@ -3941,42 +3941,42 @@
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
(dirsConsulted includes:dir pathName) ifTrue:[
- ^ self
+ ^ self
].
dirsConsulted add:dir pathName.
(dir construct:'NOPACKAGES') exists ifTrue:[
- ^ self.
+ ^ self.
].
(dir construct:'NOSUBAUTOLOAD') exists ifTrue:[
- ^ self.
+ ^ self.
].
noAutoloadHere := noAutoloadIn.
noAutoloadHere ifFalse:[
- (dir construct:'NOAUTOLOAD') exists ifTrue:[
- noAutoloadHere := true.
- ].
+ (dir construct:'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
] ifTrue:[
- (dir construct:'AUTOLOAD') exists ifTrue:[
- noAutoloadHere := false.
- ].
+ (dir construct:'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
].
((dir construct:'loadAll') exists
or:[(dir construct:'abbrev.stc') exists
or:[(dir construct:(dir baseName , '.prj')) exists]]) ifTrue:[
- KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
- ].
- dirName := dir pathName.
- pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
- KnownPackages add:pkgName
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+ dirName := dir pathName.
+ pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
+ KnownPackages add:pkgName
].
"/
@@ -3984,54 +3984,54 @@
"/ below; however, still traverse the directories to find packages ...
"/
noAutoloadHere ifFalse:[
- [
- abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
- self installAutoloadedClassesFromStream:abbrevStream.
- abbrevStream close.
- ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
+ [
+ abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+ self installAutoloadedClassesFromStream:abbrevStream.
+ abbrevStream close.
+ ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
].
[
- directoryContents := dir directoryContents.
+ directoryContents := dir directoryContents.
] on:FileStream openErrorSignal do:[:ex|
- "non-accessable directory: we are done"
- ^ self
+ "non-accessable directory: we are done"
+ ^ self
].
directoryContents do:[:aFilename |
- |f|
-
- (#(
- 'objbc'
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- 'not_delivered'
- 'not_ported'
- ) includes:aFilename) ifFalse:[
- ((dir baseName ~= 'stx')
- or:[
- (#(
- 'configurations'
- 'include'
- 'rules'
- 'stc'
- 'support'
- ) includes:aFilename) not])
- ifTrue:[
- f := dir construct:aFilename.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath.
- ]
- ]
- ].
+ |f|
+
+ (#(
+ 'objbc'
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ 'not_delivered'
+ 'not_ported'
+ ) includes:aFilename) ifFalse:[
+ ((dir baseName ~= 'stx')
+ or:[
+ (#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ) includes:aFilename) not])
+ ifTrue:[
+ f := dir construct:aFilename.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath.
+ ]
+ ]
+ ].
].
"
@@ -4046,15 +4046,15 @@
toAdd := OrderedCollection new.
self keysAndValuesDo:[:key :val |
- (key == anObject) ifTrue:[
- self shouldImplement.
- ].
- (val == anObject ) ifTrue:[
- toAdd add:(key -> newRef)
- ].
+ (key == anObject) ifTrue:[
+ self shouldImplement.
+ ].
+ (val == anObject ) ifTrue:[
+ toAdd add:(key -> newRef)
+ ].
].
toAdd do:[:each |
- self at:(each key) put:(each value)
+ self at:(each key) put:(each value)
].
!
@@ -4064,7 +4064,7 @@
The default is true.
This may be useful, if you work with an unsecure display
(serial line), and want to have a chance of proceeding after
- a crash. In multiheaded applications, this only affects
+ a crash. In multiheaded applications, this only affects
crashes of the master Display connection (the initial connection);
errors on other displays are reported to the views and treated
like window destroy from the windowManager."
@@ -4096,12 +4096,12 @@
"read in the named file - look for it in some standard places;
return true if ok, false if failed.
This method can load almost anything which makes sense:
- .st - source files
- .cls - binary smalltalk bytecode files
- .so - binary compiled machine code class libraries
- [.class - java bytecode -- soon to come]"
-
- ^ self fileIn:aFileName lazy:nil silent:nil logged:false
+ .st - source files
+ .cls - binary smalltalk bytecode files
+ .so - binary compiled machine code class libraries
+ [.class - java bytecode -- soon to come]"
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:false
"
Smalltalk fileIn:'source/TicTacToe.st'
@@ -4134,7 +4134,7 @@
Since no syntax checks are done when doing lazy fileIn, use this only for
code which is known to be syntactically correct."
- ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
+ ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
"
Smalltalk fileIn:'source/TicTacToe.st' lazy:true
@@ -4170,10 +4170,10 @@
If silent is true, no compiler messages are output to the transcript.
Giving nil for silent/lazy will use the current settings.
This method can load almost anything which makes sense:
- .st - source files
- .cls - binary smalltalk bytecode files
- .so - binary compiled machine code class libraries
- [.class - java bytecode -- soon to come]"
+ .st - source files
+ .cls - binary smalltalk bytecode files
+ .so - binary compiled machine code class libraries
+ [.class - java bytecode -- soon to come]"
|fileNameString aStream path morePath bos|
@@ -4184,42 +4184,42 @@
"
(ObjectFileLoader notNil
and:[ObjectFileLoader hasValidBinaryExtension:fileNameString]) ifTrue:[
- "/ LoadBinaries ifFalse:[^ false].
- path := self getBinaryFileName:fileNameString.
- path isNil ifTrue:[
- path := self getSystemFileName:fileNameString.
- ].
- path isNil ifTrue:[^ false].
- ^ (ObjectFileLoader loadObjectFile:path) notNil
+ "/ LoadBinaries ifFalse:[^ false].
+ path := self getBinaryFileName:fileNameString.
+ path isNil ifTrue:[
+ path := self getSystemFileName:fileNameString.
+ ].
+ path isNil ifTrue:[^ false].
+ ^ (ObjectFileLoader loadObjectFile:path) notNil
].
(fileNameString asFilename hasSuffix:'cls') ifTrue:[
- BinaryObjectStorage notNil ifTrue:[
- aStream := self systemFileStreamFor:fileNameString.
+ BinaryObjectStorage notNil ifTrue:[
+ aStream := self systemFileStreamFor:fileNameString.
"/ path := self getBinaryFileName:fileNameString.
"/ path isNil ifTrue:[^ false].
"/ aStream := path asFilename readStream.
- aStream notNil ifTrue:[
- aStream binary.
- bos := BinaryObjectStorage onOld:aStream.
- bos next.
- bos close.
- ^ true
- ].
- ^ false
- ]
+ aStream notNil ifTrue:[
+ aStream binary.
+ bos := BinaryObjectStorage onOld:aStream.
+ bos next.
+ bos close.
+ ^ true
+ ].
+ ^ false
+ ]
].
aStream := self systemFileStreamFor:fileNameString.
aStream isNil ifTrue:[^ false].
(fileNameString includes:$/) ifTrue:[
- "/ temporarily prepend the files directory
- "/ to the searchPath.
- "/ This allows fileIn-driver files to refer to local
- "/ files via a relative path, and drivers to fileIn other
- "/ drivers ...
- morePath := aStream pathName asFilename directoryName.
+ "/ temporarily prepend the files directory
+ "/ to the searchPath.
+ "/ This allows fileIn-driver files to refer to local
+ "/ files via a relative path, and drivers to fileIn other
+ "/ drivers ...
+ morePath := aStream pathName asFilename directoryName.
].
^ self fileInStream:aStream lazy:lazy silent:silent logged:logged addPath:morePath
@@ -4235,7 +4235,7 @@
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
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:logged
"
Smalltalk fileIn:'source/TicTacToe.st' logged:false
@@ -4246,8 +4246,8 @@
"read in the last changes file - bringing the system to the state it
had when left the last time.
WARNING: this method is rubbish: it should only read things after the
- last '**snapshot**' - entry
- (instead of the complete changes file)."
+ last '**snapshot**' - entry
+ (instead of the complete changes file)."
"
do NOT update the changes file now ...
@@ -4255,22 +4255,22 @@
self fileIn:ChangeFileName logged:false
"
- Smalltalk fileInChanges
+ Smalltalk fileInChanges
"
!
fileInClass:aClassName
"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
+ 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:true
- lazy:false
- silent:nil
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:true
+ lazy:false
+ silent:nil
"Modified: / 9.1.1998 / 14:41:46 / cg"
!
@@ -4291,15 +4291,15 @@
(path := self getBinaryFileName:aFileName) isNil ifTrue:[^ false].
ok := (ObjectFileLoader loadClass:aClassName fromObjectFile:path) notNil.
ok ifTrue:[
- SilentLoading ifFalse:[
- Transcript show:' loaded ' , aClassName , ' from ' ; showCR:aFileName.
- ]
+ 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'
+ Smalltalk fileInClass:'AbstractPath' fromObject:'../../goodies/Paths/AbstrPath.so'
+ Smalltalk fileInClass:'ClockView' fromObject:'../../libwidg3/libwidg3.so'
"
"Modified: 10.9.1996 / 20:43:52 / cg"
@@ -4307,39 +4307,39 @@
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
+ 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
+ ^ 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.
- search is in some standard places trying driver-file (.ld), object-file (.o) and
+ 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:loadLazy
- silent:nil
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:loadLazy
+ silent:nil
"Modified: / 9.1.1998 / 14:42:19 / cg"
!
-fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
+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
+ 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.
The argument doInit controlls if the class should be sent a #initialize after the
@@ -4348,19 +4348,19 @@
nil uses the value from SilentLoading."
^ self
- fileInClass:aClassName
- package:nil
- initialize:doInit
- lazy:loadLazy
- silent:beSilent
+ 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
+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
+ 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.
The argument doInit controlls if the class should be sent a #initialize after the
@@ -4368,323 +4368,323 @@
should not send notes to the transcript; it can be true, false or nil, where
nil uses the value from SilentLoading."
- |classFileName alternativeClassFileName libName newClass ok wasLazy wasSilent sharedLibExtension inStream mgr
+ |classFileName alternativeClassFileName libName newClass ok wasLazy wasSilent sharedLibExtension inStream mgr
fn packageDir packageFile bos hasSuffix classFilenameWithSuffix classFilenameWithoutSuffix|
wasLazy := Compiler compileLazy:loadLazy.
beSilent notNil ifTrue:[
- wasSilent := self silentLoading:beSilent.
+ wasSilent := self silentLoading:beSilent.
].
classFileName := Smalltalk fileNameForClass:aClassName.
(classFileName = aClassName) ifTrue:[
- "/ no abbrev.stc translation for className
- (aClassName includes:$:) ifTrue:[
- "/ a nameSpace name
- alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
- ].
+ "/ no abbrev.stc translation for className
+ (aClassName includes:$:) ifTrue:[
+ "/ a nameSpace name
+ alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
+ ].
].
hasSuffix := classFileName asFilename suffix notEmptyOrNil.
hasSuffix ifTrue:[
- classFilenameWithoutSuffix := classFileName asFilename withoutSuffix name.
- classFilenameWithSuffix := classFileName.
+ classFilenameWithoutSuffix := classFileName asFilename withoutSuffix name.
+ classFilenameWithSuffix := classFileName.
] ifFalse:[
- classFilenameWithoutSuffix := classFileName.
- classFilenameWithSuffix := classFileName,'.st'.
+ classFilenameWithoutSuffix := classFileName.
+ classFilenameWithSuffix := classFileName,'.st'.
].
classFileName asFilename isAbsolute ifTrue:[
- ok := self fileIn:classFilenameWithSuffix lazy:loadLazy silent:beSilent.
+ ok := self fileIn:classFilenameWithSuffix lazy:loadLazy silent:beSilent.
] ifFalse:[
- classFileName := classFileName copyReplaceAll:$: with:$_.
-
- [
- Class withoutUpdatingChangesDo:
- [
- |zarFn zar entry|
-
- ok := false.
-
- package notNil ifTrue:[
- packageDir := package asString.
- packageDir := packageDir copyReplaceAll:$: with:$/.
- ].
-
- Class packageQuerySignal answer:package
- do:[
-
- "
- then, if dynamic linking is available,
- "
- (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
- sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
-
- "
- first look for a class packages shared binary in binary/xxx.o
- "
- libName := self libraryFileNameOfClass:aClassName.
- libName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(libName, '.o')
- ]
- ].
- ].
-
- "
- then, look for a shared binary in binary/xxx.o
- "
- ok ifFalse:[
- (ok := self fileInClass:aClassName fromObject:(classFilenameWithoutSuffix, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(classFilenameWithoutSuffix, '.o')
- ].
- ok ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
- ]
- ]
- ].
- ].
- ].
- ].
- ].
-
- "
- if that did not work, look for a compiled-bytecode file ...
- "
- ok ifFalse:[
- (ok := self fileIn:(classFilenameWithoutSuffix , '.cls') lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-cls file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , classFilenameWithoutSuffix , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , classFilenameWithoutSuffix , '.cls').
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , alternativeClassFileName , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , alternativeClassFileName , '.cls').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ]
- ].
-
- zarFn := self getPackageFileName:(packageDir , '/classes.zip').
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFilenameWithoutSuffix , '.cls').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.cls').
- ].
- entry notNil ifTrue:[
- bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
- bos next.
- bos close.
- ok := true
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work, look for an st-source file ...
- "
- ok ifFalse:[
- fn := classFilenameWithoutSuffix , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- fn := alternativeClassFileName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- fn := 'source/' , classFilenameWithoutSuffix , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- fn := 'source/' , alternativeClassFileName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-source file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/source/' , classFilenameWithoutSuffix , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , classFilenameWithoutSuffix , '.st').
- ].
- fn := packageFile.
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/source/' , alternativeClassFileName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , alternativeClassFileName , '.st').
- ].
- fn := packageFile.
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
-
- packageFile := self getPackageFileName:(packageDir , '/' , classFilenameWithoutSuffix , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , classFilenameWithoutSuffix , '.st').
- ].
- fn := packageFile.
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/' , alternativeClassFileName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , alternativeClassFileName , '.st').
- ].
- fn := packageFile.
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- fn := 'source/' , packageDir , '/' , classFilenameWithoutSuffix , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- fn := 'source/' , packageDir , '/' , alternativeClassFileName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- ].
- ].
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- zarFn := self getPackageFileName:(packageDir , '/source.zip').
- zarFn isNil ifTrue:[
- zarFn := packageDir asFilename withSuffix:'zip'.
- zarFn := self getSourceFileName:zarFn.
- ].
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFilenameWithoutSuffix , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- fn := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- zarFn := self getSourceFileName:'source.zip'.
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(zarFn := classFilenameWithoutSuffix , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(zarFn := alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- fn := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ].
- ok ifFalse:[
- "
- if there is a sourceCodeManager, ask it for the classes sourceCode
- "
- (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName.
- inStream notNil ifTrue:[
- fn := nil.
- ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
- ]
- ].
- ].
- ].
- ]
- ].
- ] ensure:[
- Compiler compileLazy:wasLazy.
- wasSilent notNil ifTrue:[
- self silentLoading:wasSilent
- ]
- ].
+ classFileName := classFileName copyReplaceAll:$: with:$_.
+
+ [
+ Class withoutUpdatingChangesDo:
+ [
+ |zarFn zar entry|
+
+ ok := false.
+
+ package notNil ifTrue:[
+ packageDir := package asString.
+ packageDir := packageDir copyReplaceAll:$: with:$/.
+ ].
+
+ Class packageQuerySignal answer:package
+ do:[
+
+ "
+ then, if dynamic linking is available,
+ "
+ (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
+ sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
+
+ "
+ first look for a class packages shared binary in binary/xxx.o
+ "
+ libName := self libraryFileNameOfClass:aClassName.
+ libName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(libName, '.o')
+ ]
+ ].
+ ].
+
+ "
+ then, look for a shared binary in binary/xxx.o
+ "
+ ok ifFalse:[
+ (ok := self fileInClass:aClassName fromObject:(classFilenameWithoutSuffix, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(classFilenameWithoutSuffix, '.o')
+ ].
+ ok ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "
+ if that did not work, look for a compiled-bytecode file ...
+ "
+ ok ifFalse:[
+ (ok := self fileIn:(classFilenameWithoutSuffix , '.cls') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-cls file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , classFilenameWithoutSuffix , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , classFilenameWithoutSuffix , '.cls').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ]
+ ].
+
+ zarFn := self getPackageFileName:(packageDir , '/classes.zip').
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFilenameWithoutSuffix , '.cls').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.cls').
+ ].
+ entry notNil ifTrue:[
+ bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
+ bos next.
+ bos close.
+ ok := true
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ fn := classFilenameWithoutSuffix , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ fn := alternativeClassFileName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , classFilenameWithoutSuffix , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ fn := 'source/' , alternativeClassFileName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-source file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , classFilenameWithoutSuffix , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , classFilenameWithoutSuffix , '.st').
+ ].
+ fn := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , alternativeClassFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , alternativeClassFileName , '.st').
+ ].
+ fn := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+
+ packageFile := self getPackageFileName:(packageDir , '/' , classFilenameWithoutSuffix , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , classFilenameWithoutSuffix , '.st').
+ ].
+ fn := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/' , alternativeClassFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , alternativeClassFileName , '.st').
+ ].
+ fn := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , packageDir , '/' , classFilenameWithoutSuffix , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ fn := 'source/' , packageDir , '/' , alternativeClassFileName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ zarFn := self getPackageFileName:(packageDir , '/source.zip').
+ zarFn isNil ifTrue:[
+ zarFn := packageDir asFilename withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFilenameWithoutSuffix , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ fn := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ zarFn := self getSourceFileName:'source.zip'.
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(zarFn := classFilenameWithoutSuffix , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(zarFn := alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ fn := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ].
+ ok ifFalse:[
+ "
+ if there is a sourceCodeManager, ask it for the classes sourceCode
+ "
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName.
+ inStream notNil ifTrue:[
+ fn := nil.
+ ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ ] ensure:[
+ Compiler compileLazy:wasLazy.
+ wasSilent notNil ifTrue:[
+ self silentLoading:wasSilent
+ ]
+ ].
].
ok ifTrue:[
- newClass := self at:(aClassName asSymbol).
- newClass notNil ifTrue:[
- fn notNil ifTrue:[
- newClass getClassFilename isNil ifTrue:[
- newClass setClassFilename:fn
- ].
- ].
-
- doInit ifTrue:[
- newClass initialize
- ]
- ]
+ newClass := self at:(aClassName asSymbol).
+ newClass notNil ifTrue:[
+ fn notNil ifTrue:[
+ newClass getClassFilename isNil ifTrue:[
+ newClass setClassFilename:fn
+ ].
+ ].
+
+ doInit ifTrue:[
+ newClass initialize
+ ]
+ ]
].
^ newClass
@@ -4698,8 +4698,8 @@
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);
- the sharedLib extension (.dll / .so / .sl) is added here, to
- make the caller independent of the underlying operatingSystem."
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
|path fn|
@@ -4710,7 +4710,7 @@
path := self getBinaryFileName:fn.
path isNil ifTrue:[
- path := self getSystemFileName:fn.
+ path := self getSystemFileName:fn.
].
path isNil ifTrue:[^ false].
@@ -4729,8 +4729,8 @@
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);
- the sharedLib extension (.dll / .so / .sl) is added here, to
- make the caller independent of the underlying operatingSystem."
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
|path fn|
@@ -4780,39 +4780,39 @@
encoding := CharacterEncoder guessEncodingOfStream:inStream.
encoding notNil ifTrue:[
- decoder := CharacterEncoder encoderFor:encoding.
- inStream := EncodedStream stream:inStream encoder:decoder.
- inStream skipEncodingChunk.
+ decoder := CharacterEncoder encoderFor:encoding.
+ inStream := EncodedStream stream:inStream encoder:decoder.
+ inStream skipEncodingChunk.
].
lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
silent notNil ifTrue:[wasSilent := self silentLoading:silent].
morePath notNil ifTrue:[
- oldSystemPath := SystemPath copy.
- SystemPath addFirst:morePath.
- oldRealPath := RealSystemPath.
- RealSystemPath := nil.
+ oldSystemPath := SystemPath copy.
+ SystemPath addFirst:morePath.
+ oldRealPath := RealSystemPath.
+ RealSystemPath := nil.
].
[
- (Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
- inStream fileIn.
- ]
+ (Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
+ inStream fileIn.
+ ]
] ensure:[
- morePath notNil ifTrue:[
- "take care, someone could have changed SystemPath during fileIn!!"
- (SystemPath copyFrom:2) = oldSystemPath ifTrue:[
- SystemPath := oldSystemPath.
- RealSystemPath := oldRealPath.
- ] ifFalse:[
- (oldSystemPath includes:morePath) ifFalse:[
- SystemPath remove:morePath ifAbsent:[].
- ].
- RealSystemPath := nil.
- ].
- ].
- lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
- silent notNil ifTrue:[self silentLoading:wasSilent].
- inStream close
+ morePath notNil ifTrue:[
+ "take care, someone could have changed SystemPath during fileIn!!"
+ (SystemPath copyFrom:2) = oldSystemPath ifTrue:[
+ SystemPath := oldSystemPath.
+ RealSystemPath := oldRealPath.
+ ] ifFalse:[
+ (oldSystemPath includes:morePath) ifFalse:[
+ SystemPath remove:morePath ifAbsent:[].
+ ].
+ RealSystemPath := nil.
+ ].
+ ].
+ lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
+ silent notNil ifTrue:[self silentLoading:wasSilent].
+ inStream close
].
^ true
@@ -4826,22 +4826,22 @@
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
- ]
- ].
- ].
+ ObjectMemory
+ binaryModuleInfo
+ do:[:entry |
+ entry type == #classLibrary ifTrue:[
+ entry libraryName = name ifTrue:[
+ ^ true "/ already loaded
+ ]
+ ].
+ ].
^ false
"
- Smalltalk isClassLibraryLoaded:'libstx_libbasic'
- Smalltalk isClassLibraryLoaded:'libstx_libwidg3'
- Smalltalk isClassLibraryLoaded:'libstx_libboss'
+ Smalltalk isClassLibraryLoaded:'libstx_libbasic'
+ Smalltalk isClassLibraryLoaded:'libstx_libwidg3'
+ Smalltalk isClassLibraryLoaded:'libstx_libboss'
"
"Modified: / 23-08-2006 / 15:54:46 / cg"
@@ -4853,7 +4853,7 @@
Return true, if the library is loaded, false if not.
This entry is called without system specific filename
extensions - it is portable among different architectures
- as long as corresponding files (x.so / x.dll / x.sl / x.o)
+ as long as corresponding files (x.so / x.dll / x.sl / x.o)
are be present ..."
(self isClassLibraryLoaded:name) ifTrue:[ ^ true ]. "/ already loaded
@@ -4867,16 +4867,16 @@
"Modified: 31.10.1996 / 16:57:24 / cg"
!
-secureFileIn:aFileName
+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 ].
+ (SignalSet with:AbortOperationRequest with:TerminateProcessRequest)
+ handle:[:ex | ex return ]
+ do:[ retVal := self fileIn:aFileName ].
^ retVal
!
@@ -4888,9 +4888,9 @@
wasSilent := self silentLoading:true.
[
- self fileIn:aFilename
+ self fileIn:aFilename
] ensure:[
- self silentLoading:wasSilent
+ self silentLoading:wasSilent
]
! !
@@ -4906,7 +4906,7 @@
aString := self getBitmapFileName:aFileName.
aString notNil ifTrue:[
- ^ aString asFilename readStreamOrNil
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
@@ -4914,7 +4914,7 @@
bitmapFromFileNamed:aFileName forClass:aClass
"backward compatibility:
search aFileName in some standard places:
- first in the redefinable bitmaps path,
+ first in the redefinable bitmaps path,
then in the classes own package directory if existing.
Return an image or nil."
@@ -4928,7 +4928,7 @@
bitmapFromFileNamed:aFileName inPackage:aPackage
"backward compatibility:
search aFileName in some standard places:
- first in the redefinable bitmaps path,
+ first in the redefinable bitmaps path,
then in the package directory if existing.
Return an image or nil."
@@ -4948,32 +4948,32 @@
|fn|
(aFileName asFilename hasSuffix:'st') ifTrue:[
- fn := aFileName copyWithoutLast:3
+ fn := aFileName copyWithoutLast:3
] ifFalse:[
- fn := aFileName
+ fn := aFileName
].
^ self filenameAbbreviations keyAtEqualValue:fn ifAbsent:[fn].
"
- Smalltalk classNameForFile:'DrawObj'
- Smalltalk classNameForFile:'DrawObj.st'
- Smalltalk classNameForFile:'ArrColl.st'
- Smalltalk classNameForFile:'ArrColl.chg'
+ Smalltalk classNameForFile:'DrawObj'
+ Smalltalk classNameForFile:'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;
+ "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]
+ |fullPath|
+
+ fullPath := dirName asFilename construct:aDirectoryName.
+ "/ fullPath exists and:[fullPath isDirectory and:[fullPath isReadable]]
+ fullPath isDirectory and:[fullPath isReadable]
].
!
@@ -4987,7 +4987,7 @@
aString := self getFileInFileName:aFileName.
aString notNil ifTrue:[
- ^ aString asFilename readStreamOrNil
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
@@ -4998,43 +4998,43 @@
|cls nonMetaclass nm nm1 nm2|
aClassOrClassName isBehavior ifTrue:[
- nonMetaclass := aClassOrClassName theNonMetaclass.
- nm1 := nonMetaclass name.
- nm2 := nonMetaclass nameWithoutPrefix.
+ nonMetaclass := aClassOrClassName theNonMetaclass.
+ nm1 := nonMetaclass name.
+ nm2 := nonMetaclass nameWithoutPrefix.
] ifFalse:[
- cls := Smalltalk classNamed:aClassOrClassName.
- cls notNil ifTrue:[
- nonMetaclass := cls theNonMetaclass.
- nm := nonMetaclass getClassFilename.
- nm notNil ifTrue:[^ nm asFilename withoutSuffix baseName].
- nm1 := nonMetaclass name.
- nm2 := nonMetaclass nameWithoutPrefix.
- ] ifFalse:[
- nm1 := aClassOrClassName.
- nm2 := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
- ].
+ cls := Smalltalk classNamed:aClassOrClassName.
+ cls notNil ifTrue:[
+ nonMetaclass := cls theNonMetaclass.
+ nm := nonMetaclass getClassFilename.
+ nm notNil ifTrue:[^ nm asFilename withoutSuffix baseName].
+ nm1 := nonMetaclass name.
+ nm2 := nonMetaclass nameWithoutPrefix.
+ ] ifFalse:[
+ nm1 := aClassOrClassName.
+ nm2 := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
+ ].
].
nm1 := nm1 asSymbol.
nm2 := nm2 asSymbol.
CachedAbbreviations notNil ifTrue:[
- (CachedAbbreviations includesKey:nm1) ifTrue:[
- ^ (CachedAbbreviations at:nm1) asFilename baseName
- ].
- (CachedAbbreviations includesKey:nm2) ifTrue:[
- ^ (CachedAbbreviations at:nm2) asFilename baseName
- ].
+ (CachedAbbreviations includesKey:nm1) ifTrue:[
+ ^ (CachedAbbreviations at:nm1) asFilename baseName
+ ].
+ (CachedAbbreviations includesKey:nm2) ifTrue:[
+ ^ (CachedAbbreviations at:nm2) asFilename baseName
+ ].
].
^ nm1 copyReplaceAll:$: with:$_
"
- Smalltalk fileNameForClass:#Complex
- Smalltalk fileNameForClass:'SmallInteger'
- Smalltalk fileNameForClass:'UnixOperatingSystem'
- Smalltalk fileNameForClass:'Launcher'
- Smalltalk fileNameForClass:'SomeUnknownClass'
- Smalltalk fileNameForClass:OSI::FTAMOperation
- Smalltalk fileNameForClass:'OSI::Foobar'
+ Smalltalk fileNameForClass:#Complex
+ Smalltalk fileNameForClass:'SmallInteger'
+ Smalltalk fileNameForClass:'UnixOperatingSystem'
+ Smalltalk fileNameForClass:'Launcher'
+ Smalltalk fileNameForClass:'SomeUnknownClass'
+ Smalltalk fileNameForClass:OSI::FTAMOperation
+ Smalltalk fileNameForClass:'OSI::Foobar'
"
"Modified: / 06-10-2006 / 16:16:01 / cg"
@@ -5046,7 +5046,7 @@
to 14 chars)"
CachedAbbreviations isNil ifTrue:[
- self readAbbreviations
+ self readAbbreviations
].
^ CachedAbbreviations
@@ -5068,7 +5068,7 @@
the system is active, and those files should override the others
(for example, if you created a private resource directory)"
- RealSystemPath := ResourcePath := SourcePath :=
+ RealSystemPath := ResourcePath := SourcePath :=
BinaryPath := FileInPath := nil
"
@@ -5078,12 +5078,12 @@
getBinaryFileName:aFileName
"obsolete
- search aFileName in some standard places
+ 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
+ BinaryPath := self constructPathFor:BinaryDirName
].
^ self searchPath:BinaryPath for:aFileName in:BinaryDirName
@@ -5093,7 +5093,7 @@
getBitmapFileName:aFileName
"for backward compatibility:
- search aFileName in some standard places
+ search aFileName in some standard places
(subdirectories named 'bitmaps' in SystemPath);
Return the pathName or nil if none is found."
@@ -5109,55 +5109,55 @@
getBitmapFileName:aFileName forPackage:aPackageIDOrNil
"for backward compatibility.
search aFileName in some standard places:
- first in the redefinable bitmaps path,
+ first in the redefinable bitmaps path,
then in the package directory if existing.
Return a path or nil.
Search order is:
- bitmaps/<pkg>/file
- resources/<pkg>/bitmaps/file
- <pkg>/bitmaps/file
+ bitmaps/<pkg>/file
+ resources/<pkg>/bitmaps/file
+ <pkg>/bitmaps/file
"
|f dir packageDir pF|
aPackageIDOrNil isNil ifTrue:[
- 'Smalltalk [warning]: bitmap file access without package info' infoPrintCR.
-
- pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
- pF notNil ifTrue:[
- ^ pF.
- ].
- ^ nil
+ 'Smalltalk [warning]: bitmap file access without package info' infoPrintCR.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ ^ nil
].
packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
((f := aFileName) startsWith:'bitmaps/') ifTrue:[
- f := aFileName copyFrom:('bitmaps/' size + 1).
+ f := aFileName copyFrom:('bitmaps/' size + 1).
].
pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps/',packageDir).
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir,'/bitmaps').
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
dir := self projectDirectoryForPackage:aPackageIDOrNil.
dir notNil ifTrue:[
- pF := (dir asFilename construct:'bitmaps') constructString:f.
- pF exists ifTrue:[
- ^ pF.
- ].
+ pF := (dir asFilename construct:'bitmaps') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
].
^ nil
"
- Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
- Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
- Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
- Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
+ Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
"
"Modified: / 08-09-2006 / 18:02:04 / cg"
@@ -5165,12 +5165,12 @@
getFileInFileName:aFileName
"obsolete
- search aFileName in some standard places
+ 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
+ FileInPath := self constructPathFor:FileInDirName
].
^ self searchPath:FileInPath for:aFileName in:FileInDirName
@@ -5187,28 +5187,28 @@
module := aPackageID asPackageId module.
packageSubDirectory := aPackageID asPackageId directory.
- checkForPackageDirectory :=
- [:moduleDir |
- |packageDir|
-
- (moduleDir exists and:[moduleDir isDirectory]) ifTrue:[
- packageDir := moduleDir construct:packageSubDirectory.
- (packageDir exists and:[packageDir isDirectory]) ifTrue:[
- ^ packageDir
- ]
- ].
- ].
+ checkForPackageDirectory :=
+ [:moduleDir |
+ |packageDir|
+
+ (moduleDir exists and:[moduleDir isDirectory]) ifTrue:[
+ packageDir := moduleDir construct:packageSubDirectory.
+ (packageDir exists and:[packageDir isDirectory]) ifTrue:[
+ ^ packageDir
+ ]
+ ].
+ ].
self packagePath do:[:aPath |
- |moduleDir|
-
- moduleDir := aPath asFilename construct:module.
- checkForPackageDirectory value:moduleDir.
+ |moduleDir|
+
+ moduleDir := aPath asFilename construct:module.
+ checkForPackageDirectory value:moduleDir.
].
"/ not found - special case for the stx package...
module = 'stx' ifTrue:[
- checkForPackageDirectory value:('../../' asFilename).
+ checkForPackageDirectory value:('../../' asFilename).
].
^ nil
@@ -5223,7 +5223,7 @@
!
getPackageFileName:aFileName
- "search aFileName in some standard places
+ "search aFileName in some standard places
(packagePath and subdirectories named 'packages' in SystemPath);
return the absolute filename or nil if none is found."
@@ -5232,33 +5232,33 @@
"/ search along packagePath ...
f := self searchPath:self packagePath for:aFileName in:nil.
f isNil ifTrue:[
- "/ search under packages-directory along systemPath ...
- f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
- "/ kludge - allow for stx-directory to be named differently
- f isNil ifTrue:[
- (aFileName startsWith:'stx') ifTrue:[
- (aFileName startsWith:'stx' , Filename separator) ifTrue:[
- f := '../..' asFilename construct:(aFileName copyFrom:5).
- f exists ifTrue:[
- ^ f pathName
- ].
- ]
- ].
- ].
+ "/ search under packages-directory along systemPath ...
+ f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
+ "/ kludge - allow for stx-directory to be named differently
+ f isNil ifTrue:[
+ (aFileName startsWith:'stx') ifTrue:[
+ (aFileName startsWith:'stx' , Filename separator) ifTrue:[
+ f := '../..' asFilename construct:(aFileName copyFrom:5).
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ ]
+ ].
+ ].
].
(f notNil and:[(f := f asFilename) exists]) ifTrue:[
- ^ f pathName
+ ^ f pathName
].
^ nil
"
- Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
- Smalltalk getPackageFileName:'stx/libview/source.zip'
+ Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
+ Smalltalk getPackageFileName:'stx/libview/source.zip'
"
!
getResourceFileName:aFileName
- "search aFileName in some standard places
+ "search aFileName in some standard places
(subdirectories named 'resources' in SystemPath);
return the absolute filename or nil if none is found."
@@ -5272,7 +5272,7 @@
!
getResourceFileName:aFileName forClass:aClassOrNil
- "search aFileName in some standard places
+ "search aFileName in some standard places
(subdirectories named 'resource' in SystemPath);
and in aClasses package directory.
Return the absolute filename or nil if none is found."
@@ -5280,7 +5280,7 @@
|pkgOrNil|
aClassOrNil notNil ifTrue:[
- pkgOrNil := aClassOrNil package.
+ pkgOrNil := aClassOrNil package.
].
^ self getResourceFileName:aFileName forPackage:pkgOrNil.
@@ -5290,47 +5290,47 @@
!
getResourceFileName:aFileName forPackage:aPackageIDOrNil
- "search aFileName in some standard places
+ "search aFileName in some standard places
(subdirectories named 'resource' in SystemPath);
and in a packages directory.
Return the absolute filename or nil if none is found.
Search order is:
- resources/<pkg>/file
- <pkg>/resources/file
+ resources/<pkg>/file
+ <pkg>/resources/file
"
|pF f dir packageDir|
aPackageIDOrNil isNil ifTrue:[
- 'Smalltalk [warning]: resource file access without package info' infoPrintCR.
-
- pF := self searchPath:(self realSystemPath) for:aFileName in:('resources').
- pF notNil ifTrue:[
- ^ pF.
- ].
- ^ nil
+ 'Smalltalk [warning]: resource file access without package info' infoPrintCR.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ ^ nil
].
packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
((f := aFileName asString) startsWith:'resources/') ifTrue:[
- f := aFileName copyFrom:('resources/' size + 1).
+ f := aFileName copyFrom:('resources/' size + 1).
].
pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir).
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
dir := self projectDirectoryForPackage:aPackageIDOrNil.
dir notNil ifTrue:[
- pF := (dir asFilename construct:'resources') constructString:f.
- pF exists ifTrue:[
- ^ pF.
- ].
- pF := (dir asFilename construct:'styles') constructString:f.
- pF exists ifTrue:[
- ^ pF.
- ].
+ pF := (dir asFilename construct:'resources') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
+ pF := (dir asFilename construct:'styles') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
].
^ nil
@@ -5343,7 +5343,7 @@
!
getSourceFileName:aFileName
- "search aFileName in some standard places
+ "search aFileName in some standard places
(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,
@@ -5352,22 +5352,22 @@
|f|
SourcePath isNil ifTrue:[
- SourcePath := self constructPathFor:SourceDirName
+ SourcePath := self constructPathFor:SourceDirName
].
"/ first, try a source subdir along the path.
SourcePath notNil ifTrue:[
- f := self searchPath:SourcePath for:aFileName in:SourceDirName.
+ f := self searchPath:SourcePath for:aFileName in:SourceDirName.
].
f isNil ifTrue:[
- "/ then, try it itself along the path.
- f := self searchPath:self realSystemPath for:aFileName in:nil
+ "/ then, try it itself along the path.
+ f := self searchPath:self realSystemPath for:aFileName in:nil
].
^ f
"
- Smalltalk getSourceFileName:'Smalltalk.st'
- Smalltalk getSourceFileName:'ArrColl.st'
+ Smalltalk getSourceFileName:'Smalltalk.st'
+ Smalltalk getSourceFileName:'ArrColl.st'
"
"Modified: 18.7.1996 / 15:54:07 / cg"
@@ -5388,32 +5388,32 @@
fn := aFileNameOrString asFilename.
nameString := fn name.
fn isAbsolute ifTrue:[
- "dont use path for absolute file names"
-
- ^ nameString
+ "dont use path for absolute file names"
+
+ ^ nameString
].
self realSystemPath do:[:dirName |
- |realName|
-
- realName := dirName asFilename construct:nameString.
- "/
- "/ here, we also return true if its a directory
- "/ (Even if unreadable).
- "/ It could be that the file itself is still readable.
- "/
- (realName isDirectory or:[realName isReadable]) ifTrue: [
- ^ realName name
- ]
+ |realName|
+
+ realName := dirName asFilename construct:nameString.
+ "/
+ "/ here, we also return true if its a directory
+ "/ (Even if unreadable).
+ "/ It could be that the file itself is still readable.
+ "/
+ (realName isDirectory or:[realName isReadable]) ifTrue: [
+ ^ realName name
+ ]
].
^ nil
"
Smalltalk getSystemFileName:'doc/online/english/TOP.html'
Smalltalk getSystemFileName:'bitmaps/SBrowser.xbm'
- Smalltalk getSystemFileName:'bitmaps/foo'
- Smalltalk getSystemFileName:'resources/View.rs'
- Smalltalk getSystemFileName:'resources/iris.style'
+ Smalltalk getSystemFileName:'bitmaps/foo'
+ Smalltalk getSystemFileName:'resources/View.rs'
+ Smalltalk getSystemFileName:'resources/iris.style'
"
"Modified: / 6.5.1999 / 10:40:37 / cg"
@@ -5430,10 +5430,10 @@
classPackage := aClass package.
img := self imageFromFileNamed:aFileName inPackage:classPackage.
img isNil ifTrue:[
- "/ try under the goodies package ...
- classPackage ~= 'stx:goodies' ifTrue:[
- img := self imageFromFileNamed:aFileName inPackage:'stx:goodies'.
- ]
+ "/ try under the goodies package ...
+ classPackage ~= 'stx:goodies' ifTrue:[
+ img := self imageFromFileNamed:aFileName inPackage:'stx:goodies'.
+ ]
].
^ img
@@ -5444,29 +5444,29 @@
imageFromFileNamed:aFileName inPackage:aPackage
"search aFileName in some standard places:
- first in the redefinable bitmaps path,
+ first in the redefinable bitmaps path,
then in the package directory if existing.
Return an image or nil.
Search order is:
- bitmaps/<pkg>/file
- resources/<pkg>/bitmaps/file
- <pkg>/bitmaps/file
+ bitmaps/<pkg>/file
+ resources/<pkg>/bitmaps/file
+ <pkg>/bitmaps/file
"
|path|
path := self getBitmapFileName:aFileName forPackage:aPackage.
path notNil ifTrue:[
- ^ Image fromFile:path.
+ ^ Image fromFile:path.
].
^ nil
"
- Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
- Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
- Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
- Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
- Smalltalk imageFromFileNamed:'ComboDn_xp.xpm' inPackage:'stx:libwidg'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
+ Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
+ Smalltalk imageFromFileNamed:'ComboDn_xp.xpm' inPackage:'stx:libwidg'
"
"Modified: / 08-09-2006 / 18:02:04 / cg"
@@ -5489,9 +5489,9 @@
|aStream line words n aClassName|
aClassOrClassName isBehavior ifTrue:[
- aClassName := aClassOrClassName name
+ aClassName := aClassOrClassName name
] ifFalse:[
- aClassName := aClassOrClassName
+ aClassName := aClassOrClassName
].
aClassName := aClassName asString.
@@ -5499,33 +5499,33 @@
with:#(2) "/ column
do:[:fileName :col |
- aStream := self systemFileStreamFor:fileName.
- aStream notNil ifTrue:[
- [aStream atEnd] whileFalse:[
- line := aStream nextLine.
- line notNil ifTrue:[
- (line startsWith:'#') ifFalse:[
- words := line asCollectionOfWords.
- (n := words size) > 1 ifTrue:[
- (words at:1) = aClassName ifTrue:[
- n >= col ifTrue:[
- aStream close.
- ^ (words at:col) withoutSeparators
- ]
- ]
- ]
- ]
- ]
- ].
- aStream close
- ].
+ aStream := self systemFileStreamFor:fileName.
+ aStream notNil ifTrue:[
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+ words := line asCollectionOfWords.
+ (n := words size) > 1 ifTrue:[
+ (words at:1) = aClassName ifTrue:[
+ n >= col ifTrue:[
+ aStream close.
+ ^ (words at:col) withoutSeparators
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
+ ].
].
^ nil
"
- Smalltalk libraryFileNameOfClass:'ClockView'
- Smalltalk libraryFileNameOfClass:'Bag'
+ Smalltalk libraryFileNameOfClass:'ClockView'
+ Smalltalk libraryFileNameOfClass:'Bag'
"
"Modified: 6.11.1995 / 15:41:39 / cg"
@@ -5572,7 +5572,7 @@
^ self projectDirectoryForPackage:pkg.
"
- Smalltalk projectDirectoryForClass:Array
+ Smalltalk projectDirectoryForClass:Array
Smalltalk projectDirectoryForClass:View
"
!
@@ -5587,18 +5587,18 @@
"/ in the directory, from which the project was loaded
prj := Project projectWithId:aPackage.
prj notNil ifTrue:[
- prjDir := prj directory.
+ prjDir := prj directory.
].
(prjDir notNil and:[prjDir asFilename exists]) ifFalse:[
- prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
+ prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
].
^ prjDir
"
- Smalltalk projectDirectoryForPackage:'stx:libbasic'
+ Smalltalk projectDirectoryForPackage:'stx:libbasic'
Smalltalk projectDirectoryForPackage:'exept:smartcard'
- Smalltalk projectDirectoryForPackage:'stx'
- Smalltalk projectDirectoryForPackage:'bosch'
+ Smalltalk projectDirectoryForPackage:'stx'
+ Smalltalk projectDirectoryForPackage:'bosch'
"
"Modified: / 07-10-2006 / 17:45:58 / cg"
@@ -5667,36 +5667,36 @@
|line words nm abbrev pkg s w|
[aStream atEnd] whileFalse:[
- line := aStream nextLine.
- line notNil ifTrue:[
- (line startsWith:'#') ifFalse:[
-
- "/ must do it manually, caring for quoted strings.
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+
+ "/ must do it manually, caring for quoted strings.
"/ words := line asCollectionOfWords.
- words := OrderedCollection new.
- s := line readStream.
- [s atEnd] whileFalse:[
- s skipSeparators.
- s peek == $' ifTrue:[
- s next.
- w := s upTo:$'.
- s skipSeparators.
- ] ifFalse:[
- w := s upToSeparator
- ].
- words add:w
- ].
- words size >= 3 ifTrue:[
- nm := (words at:1) withoutSeparators.
- abbrev := (words at:2) withoutSeparators.
- pkg := (words at:3) withoutSeparators.
- self setFilename:abbrev forClass:nm package:pkg.
- ] ifFalse:[
- ('Smalltalk [warning]: malformed line in ' , (aStream pathName)) infoPrintCR.
- ]
- ]
- ]
+ words := OrderedCollection new.
+ s := line readStream.
+ [s atEnd] whileFalse:[
+ s skipSeparators.
+ s peek == $' ifTrue:[
+ s next.
+ w := s upTo:$'.
+ s skipSeparators.
+ ] ifFalse:[
+ w := s upToSeparator
+ ].
+ words add:w
+ ].
+ words size >= 3 ifTrue:[
+ nm := (words at:1) withoutSeparators.
+ abbrev := (words at:2) withoutSeparators.
+ pkg := (words at:3) withoutSeparators.
+ self setFilename:abbrev forClass:nm package:pkg.
+ ] ifFalse:[
+ ('Smalltalk [warning]: malformed line in ' , (aStream pathName)) infoPrintCR.
+ ]
+ ]
+ ]
].
"Modified: / 13.12.1999 / 11:54:17 / cg"
@@ -5709,41 +5709,41 @@
|nP|
RealSystemPath isNil ifTrue:[
- OperatingSystem isVMSlike ifTrue:[
- "/ temporary kludge: since we cannot currently
- "/ check for existance of a name like 'volume:',
- "/ leave those in the Path without a check.
- RealSystemPath := SystemPath select:[:dirName |
- |f|
-
- f := dirName asFilename.
- f isVolumeOnly ifTrue:[
- true
- ] ifFalse:[
- (f isDirectory) and:[f isReadable]
- ]
- ]
- ] ifFalse:[
- RealSystemPath := SystemPath select:[:dirName |
- |f|
-
- f := dirName asFilename.
- (f isDirectory) and:[f isReadable]
- ].
- RealSystemPath := RealSystemPath collect:[:dirName |
- |f|
-
- f := dirName asFilename pathName.
- ].
- "/ remove duplicates (but keep order)
- nP := OrderedCollection new.
- RealSystemPath do:[:p |
- (nP includes:p) ifFalse:[
- nP add:p
- ]
- ].
- RealSystemPath := nP.
- ].
+ OperatingSystem isVMSlike ifTrue:[
+ "/ temporary kludge: since we cannot currently
+ "/ check for existance of a name like 'volume:',
+ "/ leave those in the Path without a check.
+ RealSystemPath := SystemPath select:[:dirName |
+ |f|
+
+ f := dirName asFilename.
+ f isVolumeOnly ifTrue:[
+ true
+ ] ifFalse:[
+ (f isDirectory) and:[f isReadable]
+ ]
+ ]
+ ] ifFalse:[
+ RealSystemPath := SystemPath select:[:dirName |
+ |f|
+
+ f := dirName asFilename.
+ (f isDirectory) and:[f isReadable]
+ ].
+ RealSystemPath := RealSystemPath collect:[:dirName |
+ |f|
+
+ f := dirName asFilename pathName.
+ ].
+ "/ remove duplicates (but keep order)
+ nP := OrderedCollection new.
+ RealSystemPath do:[:p |
+ (nP includes:p) ifFalse:[
+ nP add:p
+ ]
+ ].
+ RealSystemPath := nP.
+ ].
].
^ RealSystemPath
!
@@ -5759,40 +5759,40 @@
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
dir exists ifFalse:[^ self].
[
- abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
- self readAbbreviationsFromStream:abbrevStream.
- abbrevStream close.
+ abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+ self readAbbreviationsFromStream:abbrevStream.
+ abbrevStream close.
] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
[
- directoryContents := dir directoryContents.
+ directoryContents := dir directoryContents.
] on:FileStream openErrorSignal do:[:ex|
- "non-accessable directory: we are done"
- ^ self
+ "non-accessable directory: we are done"
+ ^ self
].
directoryContents do:[:aFilename |
- |f|
-
- (#(
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- ) includes:aFilename) ifFalse:[
- f := dir construct:aFilename.
- f isDirectory ifTrue:[
- self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
- ]
- ].
+ |f|
+
+ (#(
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ ) includes:aFilename) ifFalse:[
+ f := dir construct:aFilename.
+ f isDirectory ifTrue:[
+ self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
+ ]
+ ].
].
!
@@ -5807,17 +5807,17 @@
(prjDir notNil
and:[(prjDir := prjDir asFilename) exists
and:[(rsrcDir := prjDir construct:'resources') exists]]) ifTrue:[
- ^ rsrcDir
+ ^ rsrcDir
].
rsrcDir := self getSystemFileName:('resources/' , (aPackage copyReplaceAll:$: with:$/)).
rsrcDir notNil ifTrue:[
- ^ rsrcDir asFilename
- ].
- ^ nil
-
- "
- Smalltalk resourceDirectoryForPackage:'stx:libbasic'
- Smalltalk resourceDirectoryForPackage:'exept:expecco'
+ ^ rsrcDir asFilename
+ ].
+ ^ nil
+
+ "
+ Smalltalk resourceDirectoryForPackage:'stx:libbasic'
+ Smalltalk resourceDirectoryForPackage:'exept:expecco'
Smalltalk resourceDirectoryForPackage:'exept:smartcard'
"
!
@@ -5840,7 +5840,7 @@
aString := self getResourceFileName:aFileName forClass:aClassOrNil.
aString notNil ifTrue:[
- ^ aString asFilename readStreamOrNil
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
@@ -5851,28 +5851,28 @@
|f|
- ((f := aFileName asFilename) isAbsolute
+ ((f := aFileName asFilename) isAbsolute
or:[f isExplicitRelative]) ifTrue:[
- "/
- "/ dont use path for absolute or explicit .-relative file names
- "/
- ^ aFileName
+ "/
+ "/ dont use path for absolute or explicit .-relative file names
+ "/
+ ^ aFileName
].
aPath notNil ifTrue:[
- aPath do:[:dirName |
- |realName dir|
-
- dir := dirName asFilename.
- aDirName notNil ifTrue:[
- realName := (dir construct:aDirName) construct:aFileName.
- ] ifFalse:[
- realName := dir construct:aFileName.
- ].
- (realName isReadable) ifTrue:[
- ^ realName name
- ]
- ].
+ aPath do:[:dirName |
+ |realName dir|
+
+ dir := dirName asFilename.
+ aDirName notNil ifTrue:[
+ realName := (dir construct:aDirName) construct:aFileName.
+ ] ifFalse:[
+ realName := dir construct:aFileName.
+ ].
+ (realName isReadable) ifTrue:[
+ ^ realName name
+ ]
+ ].
].
^ nil.
@@ -5880,59 +5880,59 @@
"Modified: / 29.4.1999 / 15:06:43 / cg"
!
-setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
+setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
|classNameSymbol oldAbbrev oldPath newPath cls abbrevs|
CachedAbbreviations isNil ifTrue:[
- CachedAbbreviations := IdentityDictionary new.
+ CachedAbbreviations := IdentityDictionary new.
].
abbrevs := CachedAbbreviations.
aClassNameString ~= aFileNameString ifTrue:[
- classNameSymbol := aClassNameString asSymbol.
- oldAbbrev := abbrevs at:classNameSymbol ifAbsent:nil.
- oldAbbrev notNil ifTrue:[
- oldAbbrev ~= aFileNameString ifTrue:[
- oldAbbrev asFilename isAbsolute
- ifTrue:[ oldPath := oldAbbrev ]
- ifFalse:[ oldPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: oldAbbrev ].
- aFileNameString asFilename isAbsolute
- ifTrue:[ newPath := aFileNameString ]
- ifFalse:[ newPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: aFileNameString ].
-
- oldPath ~= newPath ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: autoload path change for: ',aClassNameString,' in package ',aPackageNameString) infoPrintCR.
- ('Smalltalk [info]: old: ',oldPath) infoPrintCR.
- ('Smalltalk [info]: new: ',newPath) infoPrintCR.
- ]
- ]
- ].
- "overwrite old abbreviation with new one,
- to allow fixing of bad abbrev files"
- ].
-
- cls := self classNamed:aFileNameString.
- cls notNil ifTrue:[
- cls name ~= aClassNameString ifTrue:[
- "/ ok, there is a class named after this abbrev ...
- "/ this is only a conflict, if the other class has no
- "/ abbreviation (or the same).
- (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = aFileNameString ifTrue:[
- cls isNameSpace ifFalse:[
- aPackageNameString = cls package ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , cls name ,
- ' in package ' , aPackageNameString) infoPrintCR.
- ('Smalltalk [warning]: (' , aClassNameString , ' -> ' , aFileNameString
- , ')') infoPrintCR
- ]
- ]
- ]
- ]
- ]
- ].
- abbrevs at:classNameSymbol put:aFileNameString.
+ classNameSymbol := aClassNameString asSymbol.
+ oldAbbrev := abbrevs at:classNameSymbol ifAbsent:nil.
+ oldAbbrev notNil ifTrue:[
+ oldAbbrev ~= aFileNameString ifTrue:[
+ oldAbbrev asFilename isAbsolute
+ ifTrue:[ oldPath := oldAbbrev ]
+ ifFalse:[ oldPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: oldAbbrev ].
+ aFileNameString asFilename isAbsolute
+ ifTrue:[ newPath := aFileNameString ]
+ ifFalse:[ newPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: aFileNameString ].
+
+ oldPath ~= newPath ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: autoload path change for: ',aClassNameString,' in package ',aPackageNameString) infoPrintCR.
+ ('Smalltalk [info]: old: ',oldPath) infoPrintCR.
+ ('Smalltalk [info]: new: ',newPath) infoPrintCR.
+ ]
+ ]
+ ].
+ "overwrite old abbreviation with new one,
+ to allow fixing of bad abbrev files"
+ ].
+
+ cls := self classNamed:aFileNameString.
+ cls notNil ifTrue:[
+ cls name ~= aClassNameString ifTrue:[
+ "/ ok, there is a class named after this abbrev ...
+ "/ this is only a conflict, if the other class has no
+ "/ abbreviation (or the same).
+ (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = aFileNameString ifTrue:[
+ cls isNameSpace ifFalse:[
+ aPackageNameString = cls package ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , cls name ,
+ ' in package ' , aPackageNameString) infoPrintCR.
+ ('Smalltalk [warning]: (' , aClassNameString , ' -> ' , aFileNameString
+ , ')') infoPrintCR
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ abbrevs at:classNameSymbol put:aFileNameString.
]
!
@@ -5947,9 +5947,9 @@
|aStream line words n aClassName|
aClassOrClassName isBehavior ifTrue:[
- aClassName := aClassOrClassName name
+ aClassName := aClassOrClassName name
] ifFalse:[
- aClassName := aClassOrClassName
+ aClassName := aClassOrClassName
].
aClassName := aClassName asString.
@@ -5957,35 +5957,35 @@
with:#(3 2) "/ column
do:[:fileName :col |
- aStream := self systemFileStreamFor:fileName.
- aStream notNil ifTrue:[
- [aStream atEnd] whileFalse:[
- line := aStream nextLine.
- line notNil ifTrue:[
- (line startsWith:'#') ifFalse:[
- words := line asCollectionOfWords.
- (n := words size) > 1 ifTrue:[
- (words at:1) = aClassName ifTrue:[
- n >= col ifTrue:[
- aStream close.
- ^ (words at:col) withoutSeparators
- ]
- ]
- ]
- ]
- ]
- ].
- aStream close
- ].
+ aStream := self systemFileStreamFor:fileName.
+ aStream notNil ifTrue:[
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+ words := line asCollectionOfWords.
+ (n := words size) > 1 ifTrue:[
+ (words at:1) = aClassName ifTrue:[
+ n >= col ifTrue:[
+ aStream close.
+ ^ (words at:col) withoutSeparators
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
+ ].
].
^ nil
"
- Smalltalk sourceDirectoryNameOfClass:'ClockView'
- Smalltalk sourceDirectoryNameOfClass:'Bag'
- Smalltalk sourceDirectoryNameOfClass:'GLWireCubeDemoView'
- Smalltalk sourceDirectoryNameOfClass:'SomeNonExistingClass'
+ Smalltalk sourceDirectoryNameOfClass:'ClockView'
+ Smalltalk sourceDirectoryNameOfClass:'Bag'
+ Smalltalk sourceDirectoryNameOfClass:'GLWireCubeDemoView'
+ Smalltalk sourceDirectoryNameOfClass:'SomeNonExistingClass'
"
"Created: 6.11.1995 / 15:43:30 / cg"
@@ -6002,7 +6002,7 @@
aString := self getSourceFileName:aFileName.
aString notNil ifTrue:[
- ^ aString asFilename readStreamOrNil
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
@@ -6016,14 +6016,14 @@
aString := self getSystemFileName:aFileName.
aString notNil ifTrue:[
- ^ aString asFilename readStreamOrNil
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
systemPath
"return a 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."
@@ -6037,7 +6037,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."
@@ -6063,23 +6063,23 @@
if there is a sourceCodeManager, ask it first for the extensions
"
(mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- inStream := mgr getMostRecentSourceStreamForFile:'extensions.st' inPackage:aPackageId.
- inStream notNil ifTrue:[
- Class withoutUpdatingChangeSetDo:[
- inStream fileIn.
- ].
- inStream close.
- SilentLoading ifFalse:[
- Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
- ].
- ^ true
- ]
+ inStream := mgr getMostRecentSourceStreamForFile:'extensions.st' inPackage:aPackageId.
+ inStream notNil ifTrue:[
+ Class withoutUpdatingChangeSetDo:[
+ inStream fileIn.
+ ].
+ inStream close.
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
+ ].
+ ^ true
+ ]
].
packageDirName := aPackageId copyReplaceAll:$: with:$/.
packageDirName := self getPackageFileName:packageDirName.
packageDirName notNil ifTrue:[
- ^ self loadExtensionsFromDirectory:packageDirName
+ ^ self loadExtensionsFromDirectory:packageDirName
].
^ false
!
@@ -6091,13 +6091,13 @@
f := packageDir construct:'extensions.st'.
f exists ifTrue:[
- Class withoutUpdatingChangeSetDo:[
- f fileIn.
- ].
- SilentLoading ifFalse:[
- Transcript showCR:('loaded extensions: ' , f pathName).
- ].
- ^ true
+ Class withoutUpdatingChangeSetDo:[
+ f fileIn.
+ ].
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded extensions: ' , f pathName).
+ ].
+ ^ true
].
^ false
!
@@ -6107,12 +6107,12 @@
Experimental."
(aPackageIdOrPackage isString) ifTrue:[
- ^ self loadPackageWithId:aPackageIdOrPackage asAutoloaded:false
+ ^ self loadPackageWithId:aPackageIdOrPackage asAutoloaded:false
].
self shouldImplement.
"
- Smalltalk loadPackage:'stx:libbasic'
+ Smalltalk loadPackage:'stx:libbasic'
Smalltalk loadPackage:'stx:goodies/persistency'
Smalltalk loadPackage:'cg:cparser'
Smalltalk loadPackage:'cg:rose'
@@ -6130,39 +6130,39 @@
"/ solution: repeat twice, so that superclasses are present the second time
Class packageQuerySignal answer:packageId asSymbol do:[
- |any|
-
- repeatCount := 0.
- [
- repeatCount := repeatCount + 1.
- anyFail := false.
- aDirectory directoryContents do:[:file |
- |fn|
-
- fn := aDirectory construct:file.
- (fn hasSuffix:'st') ifTrue:[
- Metaclass confirmationQuerySignal answer:false
- do:[
- Error
- handle:[:ex |
- anyFail := true
- ]
- do:[
- (self fileIn:fn) ifFalse:[
- anyFail := true
- ] ifTrue:[
- any := true.
- ]
- ]
- ]
- ]
- ].
- any ifFalse:[
- ^ false "/ no file found
- ]
- ] doWhile:[anyFail and:[repeatCount<2]].
- ].
-
+ |any|
+
+ repeatCount := 0.
+ [
+ repeatCount := repeatCount + 1.
+ anyFail := false.
+ aDirectory directoryContents do:[:file |
+ |fn|
+
+ fn := aDirectory construct:file.
+ (fn hasSuffix:'st') ifTrue:[
+ Metaclass confirmationQuerySignal answer:false
+ do:[
+ Error
+ handle:[:ex |
+ anyFail := true
+ ]
+ do:[
+ (self fileIn:fn) ifFalse:[
+ anyFail := true
+ ] ifTrue:[
+ any := true.
+ ]
+ ]
+ ]
+ ]
+ ].
+ any ifFalse:[
+ ^ false "/ no file found
+ ]
+ ] doWhile:[anyFail and:[repeatCount<2]].
+ ].
+
new := (p := Project projectWithId:packageId) isNil.
new ifTrue:[ p := Project new].
@@ -6185,10 +6185,10 @@
|p t new|
(self fileIn:aFilename) ifFalse:[
- (self fileInClassLibrary:aFilename) ifFalse:[
- self warn:'Failed to load the package ', packageId printString.
- ^ false.
- ]
+ (self fileInClassLibrary:aFilename) ifFalse:[
+ self warn:'Failed to load the package ', packageId printString.
+ ^ false.
+ ]
].
new := (p := Project projectWithId:packageId) isNil.
@@ -6214,10 +6214,10 @@
Metaclass confirmationQuerySignal answer:false
do:[
- (self fileIn:aFilename) ifFalse:[
- self warn:'Failed to load the package ', packageId printString.
- ^ false.
- ]
+ (self fileIn:aFilename) ifFalse:[
+ self warn:'Failed to load the package ', packageId printString.
+ ^ false.
+ ]
].
new := (p := Project projectWithId:packageId) isNil.
@@ -6256,13 +6256,13 @@
Smalltalk installAutoloadedClassesFrom:abbrevFile pathName.
doLoadAsAutoloaded ifFalse:[
- "/ force autoloading...
- Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
+ "/ force autoloading...
+ Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
].
self loadExtensionsFromDirectory:packageDir.
SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
+ Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
].
^ true
@@ -6276,7 +6276,7 @@
^ self loadPackageWithId:aPackageId asAutoloaded:false
"
- Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:libbasic'
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'cg:cparser'
Smalltalk loadPackageWithId:'cg:rose'
@@ -6291,12 +6291,12 @@
|pkg packageDir|
pkg := Project projectWithId:aPackageId.
- (pkg notNil and:[pkg isLoaded]) ifTrue:[
- "/ ('Smalltalk [info]: Package ' , aPackageId , ' already loaded.') infoPrintCR.
- (doLoadAsAutoloaded
- or:[pkg areAllClassesLoaded]) ifTrue:[
- ^ true
- ].
+ (pkg notNil and:[pkg isLoaded]) ifTrue:[
+ "/ ('Smalltalk [info]: Package ' , aPackageId , ' already loaded.') infoPrintCR.
+ (doLoadAsAutoloaded
+ or:[pkg areAllClassesLoaded]) ifTrue:[
+ ^ true
+ ].
].
"/ ok; not yet loaded.
@@ -6305,23 +6305,23 @@
"/ $(SYSPATH)/packages/<packageDir>
packageDir := self packageDirectoryForPackageId:aPackageId.
packageDir isNil ifTrue:[
- (aPackageId includes:$:) ifFalse:[
- "/ assume stx
- packageDir := self packageDirectoryForPackageId:('stx:',aPackageId).
- ].
+ (aPackageId includes:$:) ifFalse:[
+ "/ assume stx
+ packageDir := self packageDirectoryForPackageId:('stx:',aPackageId).
+ ].
].
packageDir isNil ifTrue:[
- ('Smalltalk [warning]: cannot find packageDirectory for: ' , aPackageId) errorPrintCR.
- ^ false
+ ('Smalltalk [warning]: cannot find packageDirectory for: ' , aPackageId) errorPrintCR.
+ ^ false
].
^ self
- loadPackageWithId:aPackageId
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded
-
- "
- Smalltalk loadPackageWithId:'stx:libbasic'
+ loadPackageWithId:aPackageId
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
@@ -6335,37 +6335,37 @@
"/ if there is a project definiton, use that one to pull in the rest.
defClass := ProjectDefinition definitionClassForPackage:aPackageId.
defClass notNil ifTrue:[
- defClass autoload.
- defClass load.
- ^ true.
+ defClass autoload.
+ defClass load.
+ ^ true.
].
"/ try to load the project definition class
f := (packageDir construct:(ProjectDefinition initialClassNameForDefinitionOf:aPackageId)) withSuffix:'st'.
f exists ifTrue:[
- f fileIn.
- defClass := ProjectDefinition definitionClassForPackage:aPackageId.
- defClass notNil ifTrue:[
- defClass load.
- SilentLoading ifFalse:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project file: ' , f pathName).
- ].
- ^ true
- ].
- ].
-
- "/ loadAll ? - well be soon obsolete
+ f fileIn.
+ defClass := ProjectDefinition definitionClassForPackage:aPackageId.
+ defClass notNil ifTrue:[
+ defClass load.
+ SilentLoading ifFalse:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project file: ' , f pathName).
+ ].
+ ^ true
+ ].
+ ].
+
+ "/ loadAll ? - well be soon obsolete
f := packageDir construct:'loadAll'.
f exists ifFalse:[
- f := packageDir construct:'loadall'.
+ f := packageDir construct:'loadall'.
].
f exists ifTrue:[
- (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
packageName := packageDir baseName.
@@ -6373,12 +6373,12 @@
"/ .zip ?
f := (packageDir construct:packageName) withSuffix:'zip'.
f exists ifTrue:[
- (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
shLibName := packageName , ObjectFileLoader sharedLibraryExtension.
@@ -6386,54 +6386,54 @@
"/ .so ?
f := packageDir construct:shLibName.
f exists ifTrue:[
- (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
- ].
- doLoadAsAutoloaded ifFalse:[
- "/ force autoloading...
- Smalltalk allClassesDo:[:eachClass |
- eachClass package == aPackageId ifTrue:[ eachClass autoload].
- ].
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
+ ].
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass package == aPackageId ifTrue:[ eachClass autoload].
+ ].
+ ].
+ ^ true
+ ]
].
"/ abbrev.stc ?
(self loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded) ifTrue:[
- ^ true
+ ^ true
].
"/ any .so ? -> load the first one found (maybe not a good idea)
packageDir directoryContentsAsFilenamesDo:[:aFilename |
- (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
- (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
- ].
- doLoadAsAutoloaded ifFalse:[
- "/ force autoloading...
- Smalltalk allClassesDo:[:eachClass |
- eachClass package == aPackageId ifTrue:[ eachClass autoload].
- ].
- ].
- ^ true
- ]
- ]
+ (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
+ (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
+ ].
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass package == aPackageId ifTrue:[ eachClass autoload].
+ ].
+ ].
+ ^ true
+ ]
+ ]
].
"/ source files
(self loadPackage:aPackageId fromAllSourceFilesInDirectory:packageDir) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
- ].
- ^ true
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
+ ].
+ ^ true
].
^ false
"
- Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:libbasic'
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
@@ -6448,15 +6448,15 @@
packageDir := self getPackageFileName:packageDirName.
packageDir isNil ifTrue:[
- "/ for convenience: try ../../.. as well
- "/ (when executing in thedevelopment environment)
- packageDir := '../../..' asFilename construct:packageDirName.
- packageDir exists ifFalse:[ ^ nil].
+ "/ for convenience: try ../../.. as well
+ "/ (when executing in thedevelopment environment)
+ packageDir := '../../..' asFilename construct:packageDirName.
+ packageDir exists ifFalse:[ ^ nil].
].
^ packageDir asFilename
"
- Smalltalk packageDirectoryForPackageId:'stx:libbasic'
+ Smalltalk packageDirectoryForPackageId:'stx:libbasic'
Smalltalk packageDirectoryForPackageId:'stx:goodies/persistency'
Smalltalk packageDirectoryForPackageId:'exept:ctypes'
"
@@ -6468,7 +6468,7 @@
"remove all undeclared variables"
(Smalltalk at:#Undeclared) do:[:eachKey |
- Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
+ Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
].
(Smalltalk at:#Undeclared) removeAll.
Smalltalk removeKey:#Undeclared.
@@ -6498,7 +6498,7 @@
^ 'unknownOS/unknownCONF:unknownPACK'
"
- Smalltalk configuration
+ Smalltalk configuration
"
!
@@ -6549,13 +6549,13 @@
|exp|
-%{
+%{
extern unsigned int __getExpirationTime();
exp = __MKUINT(__getExpirationTime());
%}.
exp == 0 ifTrue:[
- ^ nil
+ ^ nil
].
^ Timestamp new fromOSTime:(exp * 1000). "OSTime is ms since 1970"
@@ -6569,7 +6569,7 @@
"return a full version string"
- ^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
+ ^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
"
Smalltalk fullVersionString
@@ -6592,38 +6592,38 @@
lang := Language.
(lang == #de) ifTrue:[
- proto := 'Willkommen bei %1 (Version %2 von %3)'
+ proto := 'Willkommen bei %1 (Version %2 von %3)'
] ifFalse:[ (lang == #fr) ifTrue:[
- proto := 'Salut, Bienvenue à %1 (version %2 de %3)'
+ proto := 'Salut, Bienvenue à %1 (version %2 de %3)'
] ifFalse:[ (lang == #it) ifTrue:[
- proto := 'Ciao, benvenuto al %1 (versione %2 di %3)'
+ proto := 'Ciao, benvenuto al %1 (versione %2 di %3)'
] ifFalse:[ (lang == #es) ifTrue:[
"/ proto := 'Hola, bienvenida a %1 (versión %2 de %3)'
] ifFalse:[ (lang == #es) ifTrue:[
"/ proto := 'Oi, benvindo a %1 (versão %2 de %3)'
] ifFalse:[ (lang == #no) ifTrue:[
- proto := 'Hei, verdenmottakelse til %1 (versjon %2 av %3)'
+ proto := 'Hei, verdenmottakelse til %1 (versjon %2 av %3)'
]]]]]].
"/ ... more needed here ...
proto isNil ifTrue:[
- proto := 'Hello World - here is %1 version %2 of %3'.
+ proto := 'Hello World - here is %1 version %2 of %3'.
].
^ proto bindWith:('SmallTalk/X' allBold)
- with:(self versionString)
- with:(self versionDate)
-
- "
- Smalltalk language:#us.
- Smalltalk hello
-
- Smalltalk language:#de.
- Smalltalk hello
-
- Smalltalk language:#no.
- Smalltalk hello
+ with:(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)
@@ -6682,7 +6682,7 @@
classes changes).
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 5
@@ -6702,7 +6702,7 @@
classes need rework.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 3
@@ -6716,7 +6716,7 @@
releaseIdentification
"{ Pragma: +optSpace }"
- "for developers only: return the release
+ "for developers only: return the release
(to further identify the version in case of errors)"
%{ /* NOCONTEXT */
@@ -6739,12 +6739,12 @@
their way to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 2
- "
- Smalltalk releaseNr
+ "
+ Smalltalk releaseNr
"
"Created: / 10-12-1995 / 01:42:19 / cg"
@@ -6760,13 +6760,13 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 1
- "
+ "
Smalltalk revisionNr
- Smalltalk hello
+ Smalltalk hello
"
"Modified: / 16-08-2006 / 09:37:29 / cg"
@@ -6816,7 +6816,7 @@
^ 'today'
"
- Smalltalk versionDate
+ Smalltalk versionDate
"
!
@@ -6853,5 +6853,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.764 2006-10-11 11:23:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.765 2006-10-11 11:36:45 cg Exp $'
! !